123 lines
3.9 KiB
Fortran
123 lines
3.9 KiB
Fortran
*-----------------------------------------------------------------------
|
|
* Routine: DVOUT
|
|
*
|
|
* Purpose: Real vector output routine.
|
|
*
|
|
* Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT)
|
|
*
|
|
* Arguments
|
|
* N - Length of array SX. (Input)
|
|
* SX - Real array to be printed. (Input)
|
|
* IFMT - Format to be used in printing array SX. (Input)
|
|
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
|
|
* If IDIGIT .LT. 0, printing is done with 72 columns.
|
|
* If IDIGIT .GT. 0, printing is done with 132 columns.
|
|
*
|
|
*-----------------------------------------------------------------------
|
|
*
|
|
SUBROUTINE DVOUT( LOUT, N, SX, IDIGIT, IFMT )
|
|
* ...
|
|
* ... SPECIFICATIONS FOR ARGUMENTS
|
|
* ...
|
|
* ... SPECIFICATIONS FOR LOCAL VARIABLES
|
|
* .. Scalar Arguments ..
|
|
CHARACTER*( * ) IFMT
|
|
INTEGER IDIGIT, LOUT, N
|
|
* ..
|
|
* .. Array Arguments ..
|
|
DOUBLE PRECISION SX( * )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
CHARACTER*80 LINE
|
|
INTEGER I, K1, K2, LLL, NDIGIT
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC LEN, MIN, MIN0
|
|
* ..
|
|
* .. Executable Statements ..
|
|
* ...
|
|
* ... FIRST EXECUTABLE STATEMENT
|
|
*
|
|
*
|
|
LLL = MIN( LEN( IFMT ), 80 )
|
|
DO 10 I = 1, LLL
|
|
LINE( I: I ) = '-'
|
|
10 CONTINUE
|
|
*
|
|
DO 20 I = LLL + 1, 80
|
|
LINE( I: I ) = ' '
|
|
20 CONTINUE
|
|
*
|
|
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
|
|
9999 FORMAT( / 1X, A, / 1X, A )
|
|
*
|
|
IF( N.LE.0 )
|
|
$ RETURN
|
|
NDIGIT = IDIGIT
|
|
IF( IDIGIT.EQ.0 )
|
|
$ NDIGIT = 4
|
|
*
|
|
*=======================================================================
|
|
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
|
|
*=======================================================================
|
|
*
|
|
IF( IDIGIT.LT.0 ) THEN
|
|
NDIGIT = -IDIGIT
|
|
IF( NDIGIT.LE.4 ) THEN
|
|
DO 30 K1 = 1, N, 5
|
|
K2 = MIN0( N, K1+4 )
|
|
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
30 CONTINUE
|
|
ELSE IF( NDIGIT.LE.6 ) THEN
|
|
DO 40 K1 = 1, N, 4
|
|
K2 = MIN0( N, K1+3 )
|
|
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
40 CONTINUE
|
|
ELSE IF( NDIGIT.LE.10 ) THEN
|
|
DO 50 K1 = 1, N, 3
|
|
K2 = MIN0( N, K1+2 )
|
|
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
50 CONTINUE
|
|
ELSE
|
|
DO 60 K1 = 1, N, 2
|
|
K2 = MIN0( N, K1+1 )
|
|
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
60 CONTINUE
|
|
END IF
|
|
*
|
|
*=======================================================================
|
|
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
|
|
*=======================================================================
|
|
*
|
|
ELSE
|
|
IF( NDIGIT.LE.4 ) THEN
|
|
DO 70 K1 = 1, N, 10
|
|
K2 = MIN0( N, K1+9 )
|
|
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
70 CONTINUE
|
|
ELSE IF( NDIGIT.LE.6 ) THEN
|
|
DO 80 K1 = 1, N, 8
|
|
K2 = MIN0( N, K1+7 )
|
|
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
80 CONTINUE
|
|
ELSE IF( NDIGIT.LE.10 ) THEN
|
|
DO 90 K1 = 1, N, 6
|
|
K2 = MIN0( N, K1+5 )
|
|
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
90 CONTINUE
|
|
ELSE
|
|
DO 100 K1 = 1, N, 5
|
|
K2 = MIN0( N, K1+4 )
|
|
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
|
|
100 CONTINUE
|
|
END IF
|
|
END IF
|
|
WRITE( LOUT, FMT = 9994 )
|
|
RETURN
|
|
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 )
|
|
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 )
|
|
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 )
|
|
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 )
|
|
9994 FORMAT( 1X, ' ' )
|
|
END
|