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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
|
PROGRAM PSSVDDRIVER
*
* -- ScaLAPACK testing driver (version 1.7) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* Purpose
* ========
*
* Parallel Real singular value decomposition test driver.
*
* INPUT:
* =====
* This routine tests PDGESVD, the parallel singular value
* decomposition solver. We would like to cover possible combinations
* of: matrix size, process configuration (nprow and npcol), block
* size (nb), matrix type, and workspace available.
*
* Current format of the input file SVD.dat lists the following:
* device out
* Threshold
* number of matrices
* number of rows for every matrix
* number of columns for every matrix
* number of process configurations (P, Q, NB)
* values of P (NPROW) for every configuration
* values of Q (NPCOL) for every configuration
* values of NB for every configuration.
* Here threshold is an integer constant with a value between 1 and
* 100, which meaning is explained in comments to PSSVDTST.
*
* WHAT IT DOES:
* ============
* PSVDDRIVER checks floating-point arithmetic and parameters
* provided by the user in initialization file SVD.dat. It reads and
* broadcasts to all process parameters required to run actual testing
* code PSVDTST. In case all tests are successful it tells you so. For
* the actual "meat" of the tests see comments to PSVDTST.
*
*=======================================================================
*
* .. Local Scalars ..
CHARACTER*80 SUMMARY
INTEGER CONTEXT, ERR, I, IAM, J, K, LWORK, MAXNODES,
$ NMATSIZES, NOUT, NPCONFIGS, NPROCS
REAL THRESH
* ..
* .. Parameters ..
INTEGER MAXSETSIZE, NIN, DBLSIZ, TOTMEM, MEMSIZ
PARAMETER ( MAXSETSIZE = 50, NIN = 11, DBLSIZ = 8,
$ TOTMEM = 2000000, MEMSIZ = TOTMEM / DBLSIZ )
* ..
* .. Local Arrays ..
INTEGER ISEED( 4 ), MM( MAXSETSIZE ),
$ NBS( MAXSETSIZE ), NN( MAXSETSIZE ),
$ NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE ),
$ RESULT( 9 )
REAL WORK( MEMSIZ )
* ..
* .. External Subroutines ..
EXTERNAL BLACS_EXIT, BLACS_GET, BLACS_GRIDEXIT,
$ BLACS_GRIDINIT, BLACS_PINFO, BLACS_SETUP,
$ SGEBR2D, SGEBS2D, IGEBR2D, IGEBS2D, PSSVDTST
* ..
* .. Executable Statements ..
*
* Get starting information.
*
CALL BLACS_PINFO( IAM, NPROCS )
*
* Open file and skip data header; read output device.
*
IF( IAM.EQ.0 ) THEN
OPEN( UNIT = NIN, FILE = 'SVD.dat', STATUS = 'OLD' )
READ( NIN, FMT = * )SUMMARY
READ( NIN, FMT = * )NOUT
READ( NIN, FMT = * )MAXNODES
END IF
*
IF( NPROCS.LT.1 ) THEN
CALL BLACS_SETUP( IAM, MAXNODES )
NPROCS = MAXNODES
END IF
*
CALL BLACS_GET( -1, 0, CONTEXT )
CALL BLACS_GRIDINIT( CONTEXT, 'R', 1, NPROCS )
*
* Initialize variables, arrays, and grids.
*
ERR = 0
NMATSIZES = 0
NPCONFIGS = 0
LWORK = MEMSIZ
ISEED( 1 ) = 139
ISEED( 2 ) = 1139
ISEED( 3 ) = 2139
ISEED( 4 ) = 3139
*
IF( IAM.EQ.0 ) THEN
WRITE( NOUT, FMT = 9992 )
WRITE( NOUT, FMT = 9991 )
WRITE( NOUT, FMT = 9990 )
WRITE( NOUT, FMT = 9989 )
WRITE( NOUT, FMT = 9988 )
WRITE( NOUT, FMT = 9987 )
WRITE( NOUT, FMT = 9986 )
WRITE( NOUT, FMT = 9985 )
WRITE( NOUT, FMT = 9984 )
WRITE( NOUT, FMT = 9983 )
WRITE( NOUT, FMT = 9982 )
WRITE( NOUT, FMT = 9981 )
WRITE( NOUT, FMT = 9980 )
WRITE( NOUT, FMT = 9979 )
WRITE( NOUT, FMT = 9978 )
WRITE( NOUT, FMT = 9977 )
WRITE( NOUT, FMT = 9976 )
WRITE( NOUT, FMT = 9975 )
WRITE( NOUT, FMT = 9974 )
WRITE( NOUT, FMT = 9973 )
WRITE( NOUT, FMT = 9972 )
WRITE( NOUT, FMT = 9971 )
WRITE( NOUT, FMT = 9970 )
WRITE( NOUT, FMT = 9969 )
WRITE( NOUT, FMT = 9968 )
WRITE( NOUT, FMT = 9967 )
WRITE( NOUT, FMT = 9966 )
WRITE( NOUT, FMT = 9965 )
END IF
*
* Process 0 reads values in input file and broadcasts them to
* all other processes.
*
10 CONTINUE
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )SUMMARY
READ( NIN, FMT = * )SUMMARY
READ( NIN, FMT = * )THRESH
WRITE( NOUT, FMT = 9965 )SUMMARY
CALL SGEBS2D( CONTEXT, 'All', ' ', 1, 1, THRESH, 1 )
ELSE
CALL SGEBR2D( CONTEXT, 'All', ' ', 1, 1, THRESH, 1, 0, 0 )
END IF
IF( THRESH.EQ.-1 ) THEN
GO TO 80
END IF
*
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )NMATSIZES
CALL IGEBS2D( CONTEXT, 'All', ' ', 1, 1, NMATSIZES, 1 )
ELSE
CALL IGEBR2D( CONTEXT, 'All', ' ', 1, 1, NMATSIZES, 1, 0, 0 )
END IF
* Deal with error
IF( NMATSIZES.LT.1 .OR. NMATSIZES.GT.MAXSETSIZE ) THEN
IF( IAM.EQ.0 ) THEN
WRITE( NOUT, FMT = 9999 )'Matrix size', NMATSIZES, 1,
$ MAXSETSIZE
END IF
ERR = -1
GO TO 80
END IF
*
* Read array of MATSIZES.
*
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )( MM( I ), I = 1, NMATSIZES )
CALL IGEBS2D( CONTEXT, 'All', ' ', 1, NMATSIZES, MM, 1 )
ELSE
CALL IGEBR2D( CONTEXT, 'All', ' ', 1, NMATSIZES, MM, 1, 0, 0 )
END IF
*
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )( NN( I ), I = 1, NMATSIZES )
CALL IGEBS2D( CONTEXT, 'All', ' ', 1, NMATSIZES, NN, 1 )
ELSE
CALL IGEBR2D( CONTEXT, 'All', ' ', 1, NMATSIZES, NN, 1, 0, 0 )
END IF
*
* Read and broadcast NPCONFIGS.
*
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )NPCONFIGS
CALL IGEBS2D( CONTEXT, 'All', ' ', 1, 1, NPCONFIGS, 1 )
ELSE
CALL IGEBR2D( CONTEXT, 'All', ' ', 1, 1, NPCONFIGS, 1, 0, 0 )
END IF
* Deal with error
IF( NPCONFIGS.LT.1 .OR. NPCONFIGS.GT.MAXSETSIZE ) THEN
IF( IAM.EQ.0 ) THEN
WRITE( NOUT, FMT = 9999 )'# proc configs', NPCONFIGS, 1,
$ MAXSETSIZE
END IF
ERR = -1
GO TO 80
END IF
*
* Read and broadcast array of NPROWS.
*
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )( NPROWS( I ), I = 1, NPCONFIGS )
*
CALL IGEBS2D( CONTEXT, 'All', ' ', 1, NPCONFIGS, NPROWS, 1 )
ELSE
CALL IGEBR2D( CONTEXT, 'All', ' ', 1, NPCONFIGS, NPROWS, 1, 0,
$ 0 )
END IF
* Deal with error
DO 20 I = 1, NPCONFIGS
IF( NPROWS( I ).LE.0 )
$ ERR = -1
20 CONTINUE
IF( ERR.EQ.-1 ) THEN
IF( IAM.EQ.0 ) THEN
WRITE( NOUT, FMT = 9997 )' NPROW'
END IF
GO TO 80
END IF
*
* Read and broadcast array of NPCOLS.
*
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )( NPCOLS( I ), I = 1, NPCONFIGS )
CALL IGEBS2D( CONTEXT, 'All', ' ', 1, NPCONFIGS, NPCOLS, 1 )
ELSE
CALL IGEBR2D( CONTEXT, 'All', ' ', 1, NPCONFIGS, NPCOLS, 1, 0,
$ 0 )
END IF
*
* Deal with error.
*
DO 30 I = 1, NPCONFIGS
IF( NPCOLS( I ).LE.0 )
$ ERR = -1
30 CONTINUE
IF( ERR.EQ.-1 ) THEN
IF( IAM.EQ.0 ) THEN
WRITE( NOUT, FMT = 9997 )' NPCOL'
END IF
GO TO 80
END IF
*
* Read and broadcast array of NBs.
*
IF( IAM.EQ.0 ) THEN
READ( NIN, FMT = * )( NBS( I ), I = 1, NPCONFIGS )
CALL IGEBS2D( CONTEXT, 'All', ' ', 1, NPCONFIGS, NBS, 1 )
ELSE
CALL IGEBR2D( CONTEXT, 'All', ' ', 1, NPCONFIGS, NBS, 1, 0, 0 )
END IF
* Deal with error
DO 40 I = 1, NPCONFIGS
IF( NBS( I ).LE.0 )
$ ERR = -1
40 CONTINUE
IF( ERR.EQ.-1 ) THEN
IF( IAM.EQ.0 ) THEN
WRITE( NOUT, FMT = 9997 )' NB'
END IF
GO TO 80
END IF
*
DO 70 J = 1, NMATSIZES
DO 60 I = 1, NPCONFIGS
*
DO 50 K = 1, 9
RESULT( K ) = 0
50 CONTINUE
CALL PSSVDTST( MM( J ), NN( J ), NPROWS( I ), NPCOLS( I ),
$ NBS( I ), ISEED, THRESH, WORK, RESULT, LWORK,
$ NOUT )
*
60 CONTINUE
70 CONTINUE
*
GO TO 10
*
80 CONTINUE
IF( IAM.EQ.0 ) THEN
CLOSE ( NIN )
CLOSE ( NOUT )
END IF
*
CALL BLACS_GRIDEXIT( CONTEXT )
*
CALL BLACS_EXIT( 0 )
STOP
*
* End of PSSVDDRIVER
*
9999 FORMAT( A20, ' is:', I5, ' must be between:', I5, ' and', I5 )
9998 FORMAT( A )
9997 FORMAT( A20, ' must be positive' )
9996 FORMAT( A )
9995 FORMAT( 'M = ', I5, ' N = ', I5, ' NPOW = ', I5, 'NPCOL = ', I5,
$ ' NB = ', I5 )
*
9994 FORMAT( 'Test #', I5, 'for this configuration has failed' )
9993 FORMAT( 'All test passed for this configuration' )
9992 FORMAT( ' ' )
9991 FORMAT( 'Running tests of the parallel singular value ',
$ 'decomposition routine: PSGESVD' )
9990 FORMAT( 'The following scaled residual checks will be',
$ 'computed:' )
9989 FORMAT( ' || A - U*diag(S)*VT ||/( ||A||*max(M,N)*ulp )' )
9988 FORMAT( ' || I - UT*U ||/( M*ulp )' )
9987 FORMAT( ' || I - VT*V ||/( N*ulp )' )
9986 FORMAT( ' ' )
9985 FORMAT( 'An explanation of the input/output parameters',
$ ' follows:' )
9984 FORMAT( 'RESULT : passed; or an indication of which',
$ ' jobtype test failed' )
9983 FORMAT( 'M : The number of rows of the matrix A.' )
9982 FORMAT( 'N : The number of columns of the matrix A.' )
9981 FORMAT( 'P : The number of process rows.' )
9980 FORMAT( 'Q : The number of process columns.' )
9979 FORMAT( 'NB : The size of the square blocks the',
$ ' matrix A is split into.' )
9978 FORMAT( 'THRESH : If a residual value is less than ',
$ ' THRESH, RESULT is flagged as PASSED.' )
9977 FORMAT( 'MTYPE : matrix type (see pssvdtst.f).' )
9976 FORMAT( 'CHK : || A - U*diag(S)*VT ||/( ||A||',
$ '*max(M,N)*ulp )' )
9975 FORMAT( 'MTM : maximum of two values:',/,
$ ' || I - UT*U ||/( M*ulp ) and',
$ ' || I - VT*V ||/( N*ulp )' )
9974 FORMAT( 'DELTA : maximum of three values:',/,
$ ' || U - UC ||/( M*ulp*THRESH ),' )
9973 FORMAT( ' || VT - VTC ||/( N*ulp*THRESH ), and' )
9972 FORMAT( ' || S - SC || / ( SIZE*ulp*|S|*THRESH ), ' )
9971 FORMAT( ' where UC, VTC, SC are singular vectors ',
$ 'and values' )
9970 FORMAT( ' for JOBTYPE.NE.1 (see pdsvdcmp.f) ' )
9969 FORMAT( 'HET : P if heterogeneity was detected by PDGESVD' )
9968 FORMAT( ' T if detected by the PDSVSTST, N if',
$ ' undetected' )
9967 FORMAT( ' ' )
9966 FORMAT( 'RESULT WALL CPU M N P Q',
$ ' NB MTYPE CHK MTM DELTA HET' )
9965 FORMAT( A )
END
|
