121 lines
3.3 KiB
Fortran
121 lines
3.3 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Routine: IVOUT
|
|
C
|
|
C Purpose: Integer vector output routine.
|
|
C
|
|
C Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT)
|
|
C
|
|
C Arguments
|
|
C N - Length of array IX. (Input)
|
|
C IX - Integer array to be printed. (Input)
|
|
C IFMT - Format to be used in printing array IX. (Input)
|
|
C IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
|
|
C If IDIGIT .LT. 0, printing is done with 72 columns.
|
|
C If IDIGIT .GT. 0, printing is done with 132 columns.
|
|
C
|
|
C-----------------------------------------------------------------------
|
|
C
|
|
SUBROUTINE IVOUT (LOUT, N, IX, IDIGIT, IFMT)
|
|
C ...
|
|
C ... SPECIFICATIONS FOR ARGUMENTS
|
|
INTEGER IX(*), N, IDIGIT, LOUT
|
|
CHARACTER IFMT*(*)
|
|
C ...
|
|
C ... SPECIFICATIONS FOR LOCAL VARIABLES
|
|
INTEGER I, NDIGIT, K1, K2, LLL
|
|
CHARACTER*80 LINE
|
|
* ...
|
|
* ... SPECIFICATIONS INTRINSICS
|
|
INTRINSIC MIN
|
|
*
|
|
C
|
|
LLL = MIN ( LEN ( IFMT ), 80 )
|
|
DO 1 I = 1, LLL
|
|
LINE(I:I) = '-'
|
|
1 CONTINUE
|
|
C
|
|
DO 2 I = LLL+1, 80
|
|
LINE(I:I) = ' '
|
|
2 CONTINUE
|
|
C
|
|
WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL)
|
|
2000 FORMAT ( /1X, A /1X, A )
|
|
C
|
|
IF (N .LE. 0) RETURN
|
|
NDIGIT = IDIGIT
|
|
IF (IDIGIT .EQ. 0) NDIGIT = 4
|
|
C
|
|
C=======================================================================
|
|
C CODE FOR OUTPUT USING 72 COLUMNS FORMAT
|
|
C=======================================================================
|
|
C
|
|
IF (IDIGIT .LT. 0) THEN
|
|
C
|
|
NDIGIT = -IDIGIT
|
|
IF (NDIGIT .LE. 4) THEN
|
|
DO 10 K1 = 1, N, 10
|
|
K2 = MIN0(N,K1+9)
|
|
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
|
|
10 CONTINUE
|
|
C
|
|
ELSE IF (NDIGIT .LE. 6) THEN
|
|
DO 30 K1 = 1, N, 7
|
|
K2 = MIN0(N,K1+6)
|
|
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
|
|
30 CONTINUE
|
|
C
|
|
ELSE IF (NDIGIT .LE. 10) THEN
|
|
DO 50 K1 = 1, N, 5
|
|
K2 = MIN0(N,K1+4)
|
|
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
|
|
50 CONTINUE
|
|
C
|
|
ELSE
|
|
DO 70 K1 = 1, N, 3
|
|
K2 = MIN0(N,K1+2)
|
|
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
|
|
70 CONTINUE
|
|
END IF
|
|
C
|
|
C=======================================================================
|
|
C CODE FOR OUTPUT USING 132 COLUMNS FORMAT
|
|
C=======================================================================
|
|
C
|
|
ELSE
|
|
C
|
|
IF (NDIGIT .LE. 4) THEN
|
|
DO 90 K1 = 1, N, 20
|
|
K2 = MIN0(N,K1+19)
|
|
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
|
|
90 CONTINUE
|
|
C
|
|
ELSE IF (NDIGIT .LE. 6) THEN
|
|
DO 110 K1 = 1, N, 15
|
|
K2 = MIN0(N,K1+14)
|
|
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
|
|
110 CONTINUE
|
|
C
|
|
ELSE IF (NDIGIT .LE. 10) THEN
|
|
DO 130 K1 = 1, N, 10
|
|
K2 = MIN0(N,K1+9)
|
|
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
|
|
130 CONTINUE
|
|
C
|
|
ELSE
|
|
DO 150 K1 = 1, N, 7
|
|
K2 = MIN0(N,K1+6)
|
|
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
|
|
150 CONTINUE
|
|
END IF
|
|
END IF
|
|
WRITE (LOUT,1004)
|
|
C
|
|
1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
|
|
1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
|
|
1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
|
|
1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
|
|
1004 FORMAT(1X,' ')
|
|
C
|
|
RETURN
|
|
END
|