Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/arpack/cmout.f
5196 views
1
*
2
* Routine: CMOUT
3
*
4
* Purpose: Complex matrix output routine.
5
*
6
* Usage: CALL CMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
7
*
8
* Arguments
9
* M - Number of rows of A. (Input)
10
* N - Number of columns of A. (Input)
11
* A - Complex M by N matrix to be printed. (Input)
12
* LDA - Leading dimension of A exactly as specified in the
13
* dimension statement of the calling program. (Input)
14
* IFMT - Format to be used in printing matrix A. (Input)
15
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
16
* If IDIGIT .LT. 0, printing is done with 72 columns.
17
* If IDIGIT .GT. 0, printing is done with 132 columns.
18
*
19
*\SCCS Information: @(#)
20
* FILE: cmout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2
21
*
22
*-----------------------------------------------------------------------
23
*
24
SUBROUTINE CMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
25
* ...
26
* ... SPECIFICATIONS FOR ARGUMENTS
27
INTEGER M, N, IDIGIT, LDA, LOUT
28
Complex
29
& A( LDA, * )
30
CHARACTER IFMT*( * )
31
* ...
32
* ... SPECIFICATIONS FOR LOCAL VARIABLES
33
INTEGER I, J, NDIGIT, K1, K2, LLL
34
CHARACTER*1 ICOL( 3 )
35
CHARACTER*80 LINE
36
* ...
37
* ... SPECIFICATIONS INTRINSICS
38
INTRINSIC MIN
39
*
40
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
41
$ 'l' /
42
* ...
43
* ... FIRST EXECUTABLE STATEMENT
44
*
45
LLL = MIN( LEN( IFMT ), 80 )
46
DO 10 I = 1, LLL
47
LINE( I: I ) = '-'
48
10 CONTINUE
49
*
50
DO 20 I = LLL + 1, 80
51
LINE( I: I ) = ' '
52
20 CONTINUE
53
*
54
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
55
9999 FORMAT( / 1X, A / 1X, A )
56
*
57
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
58
$ RETURN
59
NDIGIT = IDIGIT
60
IF( IDIGIT.EQ.0 )
61
$ NDIGIT = 4
62
*
63
*=======================================================================
64
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
65
*=======================================================================
66
*
67
IF( IDIGIT.LT.0 ) THEN
68
NDIGIT = -IDIGIT
69
IF( NDIGIT.LE.4 ) THEN
70
DO 40 K1 = 1, N, 2
71
K2 = MIN0( N, K1+1 )
72
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
73
DO 30 I = 1, M
74
IF (K1.NE.N) THEN
75
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
76
ELSE
77
WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 )
78
END IF
79
30 CONTINUE
80
40 CONTINUE
81
*
82
ELSE IF( NDIGIT.LE.6 ) THEN
83
DO 60 K1 = 1, N, 2
84
K2 = MIN0( N, K1+1 )
85
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
86
DO 50 I = 1, M
87
IF (K1.NE.N) THEN
88
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
89
ELSE
90
WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 )
91
END IF
92
50 CONTINUE
93
60 CONTINUE
94
*
95
ELSE IF( NDIGIT.LE.8 ) THEN
96
DO 80 K1 = 1, N, 2
97
K2 = MIN0( N, K1+1 )
98
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
99
DO 70 I = 1, M
100
IF (K1.NE.N) THEN
101
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
102
ELSE
103
WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 )
104
END IF
105
70 CONTINUE
106
80 CONTINUE
107
*
108
ELSE
109
DO 100 K1 = 1, N
110
WRITE( LOUT, 9995 ) ICOL, K1
111
DO 90 I = 1, M
112
WRITE( LOUT, 9991 )I, A( I, K1 )
113
90 CONTINUE
114
100 CONTINUE
115
END IF
116
*
117
*=======================================================================
118
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
119
*=======================================================================
120
*
121
ELSE
122
IF( NDIGIT.LE.4 ) THEN
123
DO 120 K1 = 1, N, 4
124
K2 = MIN0( N, K1+3 )
125
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
126
DO 110 I = 1, M
127
IF ((K1+3).LE.N) THEN
128
WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 )
129
ELSE IF ((K1+3-N).EQ.1) THEN
130
WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 )
131
ELSE IF ((K1+3-N).EQ.2) THEN
132
WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 )
133
ELSE IF ((K1+3-N).EQ.3) THEN
134
WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 )
135
END IF
136
110 CONTINUE
137
120 CONTINUE
138
*
139
ELSE IF( NDIGIT.LE.6 ) THEN
140
DO 140 K1 = 1, N, 3
141
K2 = MIN0( N, K1+ 2)
142
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
143
DO 130 I = 1, M
144
IF ((K1+2).LE.N) THEN
145
WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 )
146
ELSE IF ((K1+2-N).EQ.1) THEN
147
WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 )
148
ELSE IF ((K1+2-N).EQ.2) THEN
149
WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 )
150
END IF
151
130 CONTINUE
152
140 CONTINUE
153
*
154
ELSE IF( NDIGIT.LE.8 ) THEN
155
DO 160 K1 = 1, N, 3
156
K2 = MIN0( N, K1+2 )
157
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
158
DO 150 I = 1, M
159
IF ((K1+2).LE.N) THEN
160
WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 )
161
ELSE IF ((K1+2-N).EQ.1) THEN
162
WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 )
163
ELSE IF ((K1+2-N).EQ.2) THEN
164
WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 )
165
END IF
166
150 CONTINUE
167
160 CONTINUE
168
*
169
ELSE
170
DO 180 K1 = 1, N, 2
171
K2 = MIN0( N, K1+1 )
172
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
173
DO 170 I = 1, M
174
IF ((K1+1).LE.N) THEN
175
WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 )
176
ELSE
177
WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 )
178
END IF
179
170 CONTINUE
180
180 CONTINUE
181
END IF
182
END IF
183
WRITE( LOUT, 9990 )
184
*
185
9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) )
186
9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) )
187
9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) )
188
9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) )
189
*
190
*========================================================
191
* FORMAT FOR 72 COLUMN
192
*========================================================
193
*
194
* DISPLAY 4 SIGNIFICANT DIGITS
195
*
196
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
197
9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
198
*
199
* DISPLAY 6 SIGNIFICANT DIGITS
200
*
201
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
202
9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
203
*
204
* DISPLAY 8 SIGNIFICANT DIGITS
205
*
206
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
207
9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
208
*
209
* DISPLAY 13 SIGNIFICANT DIGITS
210
*
211
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,')') )
212
9990 FORMAT( 1X, ' ' )
213
*
214
*
215
*========================================================
216
* FORMAT FOR 132 COLUMN
217
*========================================================
218
*
219
* DISPLAY 4 SIGNIFICANT DIGIT
220
*
221
9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',E10.3,',',E10.3,') ') )
222
9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E10.3,',',E10.3,') ') )
223
9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
224
9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
225
*
226
* DISPLAY 6 SIGNIFICANT DIGIT
227
*
228
9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E12.5,',',E12.5,') ') )
229
9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
230
9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
231
*
232
* DISPLAY 8 SIGNIFICANT DIGIT
233
*
234
9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E14.7,',',E14.7,') ') )
235
9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
236
9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
237
*
238
* DISPLAY 13 SIGNIFICANT DIGIT
239
*
240
9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E20.13,',',E20.13,
241
& ') '))
242
9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,
243
& ') '))
244
245
*
246
*
247
*
248
*
249
RETURN
250
END
251
252