OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pssvddriver.f
Go to the documentation of this file.
1 PROGRAM pssvddriver
2*
3* -- ScaLAPACK testing driver (version 1.7) --
4* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5* and University of California, Berkeley.
6* May 1, 1997
7*
8* Purpose
9* ========
10*
11* Parallel Real singular value decomposition test driver.
12*
13* INPUT:
14* =====
15* This routine tests PDGESVD, the parallel singular value
16* decomposition solver. We would like to cover possible combinations
17* of: matrix size, process configuration (nprow and npcol), block
18* size (nb), matrix type, and workspace available.
19*
20* Current format of the input file SVD.dat lists the following:
21* device out
22* Threshold
23* number of matrices
24* number of rows for every matrix
25* number of columns for every matrix
26* number of process configurations (P, Q, NB)
27* values of P (NPROW) for every configuration
28* values of Q (NPCOL) for every configuration
29* values of NB for every configuration.
30* Here threshold is an integer constant with a value between 1 and
31* 100, which meaning is explained in comments to PSSVDTST.
32*
33* WHAT IT DOES:
34* ============
35* PSVDDRIVER checks floating-point arithmetic and parameters
36* provided by the user in initialization file SVD.dat. It reads and
37* broadcasts to all process parameters required to run actual testing
38* code PSVDTST. In case all tests are successful it tells you so. For
39* the actual "meat" of the tests see comments to PSVDTST.
40*
41*=======================================================================
42*
43* .. Local Scalars ..
44 CHARACTER*80 summary
45 INTEGER context, err, i, iam, j, k, lwork, maxnodes,
46 $ nmatsizes, nout, npconfigs, nprocs
47 REAL thresh
48* ..
49* .. Parameters ..
50 INTEGER maxsetsize, nin, dblsiz, totmem, memsiz
51 parameter( maxsetsize = 50, nin = 11, dblsiz = 8,
52 $ totmem = 2000000, memsiz = totmem / dblsiz )
53* ..
54* .. Local Arrays ..
55 INTEGER iseed( 4 ), mm( maxsetsize ),
56 $ nbs( maxsetsize ), nn( maxsetsize ),
57 $ npcols( maxsetsize ), nprows( maxsetsize ),
58 $ result( 9 )
59 REAL work( memsiz )
60* ..
61* .. External Subroutines ..
62 EXTERNAL blacs_exit, blacs_get, blacs_gridexit,
63 $ blacs_gridinit, blacs_pinfo, blacs_setup,
64 $ sgebr2d, sgebs2d, igebr2d, igebs2d, pssvdtst
65* ..
66* .. Executable Statements ..
67*
68* Get starting information.
69*
70 CALL blacs_pinfo( iam, nprocs )
71*
72* Open file and skip data header; read output device.
73*
74 IF( iam.EQ.0 ) THEN
75 OPEN( unit = nin, file = 'SVD.dat', status = 'OLD' )
76 READ( nin, fmt = * )summary
77 READ( nin, fmt = * )nout
78 READ( nin, fmt = * )maxnodes
79 END IF
80*
81 IF( nprocs.LT.1 ) THEN
82 CALL blacs_setup( iam, maxnodes )
83 nprocs = maxnodes
84 END IF
85*
86 CALL blacs_get( -1, 0, context )
87 CALL blacs_gridinit( context, 'R', 1, nprocs )
88*
89* Initialize variables, arrays, and grids.
90*
91 err = 0
92 nmatsizes = 0
93 npconfigs = 0
94 lwork = memsiz
95 iseed( 1 ) = 139
96 iseed( 2 ) = 1139
97 iseed( 3 ) = 2139
98 iseed( 4 ) = 3139
99*
100 IF( iam.EQ.0 ) THEN
101 WRITE( nout, fmt = 9992 )
102 WRITE( nout, fmt = 9991 )
103 WRITE( nout, fmt = 9990 )
104 WRITE( nout, fmt = 9989 )
105 WRITE( nout, fmt = 9988 )
106 WRITE( nout, fmt = 9987 )
107 WRITE( nout, fmt = 9986 )
108 WRITE( nout, fmt = 9985 )
109 WRITE( nout, fmt = 9984 )
110 WRITE( nout, fmt = 9983 )
111 WRITE( nout, fmt = 9982 )
112 WRITE( nout, fmt = 9981 )
113 WRITE( nout, fmt = 9980 )
114 WRITE( nout, fmt = 9979 )
115 WRITE( nout, fmt = 9978 )
116 WRITE( nout, fmt = 9977 )
117 WRITE( nout, fmt = 9976 )
118 WRITE( nout, fmt = 9975 )
119 WRITE( nout, fmt = 9974 )
120 WRITE( nout, fmt = 9973 )
121 WRITE( nout, fmt = 9972 )
122 WRITE( nout, fmt = 9971 )
123 WRITE( nout, fmt = 9970 )
124 WRITE( nout, fmt = 9969 )
125 WRITE( nout, fmt = 9968 )
126 WRITE( nout, fmt = 9967 )
127 WRITE( nout, fmt = 9966 )
128 WRITE( nout, fmt = 9965 )
129 END IF
130*
131* Process 0 reads values in input file and broadcasts them to
132* all other processes.
133*
134 10 CONTINUE
135 IF( iam.EQ.0 ) THEN
136 READ( nin, fmt = * )summary
137 READ( nin, fmt = * )summary
138 READ( nin, fmt = * )thresh
139 WRITE( nout, fmt = 9965 )summary
140 CALL sgebs2d( context, 'all', ' ', 1, 1, THRESH, 1 )
141 ELSE
142 CALL SGEBR2D( CONTEXT, 'all', ' ', 1, 1, THRESH, 1, 0, 0 )
143 END IF
144.EQ. IF( THRESH-1 ) THEN
145 GO TO 80
146 END IF
147*
148.EQ. IF( IAM0 ) THEN
149 READ( NIN, FMT = * )NMATSIZES
150 CALL IGEBS2D( CONTEXT, 'all', ' ', 1, 1, NMATSIZES, 1 )
151 ELSE
152 CALL IGEBR2D( CONTEXT, 'all', ' ', 1, 1, NMATSIZES, 1, 0, 0 )
153 END IF
154* Deal with error
155.LT..OR..GT. IF( NMATSIZES1 NMATSIZESMAXSETSIZE ) THEN
156.EQ. IF( IAM0 ) THEN
157 WRITE( NOUT, FMT = 9999 )'matrix size', NMATSIZES, 1,
158 $ MAXSETSIZE
159 END IF
160 ERR = -1
161 GO TO 80
162 END IF
163*
164* Read array of MATSIZES.
165*
166.EQ. IF( IAM0 ) THEN
167 READ( NIN, FMT = * )( MM( I ), I = 1, NMATSIZES )
168 CALL IGEBS2D( CONTEXT, 'all', ' ', 1, NMATSIZES, MM, 1 )
169 ELSE
170 CALL IGEBR2D( CONTEXT, 'all', ' ', 1, NMATSIZES, MM, 1, 0, 0 )
171 END IF
172*
173.EQ. IF( IAM0 ) THEN
174 READ( NIN, FMT = * )( NN( I ), I = 1, NMATSIZES )
175 CALL IGEBS2D( CONTEXT, 'all', ' ', 1, NMATSIZES, NN, 1 )
176 ELSE
177 CALL IGEBR2D( CONTEXT, 'all', ' ', 1, NMATSIZES, NN, 1, 0, 0 )
178 END IF
179*
180* Read and broadcast NPCONFIGS.
181*
182.EQ. IF( IAM0 ) THEN
183 READ( NIN, FMT = * )NPCONFIGS
184 CALL IGEBS2D( CONTEXT, 'all', ' ', 1, 1, NPCONFIGS, 1 )
185 ELSE
186 CALL IGEBR2D( CONTEXT, 'all', ' ', 1, 1, NPCONFIGS, 1, 0, 0 )
187 END IF
188* Deal with error
189.LT..OR..GT. IF( NPCONFIGS1 NPCONFIGSMAXSETSIZE ) THEN
190.EQ. IF( IAM0 ) THEN
191 WRITE( NOUT, FMT = 9999 )'# proc configs', NPCONFIGS, 1,
192 $ maxsetsize
193 END IF
194 err = -1
195 GO TO 80
196 END IF
197*
198* Read and broadcast array of NPROWS.
199*
200 IF( iam.EQ.0 ) THEN
201 READ( nin, fmt = * )( nprows( i ), i = 1, npconfigs )
202*
203 CALL igebs2d( context, 'All', ' ', 1, npconfigs, nprows, 1 )
204 ELSE
205 CALL igebr2d( context, 'All', ' ', 1, npconfigs, nprows, 1, 0,
206 $ 0 )
207 END IF
208* Deal with error
209 DO 20 i = 1, npconfigs
210 IF( nprows( i ).LE.0 )
211 $ err = -1
212 20 CONTINUE
213 IF( err.EQ.-1 ) THEN
214 IF( iam.EQ.0 ) THEN
215 WRITE( nout, fmt = 9997 )' NPROW'
216 END IF
217 GO TO 80
218 END IF
219*
220* Read and broadcast array of NPCOLS.
221*
222 IF( iam.EQ.0 ) THEN
223 READ( nin, fmt = * )( npcols( i ), i = 1, npconfigs )
224 CALL igebs2d( context, 'All', ' ', 1, NPCONFIGS, NPCOLS, 1 )
225 ELSE
226 CALL IGEBR2D( CONTEXT, 'all', ' ', 1, NPCONFIGS, NPCOLS, 1, 0,
227 $ 0 )
228 END IF
229*
230* Deal with error.
231*
232 DO 30 I = 1, NPCONFIGS
233.LE. IF( NPCOLS( I )0 )
234 $ ERR = -1
235 30 CONTINUE
236.EQ. IF( ERR-1 ) THEN
237.EQ. IF( IAM0 ) THEN
238 WRITE( NOUT, FMT = 9997 )' npcol'
239 END IF
240 GO TO 80
241 END IF
242*
243* Read and broadcast array of NBs.
244*
245.EQ. IF( IAM0 ) THEN
246 READ( NIN, FMT = * )( NBS( I ), I = 1, NPCONFIGS )
247 CALL IGEBS2D( CONTEXT, 'all', ' ', 1, NPCONFIGS, NBS, 1 )
248 ELSE
249 CALL IGEBR2D( CONTEXT, 'all', ' ', 1, NPCONFIGS, NBS, 1, 0, 0 )
250 END IF
251* Deal with error
252 DO 40 I = 1, NPCONFIGS
253.LE. IF( NBS( I )0 )
254 $ ERR = -1
255 40 CONTINUE
256.EQ. IF( ERR-1 ) THEN
257.EQ. IF( IAM0 ) THEN
258 WRITE( NOUT, FMT = 9997 )' nb'
259 END IF
260 GO TO 80
261 END IF
262*
263 DO 70 J = 1, NMATSIZES
264 DO 60 I = 1, NPCONFIGS
265*
266 DO 50 K = 1, 9
267 RESULT( K ) = 0
268 50 CONTINUE
269 CALL PSSVDTST( MM( J ), NN( J ), NPROWS( I ), NPCOLS( I ),
270 $ NBS( I ), ISEED, THRESH, WORK, RESULT, LWORK,
271 $ NOUT )
272*
273 60 CONTINUE
274 70 CONTINUE
275*
276 GO TO 10
277*
278 80 CONTINUE
279.EQ. IF( IAM0 ) THEN
280 CLOSE ( NIN )
281 CLOSE ( NOUT )
282 END IF
283*
284 CALL BLACS_GRIDEXIT( CONTEXT )
285*
286 CALL BLACS_EXIT( 0 )
287 STOP
288*
289* End of PSSVDDRIVER
290*
291 9999 FORMAT( A20, ' is:', I5, ' must be between:', I5, ' and', I5 )
292 9998 FORMAT( A )
293 9997 FORMAT( A20, ' must be positive' )
294 9996 FORMAT( A )
295 9995 FORMAT( 'm = ', I5, ' n = ', I5, ' npow = ', I5, 'npcol = ', I5,
296 $ ' nb = ', I5 )
297*
298 9994 FORMAT( 'test #', I5, 'for this configuration has failed' )
299 9993 FORMAT( 'All test passed for this configuration' )
300 9992 FORMAT( ' ' )
301 9991 FORMAT( 'Running tests of the parallel singular value ',
302 $ 'decomposition routine: PSGESVD' )
303 9990 FORMAT( 'The following scaled residual checks will be',
304 $ 'computed:' )
305 9989 FORMAT( ' || A - U*diag(S)*VT ||/( ||A||*max(M,N)*ulp )' )
306 9988 FORMAT( ' || I - UT*U ||/( M*ulp )' )
307 9987 FORMAT( ' || I - VT*V ||/( N*ulp )' )
308 9986 FORMAT( ' ' )
309 9985 FORMAT( 'An explanation of the input/output parameters',
310 $ ' follows:' )
311 9984 FORMAT( 'RESULT : passed; or an indication of which',
312 $ ' jobtype test failed' )
313 9983 FORMAT( 'M : The number of rows of the matrix A.' )
314 9982 FORMAT( 'N : The number of columns of the matrix A.' )
315 9981 FORMAT( 'P : The number of process rows.' )
316 9980 FORMAT( 'Q : The number of process columns.' )
317 9979 FORMAT( 'NB : The size of the square blocks the',
318 $ ' matrix A is split into.' )
319 9978 FORMAT( 'THRESH : If a residual value is less than ',
320 $ ' THRESH, RESULT is flagged as PASSED.' )
321 9977 FORMAT( 'MTYPE : matrix type (see pssvdtst.f).' )
322 9976 FORMAT( 'CHK : || A - U*diag(S)*VT ||/( ||A||',
323 $ '*max(M,N)*ulp )' )
324 9975 FORMAT( 'MTM : maximum of two values:',/,
325 $ ' || I - UT*U ||/( M*ulp ) and',
326 $ ' || I - VT*V ||/( N*ulp )' )
327 9974 FORMAT( 'DELTA : maximum of three values:',/,
328 $ ' || U - UC ||/( M*ulp*THRESH ),' )
329 9973 FORMAT( ' || VT - VTC ||/( N*ulp*THRESH ), and' )
330 9972 FORMAT( ' || S - SC || / ( SIZE*ulp*|S|*THRESH ), ' )
331 9971 FORMAT( ' where UC, VTC, SC are singular vectors ',
332 $ 'and values' )
333 9970 FORMAT( .NE.' for JOBTYPE1 (see pdsvdcmp.f) ' )
334 9969 FORMAT( 'HET : P if heterogeneity was detected by PDGESVD' )
335 9968 FORMAT( ' T if detected by the PDSVSTST, N if',
336 $ ' undetected' )
337 9967 FORMAT( ' ' )
338 9966 FORMAT( 'RESULT WALL CPU M N P Q',
339 $ ' NB MTYPE CHK MTM DELTA HET' )
340 9965 FORMAT( a )
341 END
sgebs2d
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1072
blacs_gridinit
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
sgebr2d
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762
pssvddriver
program pssvddriver
Definition pssvddriver.f:1
pssvdtst
subroutine pssvdtst(m, n, nprow, npcol, nb, iseed, thresh, work, result, lwork, nout)
Definition pssvdtst.f:3