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