1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
*-----------------------------------------------------------------------
* 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
|
