1 SUBROUTINE pzdtinfo( SUMMRY, NOUT, TRANS, NMAT, NVAL, LDNVAL, NBW,
2 $ BWLVAL, BWUVAL, LDBWVAL, NNB, NBVAL, LDNBVAL,
3 $ NNR, NRVAL, LDNRVAL, NNBR, NBRVAL, LDNBRVAL,
4 $ NGRIDS, PVAL, LDPVAL, QVAL, LDQVAL, THRESH,
18 $ LDBWVAL, LDNBRVAL, LDNBVAL, LDNRVAL, LDNVAL,
19 $ ldpval, ldqval, ngrids, nmat, nnb, nnbr, nbw,
24 INTEGER NBRVAL( LDNBRVAL ), NBVAL( LDNBVAL ),
25 $ nrval( ldnrval ), nval( ldnval ),
26 $ bwlval( ldbwval),bwuval( ldbwval),
27 $ pval( ldpval ), qval(ldqval), work( * )
151 PARAMETER ( NIN = 11 )
159 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
160 $ blacs_gridinit, blacs_setup,
icopy, igebr2d,
161 $ igebs2d, sgebr2d, sgebs2d
165 DOUBLE PRECISION PDLAMCH
166 EXTERNAL LSAME, PDLAMCH
180 OPEN( nin, file =
'BLU.dat', status =
'OLD' )
181 READ( nin, fmt = * ) summry
186 READ( nin, fmt = 9999 ) usrinfo
190 READ( nin, fmt = * ) summry
191 READ( nin, fmt = * ) nout
192 IF( nout.NE.0 .AND. nout.NE.6 )
193 $
OPEN( nout, file = summry, status =
'UNKNOWN' )
199 READ( nin, fmt = * ) trans
204 READ( nin, fmt = * ) nmat
205 IF( nmat.LT.1 .OR. nmat.GT.ldnval )
THEN
206 WRITE( nout, fmt = 9994 )
'N', ldnval
209 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
213 READ( nin, fmt = * ) nbw
215 IF( nbw.LT.1 .OR. nbw.GT.ldbwval )
THEN
216 WRITE( nout, fmt = 9994 )
'BW', ldbwval
219 READ( nin, fmt = * ) ( bwlval( i ), i = 1, nbw )
220 READ( nin, fmt = * ) ( bwuval( i ), i = 1, nbw )
224 READ( nin, fmt = * ) nnb
225 IF( nnb.LT.1 .OR. nnb.GT.ldnbval )
THEN
226 WRITE( nout, fmt = 9994 )
'NB', ldnbval
229 READ( nin, fmt = * ) ( nbval( i ), i = 1, nnb )
233 READ( nin, fmt = * ) nnr
234 IF( nnr.LT.1 .OR. nnr.GT.ldnrval )
THEN
235 WRITE( nout, fmt = 9994 )
'NRHS', ldnrval
238 READ( nin, fmt = * ) ( nrval( i ), i = 1, nnr )
242 READ( nin, fmt = * ) nnbr
243 IF( nnbr.LT.1 .OR. nnbr.GT.ldnbrval )
THEN
244 WRITE( nout, fmt = 9994 )
'NBRHS', ldnbrval
247 READ( nin, fmt = * ) ( nbrval( i ), i = 1, nnbr )
251 READ( nin, fmt = * ) ngrids
252 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval )
THEN
253 WRITE( nout, fmt = 9994 )
'Grids', ldpval
255 ELSE IF( ngrids.GT.ldqval )
THEN
256 WRITE( nout, fmt = 9994 )
'Grids', ldqval
261 DO 8738 i = 1, ngrids
267 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
271 READ( nin, fmt = * ) thresh
280 IF( nprocs.LT.1 )
THEN
283 nprocs =
max( nprocs, pval( i )*qval( i ) )
285 CALL blacs_setup( iam, nprocs )
291 CALL blacs_get( -1, 0, ictxt )
292 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
296 eps = pdlamch( ictxt,
'eps' )
300 CALL sgebs2d( ictxt,
'All',
' ', 1, 1, thresh, 1 )
314 IF( lsame( trans,
'N' ) )
THEN
322 CALL igebs2d( ictxt,
'All',
' ', 1, 1, i-1, 1 )
324 CALL igebs2d( ictxt,
'All',
' ', i-1, 1, work, i-1 )
327 CALL icopy( nmat, nval, 1, work( i ), 1 )
329 CALL icopy( nbw, bwlval, 1, work( i ), 1 )
331 CALL icopy( nbw, bwuval, 1, work( i ), 1 )
333 CALL icopy( nnb, nbval, 1, work( i ), 1 )
335 CALL icopy( nnr, nrval, 1, work( i ), 1 )
337 CALL icopy( nnbr, nbrval, 1, work( i ), 1 )
339 CALL icopy( ngrids, pval, 1, work( i ), 1 )
341 CALL icopy( ngrids, qval, 1, work( i ), 1 )
343 CALL igebs2d( ictxt,
'All',
' ', i-1, 1, work, i-1 )
347 WRITE( nout, fmt = 9999 )
348 $
'SCALAPACK banded linear systems.'
349 WRITE( nout, fmt = 9999 ) usrinfo
350 WRITE( nout, fmt = * )
351 WRITE( nout, fmt = 9999 )
352 $
'Tests of the parallel '//
353 $
'complex single precision band matrix solve '
354 WRITE( nout, fmt = 9999 )
355 $
'The following scaled residual '//
356 $
'checks will be computed:'
357 WRITE( nout, fmt = 9999 )
358 $
' Solve residual = ||Ax - b|| / '//
359 $
'(||x|| * ||A|| * eps * N)'
360 WRITE( nout, fmt = 9999 )
361 $
' Factorization residual = ||A - LU|| /'//
362 $
' (||A|| * eps * N)'
363 WRITE( nout, fmt = 9999 )
364 $
'The matrix A is randomly '//
365 $
'generated for each test.'
366 WRITE( nout, fmt = * )
367 WRITE( nout, fmt = 9999 )
368 $
'An explanation of the input/output '//
369 $
'parameters follows:'
370 WRITE( nout, fmt = 9999 )
371 $
'TIME : Indicates whether WALL or '//
372 $
'CPU time was used.'
374 WRITE( nout, fmt = 9999 )
375 $
'N : The number of rows and columns '//
377 WRITE( nout, fmt = 9999 )
378 $
'bwl, bwu : The number of diagonals '//
380 WRITE( nout, fmt = 9999 )
381 $
'NB : The size of the column panels the'//
382 $
' matrix A is split into. [-1 for default]'
383 WRITE( nout, fmt = 9999 )
384 $
'NRHS : The total number of RHS to solve'//
386 WRITE( nout, fmt = 9999 )
387 $
'NBRHS : The number of RHS to be put on '//
388 $
'a column of processes before going'
389 WRITE( nout, fmt = 9999 )
390 $
' on to the next column of processes.'
391 WRITE( nout, fmt = 9999 )
392 $
'P : The number of process rows.'
393 WRITE( nout, fmt = 9999 )
394 $
'Q : The number of process columns.'
395 WRITE( nout, fmt = 9999 )
396 $
'THRESH : If a residual value is less than'//
397 $
' THRESH, CHECK is flagged as PASSED'
398 WRITE( nout, fmt = 9999 )
399 $
'Fact time: Time in seconds to factor the'//
401 WRITE( nout, fmt = 9999 )
402 $
'Sol Time: Time in seconds to solve the'//
404 WRITE( nout, fmt = 9999 )
405 $
'MFLOPS : Rate of execution for factor '//
406 $
'and solve using sequential operation count.'
407 WRITE( nout, fmt = 9999 )
408 $
'MFLOP2 : Rough estimate of speed '//
409 $
'using actual op count (accurate big P,N).'
410 WRITE( nout, fmt = * )
411 WRITE( nout, fmt = 9999 )
412 $
'The following parameter values will be used:'
413 WRITE( nout, fmt = 9996 )
414 $
'N ', ( nval(i), i = 1,
min(nmat, 10) )
416 $
WRITE( nout, fmt = 9997 ) ( nval(i), i = 11, nmat )
417 WRITE( nout, fmt = 9996 )
418 $
'bwl ', ( bwlval(i), i = 1,
min(nbw, 10) )
420 $
WRITE( nout, fmt = 9997 ) ( bwlval(i), i = 11, nbw )
421 WRITE( nout, fmt = 9996 )
422 $
'bwu ', ( bwuval(i), i = 1,
min(nbw, 10) )
424 $
WRITE( nout, fmt = 9997 ) ( bwuval(i), i = 11, nbw )
425 WRITE( nout, fmt = 9996 )
426 $
'NB ', ( nbval(i), i = 1,
min(nnb, 10) )
428 $
WRITE( nout, fmt = 9997 ) ( nbval(i), i = 11, nnb )
429 WRITE( nout, fmt = 9996 )
430 $
'NRHS ', ( nrval(i), i = 1,
min(nnr, 10) )
432 $
WRITE( nout, fmt = 9997 ) ( nrval(i), i = 11, nnr )
433 WRITE( nout, fmt = 9996 )
434 $
'NBRHS', ( nbrval(i), i = 1,
min(nnbr, 10) )
436 $
WRITE( nout, fmt = 9997 ) ( nbrval(i), i = 11, nnbr )
437 WRITE( nout, fmt = 9996 )
438 $
'P ', ( pval(i), i = 1,
min(ngrids, 10) )
440 $
WRITE( nout, fmt = 9997) ( pval(i), i = 11, ngrids )
441 WRITE( nout, fmt = 9996 )
442 $
'Q ', ( qval(i), i = 1,
min(ngrids, 10) )
444 $
WRITE( nout, fmt = 9997 ) ( qval(i), i = 11, ngrids )
445 WRITE( nout, fmt = * )
446 WRITE( nout, fmt = 9995 ) eps
447 WRITE( nout, fmt = 9998 ) thresh
454 $
CALL blacs_setup( iam, nprocs )
459 CALL blacs_get( -1, 0, ictxt )
460 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
464 eps = pdlamch( ictxt,
'eps' )
466 CALL sgebr2d( ictxt,
'All',
' ', 1, 1, thresh, 1, 0, 0 )
467 CALL igebr2d( ictxt,
'All',
' ', 1, 1, i, 1, 0, 0 )
468 CALL igebr2d( ictxt,
'All',
' ', i, 1, work, i, 0, 0 )
482 IF( work( i ) .EQ. 1 )
THEN
489 i = nmat + nbw + nnb + nnr + nnbr + 2*ngrids
492 CALL igebr2d( ictxt,
'All',
' ', 1, i, work, 1, 0, 0 )
494 CALL icopy( nmat, work( i ), 1, nval, 1 )
496 CALL icopy( nbw, work( i ), 1, bwlval, 1 )
498 CALL icopy( nbw, work( i ), 1, bwuval, 1 )
500 CALL icopy( nnb, work( i ), 1, nbval, 1 )
502 CALL icopy( nnr, work( i ), 1, nrval, 1 )
504 CALL icopy( nnbr, work( i ), 1, nbrval, 1 )
506 CALL icopy( ngrids, work( i ), 1, pval, 1 )
508 CALL icopy( ngrids, work( i ), 1, qval, 1 )
512 CALL blacs_gridexit( ictxt )
516 20
WRITE( nout, fmt = 9993 )
518 IF( nout.NE.6 .AND. nout.NE.0 )
521 CALL blacs_abort( ictxt, 1 )
525 9998
FORMAT(
'Routines pass computational tests if scaled residual ',
526 $
'is less than ', g12.5 )
527 9997
FORMAT(
' ', 10i6 )
528 9996
FORMAT( 2x, a5,
': ', 10i6 )
529 9995
FORMAT(
'Relative machine precision (eps) is taken to be ',
531 9994
FORMAT(
' Number of values of ',5a,
' is less than 1 or greater ',
533 9993
FORMAT(
' Illegal input in file ',40a,
'. Aborting run.' )