ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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( .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
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