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