ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pslsinfo.f
Go to the documentation of this file.
1  SUBROUTINE pslsinfo( SUMMRY, NOUT, NMAT, MVAL, LDMVAL,
2  $ NVAL, LDNVAL, NNB, NBVAL, LDNBVAL, NNR,
3  $ NRVAL, LDNRVAL, NNBR, NBRVAL, LDNBRVAL,
4  $ NGRIDS, PVAL, LDPVAL, QVAL, LDQVAL, THRESH,
5  $ WORK, IAM, NPROCS )
6 *
7 * -- ScaLAPACK routine (version 1.7) --
8 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
9 * and University of California, Berkeley.
10 * May 1, 1997
11 *
12 * .. Scalar Arguments ..
13  CHARACTER*( * ) SUMMRY
14  INTEGER IAM, LDMVAL, LDNBRVAL, LDNBVAL, LDNRVAL,
15  $ LDNVAL, LDPVAL, LDQVAL, NGRIDS, NMAT, NNB,
16  $ NNBR, NNR, NOUT, NPROCS
17  REAL THRESH
18 * ..
19 * .. Array Arguments ..
20  INTEGER MVAL( LDMVAL ), NBRVAL( LDNBRVAL ),
21  $ nbval( ldnbval ), nrval( ldnrval ),
22  $ nval( ldnval ), pval( ldpval ),
23  $ qval( ldqval ), work( * )
24 * ..
25 *
26 * Purpose
27 * =======
28 *
29 * PSLSINFO gets needed startup information for LS solve and
30 * transmits it to all processes.
31 *
32 * Arguments
33 * =========
34 *
35 * SUMMRY (global output) CHARACTER*(*)
36 * Name of output (summary) file (if any). Only defined for
37 * process 0.
38 *
39 * NOUT (global output) INTEGER
40 * The unit number for output file. NOUT = 6, ouput to screen,
41 * NOUT = 0, output to stderr. Only defined for process 0.
42 *
43 * NMAT (global output) INTEGER
44 * The number of different values that can be used for N.
45 *
46 * MVAL (global output) INTEGER array, dimension (LDNVAL)
47 * The values of M (number of rows in matrix) to run the code
48 * with.
49 *
50 * LDMVAL (global input) INTEGER
51 * The maximum number of different values that can be used for
52 * M, LDNVAL > = NMAT.
53 *
54 * NVAL (global output) INTEGER array, dimension (LDNVAL)
55 * The values of N (number of columns in matrix) to run the
56 * code with.
57 *
58 * LDNVAL (global input) INTEGER
59 * The maximum number of different values that can be used for
60 * N, LDNVAL > = NMAT.
61 *
62 * NNB (global output) INTEGER
63 * The number of different values that can be used for NB.
64 *
65 * NBVAL (global output) INTEGER array, dimension (LDNBVAL)
66 * The values of NB (blocksize) to run the code with.
67 *
68 * LDNBVAL (global input) INTEGER
69 * The maximum number of different values that can be used for
70 * NB, LDNBVAL >= NNB.
71 *
72 * NNR (global output) INTEGER
73 * The number of different values that can be used for NRHS.
74 *
75 * NRVAL (global output) INTEGER array, dimension(LDNRVAL)
76 * The values of NRHS (# of Right Hand Sides) to run the code
77 * with.
78 *
79 * LDNRVAL (global input) INTEGER
80 * The maximum number of different values that can be used for
81 * NRHS, LDNRVAL >= NNR.
82 *
83 * NNBR (global output) INTEGER
84 * The number of different values that can be used for NBRHS.
85 *
86 * NBRVAL (global output) INTEGER array, dimension (LDNBRVAL)
87 * The values of NBRHS (RHS blocksize) to run the code with.
88 *
89 * LDNBRVAL (global input) INTEGER
90 * The maximum number of different values that can be used for
91 * NBRHS, LDNBRVAL >= NBRVAL.
92 *
93 * NGRIDS (global output) INTEGER
94 * The number of different values that can be used for P & Q.
95 *
96 * PVAL (global output) INTEGER array, dimension (LDPVAL)
97 * The values of P (number of process rows) to run the code
98 * with.
99 *
100 * LDPVAL (global input) INTEGER
101 * The maximum number of different values that can be used for
102 * P, LDPVAL >= NGRIDS.
103 *
104 * QVAL (global output) INTEGER array, dimension (LDQVAL)
105 * The values of Q (number of process columns) to run the code
106 * with.
107 *
108 * LDQVAL (global input) INTEGER
109 * The maximum number of different values that can be used for
110 * Q, LDQVAL >= NGRIDS.
111 *
112 * THRESH (global output) REAL
113 * Indicates what error checks shall be run and printed out:
114 * < 0 : Perform no error checking
115 * > 0 : report all residuals greater than THRESH, perform
116 * factor check only if solve check fails
117 *
118 * WORK (workspace) INTEGER array of dimension >=
119 * MAX(5,LDMVAL+LDNVAL+LDNBVAL+LDNRVAL+LDNBRVAL+LDPVAL+LDQVAL)
120 * Used to pack all input arrays in order to send info in one
121 * message.
122 *
123 * IAM (local input) INTEGER
124 * My process number.
125 *
126 * NPROCS (global input) INTEGER
127 * The total number of processes.
128 *
129 * ======================================================================
130 *
131 * Note: For packing the information we assumed that the length in bytes
132 * ===== of an integer is equal to the length in bytes of a real single
133 * precision.
134 *
135 * ======================================================================
136 *
137 * .. Parameters ..
138  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
139  $ LLD_, MB_, M_, NB_, N_, RSRC_
140  PARAMETER ( BLOCK_CYCLIC_2D = 1, dlen_ = 9, dtype_ = 1,
141  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
142  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
143  INTEGER NIN
144  parameter( nin = 11 )
145 * ..
146 * .. Local Scalars ..
147  CHARACTER*79 USRINFO
148  INTEGER I, ICTXT
149  REAL EPS
150 * ..
151 * .. External Subroutines ..
152  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
153  $ blacs_gridinit, blacs_setup, icopy, igebr2d,
154  $ igebs2d, sgebr2d, sgebs2d
155 * ..
156 * .. External Functions ..
157  LOGICAL LSAME
158  REAL PSLAMCH
159  EXTERNAL LSAME, PSLAMCH
160 * ..
161 * .. Intrinsic Functions ..
162  INTRINSIC max, min
163 * ..
164 * .. Executable Statements ..
165 *
166 * Process 0 reads the input data, broadcasts to other processes and
167 * writes needed information to NOUT
168 *
169  IF( iam.EQ.0 ) THEN
170 *
171 * Open file and skip data file header
172 *
173  OPEN( nin, file='LS.dat', status='OLD' )
174  READ( nin, fmt = * ) summry
175  summry = ' '
176 *
177 * Read in user-supplied info about machine type, compiler, etc.
178 *
179  READ( nin, fmt = 9999 ) usrinfo
180 *
181 * Read name and unit number for summary output file
182 *
183  READ( nin, fmt = * ) summry
184  READ( nin, fmt = * ) nout
185  IF( nout.NE.0 .AND. nout.NE.6 )
186  $ OPEN( nout, file = summry, status = 'UNKNOWN' )
187 *
188 * Read and check the parameter values for the tests.
189 *
190 * Get number of matrices and their dimensions
191 *
192  READ( nin, fmt = * ) nmat
193  IF( nmat.LT.1 .OR. nmat.GT.ldnval ) THEN
194  WRITE( nout, fmt = 9994 ) 'N', ldnval
195  GO TO 20
196  ELSE IF( nmat.GT.ldmval ) THEN
197  WRITE( nout, fmt = 9994 ) 'M', ldmval
198  GO TO 20
199  END IF
200  READ( nin, fmt = * ) ( mval( i ), i = 1, nmat )
201  READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
202 *
203 * Get values of NB
204 *
205  READ( nin, fmt = * ) nnb
206  IF( nnb.LT.1 .OR. nnb.GT.ldnbval ) THEN
207  WRITE( nout, fmt = 9994 ) 'NB', ldnbval
208  GO TO 20
209  END IF
210  READ( nin, fmt = * ) ( nbval( i ), i = 1, nnb )
211 *
212 * Get values of NRHS
213 *
214  READ( nin, fmt = * ) nnr
215  IF( nnr.LT.1 .OR. nnr.GT.ldnrval ) THEN
216  WRITE( nout, fmt = 9994 ) 'NRHS', ldnrval
217  GO TO 20
218  END IF
219  READ( nin, fmt = * ) ( nrval( i ), i = 1, nnr )
220 *
221 * Get values of NBRHS
222 *
223  READ( nin, fmt = * ) nnbr
224  IF( nnbr.LT.1 .OR. nnbr.GT.ldnbrval ) THEN
225  WRITE( nout, fmt = 9994 ) 'NBRHS', ldnbrval
226  GO TO 20
227  END IF
228  READ( nin, fmt = * ) ( nbrval( i ), i = 1, nnbr )
229 *
230 * Get number of grids
231 *
232  READ( nin, fmt = * ) ngrids
233  IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
234  WRITE( nout, fmt = 9994 ) 'Grids', ldpval
235  GO TO 20
236  ELSE IF( ngrids.GT.ldqval ) THEN
237  WRITE( nout, fmt = 9994 ) 'Grids', ldqval
238  GO TO 20
239  END IF
240 *
241 * Get values of P and Q
242 *
243  READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
244  READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
245 *
246 * Get level of checking
247 *
248  READ( nin, fmt = * ) thresh
249 *
250 * Close input file
251 *
252  CLOSE( nin )
253 *
254 * For pvm only: if virtual machine not set up, allocate it and
255 * spawn the correct number of processes.
256 *
257  IF( nprocs.LT.1 ) THEN
258  nprocs = 0
259  DO 10 i = 1, ngrids
260  nprocs = max( nprocs, pval( i )*qval( i ) )
261  10 CONTINUE
262  CALL blacs_setup( iam, nprocs )
263  END IF
264 *
265 * Temporarily define blacs grid to include all processes so
266 * information can be broadcast to all processes
267 *
268  CALL blacs_get( -1, 0, ictxt )
269  CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
270 *
271 * Compute machine epsilon
272 *
273  eps = pslamch( ictxt, 'eps' )
274 *
275 * Pack information arrays and broadcast
276 *
277  CALL sgebs2d( ictxt, 'All', ' ', 1, 1, thresh, 1 )
278 *
279  work( 1 ) = nmat
280  work( 2 ) = nnb
281  work( 3 ) = nnr
282  work( 4 ) = nnbr
283  work( 5 ) = ngrids
284  CALL igebs2d( ictxt, 'All', ' ', 5, 1, work, 5 )
285 *
286  i = 1
287  CALL icopy( nmat, mval, 1, work( i ), 1 )
288  i = i + nmat
289  CALL icopy( nmat, nval, 1, work( i ), 1 )
290  i = i + nmat
291  CALL icopy( nnb, nbval, 1, work( i ), 1 )
292  i = i + nnb
293  CALL icopy( nnr, nrval, 1, work( i ), 1 )
294  i = i + nnr
295  CALL icopy( nnbr, nbrval, 1, work( i ), 1 )
296  i = i + nnbr
297  CALL icopy( ngrids, pval, 1, work( i ), 1 )
298  i = i + ngrids
299  CALL icopy( ngrids, qval, 1, work( i ), 1 )
300  i = i + ngrids - 1
301  CALL igebs2d( ictxt, 'All', ' ', i, 1, work, i )
302 *
303 * regurgitate input
304 *
305  WRITE( nout, fmt = 9999 )
306  $ 'SCALAPACK min ||Ax-b|| by QR factorizations.'
307  WRITE( nout, fmt = 9999 ) usrinfo
308  WRITE( nout, fmt = * )
309  WRITE( nout, fmt = 9999 )
310  $ 'Tests of the parallel '//
311  $ 'real single precision least-square solve.'
312  WRITE( nout, fmt = 9999 )
313  $ 'The following scaled residual '//
314  $ 'checks will be computed:'
315  WRITE( nout, fmt = 9999 )
316  $ ' Solve residual = ||Ax - b|| / '//
317  $ '(||x|| * ||A|| * eps * N)'
318  WRITE( nout, fmt = 9999 )
319  $ ' Factorization residual = ||A - QR|| / '//
320  $ '(||A|| * eps * N)'
321  WRITE( nout, fmt = 9999 )
322  $ 'The matrix A is randomly '//
323  $ 'generated for each test.'
324  WRITE( nout, fmt = * )
325  WRITE( nout, fmt = 9999 )
326  $ 'An explanation of the input/output '//
327  $ 'parameters follows:'
328  WRITE( nout, fmt = 9999 )
329  $ 'TIME : Indicates whether WALL or '//
330  $ 'CPU time was used. If CPU and WALL time'
331  WRITE( nout, fmt = 9999 )
332  $ ' are the same, only one line '//
333  $ 'is printed, and the label is ''BOTH''.'
334 *
335  WRITE( nout, fmt = 9999 )
336  $ 'M : The number of rows in the '//
337  $ 'matrix A.'
338  WRITE( nout, fmt = 9999 )
339  $ 'N : The number of columns in the '//
340  $ 'matrix A.'
341  WRITE( nout, fmt = 9999 )
342  $ 'NB : The size of the square blocks the'//
343  $ ' matrix A is split into.'
344  WRITE( nout, fmt = 9999 )
345  $ 'NRHS : The total number of RHS to solve'//
346  $ ' for.'
347  WRITE( nout, fmt = 9999 )
348  $ 'NBRHS : The number of RHS to be put on '//
349  $ 'a column of processes before going'
350  WRITE( nout, fmt = 9999 )
351  $ ' on to the next column of processes.'
352  WRITE( nout, fmt = 9999 )
353  $ 'P : The number of process rows.'
354  WRITE( nout, fmt = 9999 )
355  $ 'Q : The number of process columns.'
356  WRITE( nout, fmt = 9999 )
357  $ 'THRESH : If a residual value is less than'//
358  $ ' THRESH, CHECK is flagged as PASSED'
359  WRITE( nout, fmt = 9999 )
360  WRITE( nout, fmt = 9999 )
361  $ 'QR time : Time in seconds to factor the'//
362  $ ' matrix'
363  WRITE( nout, fmt = 9999 )
364  $ 'Sol Time: Time in seconds to solve the'//
365  $ ' system.'
366  WRITE( nout, fmt = 9999 )
367  $ 'MFLOPS : Rate of execution for factor '//
368  $ 'and solve.'
369  WRITE( nout, fmt = * )
370  WRITE( nout, fmt = 9999 )
371  $ 'The following parameter values will be used:'
372  WRITE( nout, fmt = 9996 )
373  $ 'M ', ( mval(i), i = 1, min(nmat, 10) )
374  IF( nmat.GT.10 )
375  $ WRITE( nout, fmt = 9997 ) ( mval(i), i = 11, nmat )
376  WRITE( nout, fmt = 9996 )
377  $ 'N ', ( nval(i), i = 1, min(nmat, 10) )
378  IF( nmat.GT.10 )
379  $ WRITE( nout, fmt = 9997 ) ( nval(i), i = 11, nmat )
380  WRITE( nout, fmt = 9996 )
381  $ 'NB ', ( nbval(i), i = 1, min(nnb, 10) )
382  IF( nnb.GT.10 )
383  $ WRITE( nout, fmt = 9997 ) ( nbval(i), i = 11, nnb )
384  WRITE( nout, fmt = 9996 )
385  $ 'NRHS ', ( nrval(i), i = 1, min(nnr, 10) )
386  IF( nnr.GT.10 )
387  $ WRITE( nout, fmt = 9997 ) ( nrval(i), i = 11, nnr )
388  WRITE( nout, fmt = 9996 )
389  $ 'NBRHS', ( nbrval(i), i = 1, min(nnbr, 10) )
390  IF( nnbr.GT.10 )
391  $ WRITE( nout, fmt = 9997 ) ( nbrval(i), i = 11, nnbr )
392  WRITE( nout, fmt = 9996 )
393  $ 'P ', ( pval(i), i = 1, min(ngrids, 10) )
394  IF( ngrids.GT.10 )
395  $ WRITE( nout, fmt = 9997) ( pval(i), i = 11, ngrids )
396  WRITE( nout, fmt = 9996 )
397  $ 'Q ', ( qval(i), i = 1, min(ngrids, 10) )
398  IF( ngrids.GT.10 )
399  $ WRITE( nout, fmt = 9997 ) ( qval(i), i = 11, ngrids )
400  WRITE( nout, fmt = * )
401  WRITE( nout, fmt = 9995 ) eps
402  WRITE( nout, fmt = 9998 ) thresh
403 *
404  ELSE
405 *
406 * If in pvm, must participate setting up virtual machine
407 *
408  IF( nprocs.LT.1 )
409  $ CALL blacs_setup( iam, nprocs )
410 *
411 * Temporarily define blacs grid to include all processes so
412 * all processes have needed startup information
413 *
414  CALL blacs_get( -1, 0, ictxt )
415  CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
416 *
417 * Compute machine epsilon
418 *
419  eps = pslamch( ictxt, 'eps' )
420 *
421  CALL sgebr2d( ictxt, 'All', ' ', 1, 1, thresh, 1, 0, 0 )
422 *
423  CALL igebr2d( ictxt, 'All', ' ', 5, 1, work, 5, 0, 0 )
424  nmat = work( 1 )
425  nnb = work( 2 )
426  nnr = work( 3 )
427  nnbr = work( 4 )
428  ngrids = work( 5 )
429 *
430  i = 2*nmat + nnb + nnr + nnbr + 2*ngrids
431  CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
432  i = 1
433  CALL icopy( nmat, work( i ), 1, mval, 1 )
434  i = i + nmat
435  CALL icopy( nmat, work( i ), 1, nval, 1 )
436  i = i + nmat
437  CALL icopy( nnb, work( i ), 1, nbval, 1 )
438  i = i + nnb
439  CALL icopy( nnr, work( i ), 1, nrval, 1 )
440  i = i + nnr
441  CALL icopy( nnbr, work( i ), 1, nbrval, 1 )
442  i = i + nnbr
443  CALL icopy( ngrids, work( i ), 1, pval, 1 )
444  i = i + ngrids
445  CALL icopy( ngrids, work( i ), 1, qval, 1 )
446 *
447  END IF
448 *
449  CALL blacs_gridexit( ictxt )
450 *
451  RETURN
452 *
453  20 WRITE( nout, fmt = 9993 )
454  CLOSE( nin )
455  IF( nout.NE.6 .AND. nout.NE.0 )
456  $ CLOSE( nout )
457  CALL blacs_abort( ictxt, 1 )
458 *
459  stop
460 *
461  9999 FORMAT( a )
462  9998 FORMAT( 'Routines pass computational tests if scaled residual ',
463  $ 'is less than ', g12.5 )
464  9997 FORMAT( ' ', 10i6 )
465  9996 FORMAT( 2x, a5, ' : ', 10i6 )
466  9995 FORMAT( 'Relative machine precision (eps) is taken to be ',
467  $ e18.6 )
468  9994 FORMAT( ' Number of values of ',5a, ' is less than 1 or greater ',
469  $ 'than ', i2 )
470  9993 FORMAT( ' Illegal input in file ',40a,'. Aborting run.' )
471 *
472 * End of PSLSINFO
473 *
474  END
max
#define max(A, B)
Definition: pcgemr.c:180
pslsinfo
subroutine pslsinfo(SUMMRY, NOUT, NMAT, MVAL, LDMVAL, NVAL, LDNVAL, NNB, NBVAL, LDNBVAL, NNR, NRVAL, LDNRVAL, NNBR, NBRVAL, LDNBRVAL, NGRIDS, PVAL, LDPVAL, QVAL, LDQVAL, THRESH, WORK, IAM, NPROCS)
Definition: pslsinfo.f:6
icopy
subroutine icopy(N, SX, INCX, SY, INCY)
Definition: pblastst.f:1525
min
#define min(A, B)
Definition: pcgemr.c:181