SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pzlltinfo()

subroutine pzlltinfo ( character*(*)  summry,
integer  nout,
character  uplo,
integer  nmat,
integer, dimension( ldnval )  nval,
integer  ldnval,
integer  nnb,
integer, dimension( ldnbval )  nbval,
integer  ldnbval,
integer  nnr,
integer, dimension( ldnrval )  nrval,
integer  ldnrval,
integer  nnbr,
integer, dimension( ldnbrval )  nbrval,
integer  ldnbrval,
integer  ngrids,
integer, dimension( ldpval )  pval,
integer  ldpval,
integer, dimension(ldqval)  qval,
integer  ldqval,
real  thresh,
logical  est,
integer, dimension( * )  work,
integer  iam,
integer  nprocs 
)

Definition at line 1 of file pzlltinfo.f.

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