61 INTEGER block_cyclic_2d, csrc_, ctxt_, dlen_, dtype_,
62 $ lld_, mb_, m_, nb_, n_, rsrc_
63 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
64 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
65 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
66 INTEGER dblesz, totmem, zplxsz, memsiz, ntests
68 parameter( dblesz = 8, totmem = 2000000, zplxsz = 16,
69 $ memsiz = totmem / zplxsz, ntests = 20,
70 $ padval = ( -9923.0d+0, -9923.0d+0 ) )
77 INTEGER i, iam, iaseed, ictxt, imidpad, info, ipa, ipd,
78 $ ipe, ipostpad, iprepad, ipt, ipw, itemp, j, k,
79 $ kfail, kpass, kskip, ktests, lcm, lwork, ,
80 $ myrow, n, nb, ndiag, ngrids, nmat, nnb, noffd,
81 $ nout, np, npcol, , nprow, nq, worksiz,
84 DOUBLE PRECISION anorm, fresid, nops, tmflops
87 INTEGER desca( dlen_ ), ierr( 1 ), nbval( ntests ),
88 $ nval( ntests ), pval( ntests ), qval( ntests )
89 DOUBLE PRECISION ctime( 1 ), wtime( 1 )
93 EXTERNAL blacs_barrier, blacs_exit, blacs_get,
110 DATA ktests, kpass, kfail, kskip / 4*0 /
114 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
118 CALL blacs_pinfo( iam, nprocs )
120 CALL pztrdinfo( outfile, nout, uplo, nmat, nval, ntests, nnb,
121 $ nbval, ntests, ngrids, pval, ntests, qval, ntests,
122 $ thresh, mem, iam, nprocs )
123 check = ( thresh.GE.0.0e+0 )
128 WRITE( nout, fmt = * )
129 WRITE( nout, fmt = 9995 )
130 WRITE( nout, fmt = 9994 )
131 WRITE( nout, fmt = * )
144 IF( nprow.LT.1 )
THEN
146 $
WRITE( nout, fmt = 9999 )
'GRID',
'nprow', nprow
148 ELSE IF( npcol.LT.1 )
THEN
150 $
WRITE( nout, fmt = 9999 )
'GRID',
'npcol', npcol
152 ELSE IF( nprow*npcol.GT.nprocs )
THEN
154 $
WRITE( nout, fmt = 9998 )nprow*npcol, nprocs
158 IF( ierr( 1 ).GT.0 )
THEN
160 $
WRITE( nout, fmt = 9997 )
'grid'
167 CALL blacs_get( -1, 0, ictxt )
173 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
185 $
WRITE( nout, fmt = 9999 )
'MATRIX',
'N', n
191 CALL igsum2d( ictxt,
'All',
' ', 1, 1, ierr, 1, -1, 0 )
193 IF( ierr( 1 ).GT.0 )
THEN
195 $
WRITE( nout, fmt = 9997 )
'matrix'
212 $
WRITE( nout, fmt = 9999 )
'NB',
'NB', nb
217 CALL igsum2d( ictxt,
'All',
' ', 1, 1, ierr, 1, -1, 0 )
219 IF( ierr( 1 ).GT.0 )
THEN
221 $
WRITE( nout, fmt = 9997 )
'NB'
228 np =
numroc( n, nb, myrow, 0, nprow )
229 nq =
numroc( n, nb, mycol, 0, npcol )
231 iprepad =
max( nb, np )
233 ipostpad =
max( nb, nq )
242 CALL descinit( desca, n, n, nb, nb, 0, 0, ictxt,
243 $
max( 1, np )+imidpad, ierr( 1 ) )
247 CALL igsum2d( ictxt,
'All',
' ', 1, 1, ierr, 1, -1, 0 )
249 IF( ierr( 1 ).LT.0 )
THEN
251 $
WRITE( nout, fmt = 9997 )
'descriptor'
260 IF(
lsame( uplo,
'U' ) )
THEN
263 noffd =
numroc( n-1, nb, mycol, 0, npcol )
265 ndiag =
iceil( dblesz*ndiag, zplxsz )
266 noffd =
iceil( dblesz*noffd, zplxsz )
269 ipd = ipa + desca( lld_ )*nq + ipostpad + iprepad
270 ipe = ipd + ndiag + ipostpad + iprepad
271 ipt = ipe + noffd + ipostpad + iprepad
272 ipw = ipt + nq + ipostpad + iprepad
277 lwork =
max( nb*( np+1 ), 3*nb )
278 worktrd = lwork + ipostpad
285 IF( nprow.NE.npcol )
THEN
286 lcm =
ilcm( nprow, npcol )
287 itemp = nb*
iceil(
iceil( np, nb ), lcm / nprow ) +
290 itemp =
max(
iceil( dblesz*itemp, zplxsz ),
292 worksiz =
max( lwork, itemp ) + ipostpad
298 IF( ipw+worksiz.GT.memsiz )
THEN
300 $
WRITE( nout, fmt = 9996 )
'Tridiagonal reduction',
301 $ ( ipw+worksiz )*zplxsz
307 CALL igsum2d( ictxt,
'All',
' ', 1, 1, ierr, 1, -1, 0 )
309 IF( ierr( 1 ).GT.0 )
THEN
311 $
WRITE( nout, fmt = 9997 )
'MEMORY'
318 CALL pzmatgen( ictxt,
'Hemm',
'N', desca( m_ ),
319 $ desca( n_ ), desca( mb_ ), desca( nb_ ),
320 $ mem( ipa ), desca( lld_ ), desca( rsrc_ ),
321 $ desca( csrc_ ), iaseed, 0, np, 0, nq,
322 $ myrow, mycol, nprow, npcol )
327 CALL pzfillpad( ictxt, np, nq, mem( ipa-iprepad ),
328 $ desca( lld_ ), iprepad, ipostpad,
330 CALL pzfillpad( ictxt, ndiag, 1, mem( ipd-iprepad ),
331 $ ndiag, iprepad, ipostpad, padval )
332 CALL pzfillpad( ictxt, noffd, 1, mem( ipe-iprepad ),
333 $ noffd, iprepad, ipostpad, padval )
334 CALL pzfillpad( ictxt, nq, 1, mem( ipt-iprepad ), nq,
335 $ iprepad, ipostpad, padval )
336 CALL pzfillpad( ictxt, worksiz-ipostpad, 1,
337 $ mem( ipw-iprepad ), worksiz-ipostpad,
338 $ iprepad, ipostpad, padval )
339 anorm =
pzlanhe(
'I', uplo, n, mem( ipa ), 1, 1,
340 $ desca, mem( ipw ) )
341 CALL pzchekpad( ictxt,
'PZLANHE', np, nq,
342 $ mem( ipa-iprepad ), desca( lld_ ),
343 $ iprepad, ipostpad, padval )
344 CALL pzchekpad( ictxt,
'PZLANHE', worksiz-ipostpad, 1,
345 $ mem( ipw-iprepad ), worksiz-ipostpad,
346 $ iprepad, ipostpad, padval )
347 CALL pzfillpad( ictxt, worktrd-ipostpad, 1,
348 $ mem( ipw-iprepad ), worktrd-ipostpad,
349 $ iprepad, ipostpad, padval )
353 CALL blacs_barrier( ictxt,
'All' )
358 CALL pzhetrd( uplo, n, mem( ipa ), 1, 1, desca,
359 $ mem( ipd ), mem( ipe ), mem( ipt ),
360 $ mem( ipw ), lwork, info )
368 CALL pzchekpad( ictxt,
'PZHETRD', np, nq,
369 $ mem( ipa-iprepad ), desca( lld_ ),
370 $ iprepad, ipostpad, padval )
371 CALL pzchekpad( ictxt,
'PZHETRD', ndiag, 1,
372 $ mem( ipd-iprepad ), ndiag, iprepad,
374 CALL pzchekpad( ictxt,
'PZHETRD', noffd, 1,
375 $ mem( ipe-iprepad ), noffd, iprepad,
378 $ MEM( IPT-IPREPAD ), NQ, IPREPAD,
380 CALL PZCHEKPAD( ICTXT, 'pzhetrd', WORKTRD-IPOSTPAD, 1,
381 $ MEM( IPW-IPREPAD ), WORKTRD-IPOSTPAD,
382 $ IPREPAD, IPOSTPAD, PADVAL )
383 CALL PZFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
384 $ MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
385 $ IPREPAD, IPOSTPAD, PADVAL )
389 CALL PZHETDRV( UPLO, N, MEM( IPA ), 1, 1, DESCA,
390 $ MEM( IPD ), MEM( IPE ), MEM( IPT ),
391 $ MEM( IPW ), IERR( 1 ) )
392 CALL PZLAFCHK( 'hemm
', 'no
', N, N, MEM( IPA ), 1, 1,
393 $ DESCA, IASEED, ANORM, FRESID,
398 CALL PZCHEKPAD( ICTXT, 'pzhetdrv', NP, NQ,
399 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
400 $ IPREPAD, IPOSTPAD, PADVAL )
401 CALL PZCHEKPAD( ICTXT, 'pzhetdrv', NDIAG, 1,
402 $ MEM( IPD-IPREPAD ), NDIAG, IPREPAD,
404 CALL PZCHEKPAD( ICTXT, 'pzhetdrv', NOFFD, 1,
405 $ MEM( IPE-IPREPAD ), NOFFD, IPREPAD,
407 CALL PZCHEKPAD( ICTXT, 'pzhetdrv', WORKSIZ-IPOSTPAD,
408 $ 1, MEM( IPW-IPREPAD ),
409 $ WORKSIZ-IPOSTPAD, IPREPAD, IPOSTPAD,
414.LE..AND..EQ.
IF( FRESIDTHRESH FRESID-FRESID
415.AND..EQ.
$ 0.0D+0 IERR( 1 )0 ) THEN
419.EQ..AND..EQ.
IF( MYROW0 MYCOL0 )
420 $ WRITE( NOUT, FMT = 9986 )FRESID
425.EQ..AND..EQ..AND..NE.
IF( MYROW0 MYCOL0 IERR( 1 )0 )
426 $ WRITE( NOUT, FMT = * )'d or e copies incorrect ...
'
432 FRESID = FRESID - FRESID
438 CALL SLCOMBINE( ICTXT, 'all
', '>
', 'w
', 1, 1, WTIME )
439 CALL SLCOMBINE( ICTXT, 'all
', '>
', 'c
', 1, 1, CTIME )
443.EQ..AND..EQ.
IF( MYROW0 MYCOL0 ) THEN
449 NOPS = ( 4.0D+0 / 3.0D+0 )*NOPS**3
454.GT.
IF( WTIME( 1 )0.0D+0 ) THEN
455 TMFLOPS = NOPS / WTIME( 1 )
459.GE.
IF( WTIME( 1 )0.0D+0 )
460 $ WRITE( NOUT, FMT = 9993 )'wall
', UPLO, N, NB,
461 $ NPROW, NPCOL, WTIME( 1 ), TMFLOPS, FRESID, PASSED
465.GT.
IF( CTIME( 1 )0.0D+0 ) THEN
466 TMFLOPS = NOPS / CTIME( 1 )
470.GE.
IF( CTIME( 1 )0.0D+0 )
471 $ WRITE( NOUT, FMT = 9993 )'cpu
', UPLO, N, NB,
472 $ NPROW, NPCOL, CTIME( 1 ), TMFLOPS, FRESID, PASSED
477 CALL BLACS_GRIDEXIT( ICTXT )
480 CALL PZTTRDTESTER( IAM, NPROCS, CHECK, NOUT, THRESH, NVAL, NMAT,
481 $ MEM, TOTMEM, KPASS, KFAIL, KSKIP )
486 KTESTS = KPASS + KFAIL + KSKIP
487 WRITE( NOUT, FMT = * )
488 WRITE( NOUT, FMT = 9992 )KTESTS
490 WRITE( NOUT, FMT = 9991 )KPASS
491 WRITE( NOUT, FMT = 9989 )KFAIL
493 WRITE( NOUT, FMT = 9990 )KPASS
495 WRITE( NOUT, FMT = 9988 )KSKIP
496 WRITE( NOUT, FMT = * )
497 WRITE( NOUT, FMT = * )
498 WRITE( NOUT, FMT = 9987 )
499.NE..AND..NE.
IF( NOUT6 NOUT0 )
505 9999 FORMAT( 'illegal
', A6, ':
', A5, ' =
', I3,
506 $ '; it should be at least 1
' )
507 9998 FORMAT( 'illegal grid: nprow*npcol =
', I4, '. it can be at most
',
509 9997 FORMAT( 'bad
', A6, ' parameters: going on to next test case.
' )
510 9996 FORMAT( 'unable to perform
', A, ': need totmem of at least
',
512 9995 FORMAT( 'time uplo n nb p q trd time
',
513 $ ' mflops residual check
' )
514 9994 FORMAT( '---- ---- ------ --- ----- ----- ---------
',
515 $ '----------- -------- ------
' )
516 9993 FORMAT( A4, 1X, A4, 1X, I6, 1X, I3, 1X, I5, 1X, I5, 1X, F9.2, 1X,
517 $ F11.2, 1X, F8.2, 1X, A6 )
518 9992 FORMAT( 'finished
', I4, ' tests, with
the following results:
' )
519 9991 FORMAT( I5, ' tests completed and passed residual checks.
' )
520 9990 FORMAT( I5, ' tests completed without checking.
' )
521 9989 FORMAT( I5, ' tests completed and failed residual checks.
' )
522 9988 FORMAT( I5, ' tests skipped because of illegal input values.
' )
523 9987 FORMAT( 'END OF TESTS.
' )
524 9986 FORMAT( '||A - Q*T*Q
''|| / (||A|| * N * eps) =
', G25.7 )
subroutine pzlafchk(aform, diag, m, n, a, ia, ja, desca, iaseed, anorm, fresid, work)
subroutine pzmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
end diagonal values have been computed in the(sparse) matrix id.SOL
logical function lsame(ca, cb)
LSAME
integer function iceil(inum, idenom)
integer function ilcm(m, n)
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
subroutine descinit(desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
subroutine blacs_gridexit(cntxt)
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
integer function numroc(n, nb, iproc, isrcproc, nprocs)
subroutine pzchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
subroutine pzfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
subroutine pzhetdrv(uplo, n, a, ia, ja, desca, d, e, tau, work, info)
subroutine pzhetrd(uplo, n, a, ia, ja, desca, d, e, tau, work, lwork, info)
double precision function pzlanhe(norm, uplo, n, a, ia, ja, desca, work)
subroutine pztrdinfo(summry, nout, uplo, nmat, nval, ldnval, nnb, nbval, ldnbval, ngrids, pval, ldpval, qval, ldqval, thresh, work, iam, nprocs)
subroutine pzttrdtester(iam, nprocs, check, nout, thresh, nval, nmat, mem, totmem, kpass, kfail, kskip)
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)