OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pdsvddriver.f
Go to the documentation of this file.
1 PROGRAM pdsvddriver
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 Double precision 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 PDSVDTST.
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 DOUBLE PRECISION 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 DOUBLE PRECISION work( MEMSIZ )
60* ..
61* .. External Subroutines ..
62 EXTERNAL blacs_exit, blacs_get, blacs_gridexit,
63 $ blacs_gridinit, blacs_pinfo, blacs_setup,
64 $ dgebr2d, dgebs2d, igebr2d, igebs2d, pdsvdtst
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 dgebs2d( context, 'All', ' ', 1, 1, thresh, 1 )
141 ELSE
142 CALL dgebr2d( context, 'All', ' ', 1, 1, thresh, 1, 0, 0 )
143 END IF
144 IF( thresh.EQ.-1 ) THEN
145 GO TO 80
146 END IF
147*
148 IF( iam.EQ.0 ) 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 IF( nmatsizes.LT.1 .OR. nmatsizes.GT.maxsetsize ) THEN
156 IF( iam.EQ.0 ) 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 IF( iam.EQ.0 ) 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 IF( iam.EQ.0 ) 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 IF( iam.EQ.0 ) 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 IF( npconfigs.LT.1 .OR. npconfigs.GT.maxsetsize ) THEN
190 IF( iam.EQ.0 ) 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 IF( npcols( i ).LE.0 )
234 $ err = -1
235 30 CONTINUE
236 IF( err.EQ.-1 ) THEN
237 IF( iam.EQ.0 ) 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 IF( iam.EQ.0 ) 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 IF( nbs( i ).LE.0 )
254 $ err = -1
255 40 CONTINUE
256 IF( err.EQ.-1 ) THEN
257 IF( iam.EQ.0 ) 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 pdsvdtst( 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 IF( iam.EQ.0 ) 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 PDSVDDRIVER
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: PDGESVD' )
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 pdsvdtst.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( ' for jobtype.NE.1 (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
if
if(complex_arithmetic) id
the
end diagonal values have been computed in the(sparse) matrix id.SOL
max
#define max(a, b)
Definition macros.h:21
blacs_gridinit
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
dgebs2d
subroutine dgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1082
dgebr2d
subroutine dgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1123
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
pdgesvd
subroutine pdgesvd(jobu, jobvt, m, n, a, ia, ja, desca, s, u, iu, ju, descu, vt, ivt, jvt, descvt, work, lwork, info)
Definition pdgesvd.f:4
pdsvdcmp
subroutine pdsvdcmp(m, n, jobtype, s, sc, u, uc, iu, ju, descu, vt, vtc, ivt, jvt, descvt, thresh, result, delta, work, lwork)
Definition pdsvdcmp.f:4
pdsvddriver
program pdsvddriver
Definition pdsvddriver.f:1
pdsvdtst
subroutine pdsvdtst(m, n, nprow, npcol, nb, iseed, thresh, work, result, lwork, nout)
Definition pdsvdtst.f:3
split
void split(mapping_t *, PORD_INT, PORD_INT, PORD_INT, PORD_INT *, PORD_INT *, FLOAT *, PORD_INT)