62 INTEGER block_cyclic_2d, csrc_, ctxt_, dlen_, dtype_,
63 $ lld_, mb_, m_, nb_, n_, rsrc_
64 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
65 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
66 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
67 INTEGER cplxsz, memsiz, ntests, totmem, realsz
69 parameter( cplxsz = 8, totmem = 2000000, realsz = 8,
70 $ memsiz = totmem / cplxsz, ntests = 20,
71 $ padval = ( -9923.0e+0, -9923.0e+0 ) )
77 INTEGER i, iam, iaseed, ictxt, imidpad, info, ipa, ipd,
78 $ ipe, ipostpad, iprepad, iptp, iptq, ipw, j, k,
79 $ kfail, kpass, kskip, ktests, lwork, m, maxmn,
83 REAL anorm, fresid, thresh
84 DOUBLE PRECISION nops, tmflops
87 INTEGER desca( dlen_ ), ierr( 1 ), nbval( ntests ),
88 $ mval( ntests ), nval( ntests ),
89 $ pval( ntests ), qval( ntests )
90 DOUBLE PRECISION ctime( 1 ), wtime( 1 )
94 EXTERNAL blacs_barrier, blacs_exit, blacs_get,
110 DATA ktests, kpass, kfail, kskip / 4*0 /
116 CALL blacs_pinfo( iam, nprocs )
118 CALL pcbrdinfo( outfile, nout, nmat, mval, ntests, nval, ntests,
119 $ nnb, nbval, ntests, ngrids, pval, ntests, qval,
120 $ ntests, thresh, mem, iam, nprocs )
121 check = ( thresh.GE.0.0e+0 )
126 WRITE( nout, fmt = * )
127 WRITE( nout, fmt = 9995 )
128 WRITE( nout, fmt = 9994 )
129 WRITE( nout, fmt = * )
142 IF( nprow.LT.1 )
THEN
144 $
WRITE( nout, fmt = 9999 )
'GRID',
'nprow', nprow
146 ELSE IF( npcol.LT.1 )
THEN
148 $
WRITE( nout, fmt = 9999 )
'GRID',
'npcol', npcol
150 ELSE IF( nprow*npcol.GT.nprocs
THEN
152 $
WRITE( nout, fmt = 9998 ) nprow*npcol, nprocs
156 IF( ierr( 1 ).GT.0 )
THEN
158 $
WRITE( nout, fmt = 9997 )
'grid'
165 CALL blacs_get( -1, 0, ictxt )
169 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
184 $
WRITE( nout, fmt = 9999 )
'MATRIX',
'M', m
186 ELSE IF( n.LT.1 )
THEN
188 $
WRITE( nout, fmt = 9999 )
'MATRIX',
'N', n
194 CALL igsum2d( ictxt,
'All',
' ', 1, 1, ierr, 1, -1, 0 )
196 IF( ierr( 1 ).GT.0 )
THEN
198 $
WRITE( nout, fmt = 9997 ) 'matrix
'
215 $ WRITE( NOUT, FMT = 9999 ) 'nb
', 'nb
', NB
220 CALL IGSUM2D( ICTXT, 'all
', ' ', 1, 1, IERR, 1, -1, 0 )
222.GT.
IF( IERR( 1 )0 ) THEN
224 $ WRITE( NOUT, FMT = 9997 ) 'nb
'
231 MP = NUMROC( M, NB, MYROW, 0, NPROW )
232 NQ = NUMROC( N, NB, MYCOL, 0, NPCOL )
233 MNP = NUMROC( MIN( M, N ), NB, MYROW, 0, NPROW )
234 MNQ = NUMROC( MIN( M, N ), NB, MYCOL, 0, NPCOL )
236 IPREPAD = MAX( NB, MP )
238 IPOSTPAD = MAX( NB, NQ )
247 CALL DESCINIT( DESCA, M, N, NB, NB, 0, 0, ICTXT,
248 $ MAX( 1, MP )+IMIDPAD, IERR( 1 ) )
250 CALL IGSUM2D( ICTXT, 'all
', ' ', 1, 1, IERR, 1, -1, 0 )
252.LT.
IF( IERR( 1 )0 ) THEN
254 $ WRITE( NOUT, FMT = 9997 ) 'descriptor
'
265 NDIAG = ICEIL( REALSZ*NDIAG, CPLXSZ )
266 NOFFD = ICEIL( REALSZ*NOFFD, CPLXSZ )
269 NOFFD = NUMROC( MIN( M, N )-1, NB, MYCOL, 0, NPCOL )
270 NDIAG = ICEIL( REALSZ*NDIAG, CPLXSZ )
271 NOFFD = ICEIL( REALSZ*NOFFD, CPLXSZ )
275 IPD = IPA + DESCA( LLD_ )*NQ + IPOSTPAD + IPREPAD
276 IPE = IPD + NDIAG + IPOSTPAD + IPREPAD
277 IPTQ = IPE + NOFFD + IPOSTPAD + IPREPAD
278 IPTP = IPTQ + MNQ + IPOSTPAD + IPREPAD
279 IPW = IPTP + MNP + IPOSTPAD + IPREPAD
284 LWORK = NB*( MP+NQ+1 ) + NQ
285 WORKBRD = LWORK + IPOSTPAD
291 WORKSIZ = MAX( LWORK, 2*NB*( MP+NQ+NB ) ) + IPOSTPAD
297.GT.
IF( IPW+WORKSIZMEMSIZ ) THEN
299 $ WRITE( NOUT, FMT = 9996 ) 'bidiagonal reduction
',
300 $ ( IPW+WORKSIZ )*CPLXSZ
306 CALL IGSUM2D( ICTXT, 'all
', ' ', 1, 1, IERR, 1, -1, 0 )
308.GT.
IF( IERR( 1 )0 ) THEN
310 $ WRITE( NOUT, FMT = 9997 ) 'memory
'
317 CALL PCMATGEN( ICTXT, 'no
', 'no
', DESCA( M_ ),
318 $ DESCA( N_ ), DESCA( MB_ ), DESCA( NB_ ),
319 $ MEM( IPA ), DESCA( LLD_ ), DESCA( RSRC_ ),
320 $ DESCA( CSRC_ ), IASEED, 0, MP, 0, NQ,
321 $ MYROW, MYCOL, NPROW, NPCOL )
326 CALL PCFILLPAD( ICTXT, MP, NQ, MEM( IPA-IPREPAD ),
327 $ DESCA( LLD_ ), IPREPAD, IPOSTPAD,
329 CALL PCFILLPAD( ICTXT, NDIAG, 1, MEM( IPD-IPREPAD ),
330 $ NDIAG, IPREPAD, IPOSTPAD, PADVAL )
331 CALL PCFILLPAD( ICTXT, NOFFD, 1, MEM( IPE-IPREPAD ),
332 $ NOFFD, IPREPAD, IPOSTPAD, PADVAL )
333 CALL PCFILLPAD( ICTXT, MNQ, 1, MEM( IPTQ-IPREPAD ),
334 $ MNQ, IPREPAD, IPOSTPAD, PADVAL )
335 CALL PCFILLPAD( ICTXT, MNP, 1, MEM( IPTP-IPREPAD ),
336 $ MNP, IPREPAD, IPOSTPAD, PADVAL )
337 CALL PCFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
338 $ MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
339 $ IPREPAD, IPOSTPAD, PADVAL )
340 ANORM = PCLANGE( 'i
', M, N, MEM( IPA ), 1, 1, DESCA,
342 CALL PCCHEKPAD( ICTXT, 'pclange', MP, NQ,
343 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
344 $ IPREPAD, IPOSTPAD, PADVAL )
345 CALL PCCHEKPAD( ICTXT, 'pclange', WORKSIZ-IPOSTPAD,
346 $ 1, MEM( IPW-IPREPAD ),
347 $ WORKSIZ-IPOSTPAD, IPREPAD, IPOSTPAD,
349 CALL PCFILLPAD( ICTXT, WORKBRD-IPOSTPAD, 1,
350 $ MEM( IPW-IPREPAD ), WORKBRD-IPOSTPAD,
351 $ IPREPAD, IPOSTPAD, PADVAL )
355 CALL BLACS_BARRIER( ICTXT, 'all
' )
360 CALL PCGEBRD( M, N, MEM( IPA ), 1, 1, DESCA, MEM( IPD ),
361 $ MEM( IPE ), MEM( IPTQ ), MEM( IPTP ),
362 $ MEM( IPW ), LWORK, INFO )
370 CALL PCCHEKPAD( ICTXT, 'pcgebrd', MP, NQ,
371 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
372 $ IPREPAD, IPOSTPAD, PADVAL )
373 CALL PCCHEKPAD( ICTXT, 'pcgebrd', NDIAG, 1,
374 $ MEM( IPD-IPREPAD ), NDIAG, IPREPAD,
376 CALL PCCHEKPAD( ICTXT, 'pcgebrd', NOFFD, 1,
377 $ MEM( IPE-IPREPAD ), NOFFD, IPREPAD,
379 CALL PCCHEKPAD( ICTXT, 'pcgebrd', MNQ, 1,
380 $ MEM( IPTQ-IPREPAD ), MNQ, IPREPAD,
382 CALL PCCHEKPAD( ICTXT, 'pcgebrd', MNP, 1,
383 $ MEM( IPTP-IPREPAD ), MNP, IPREPAD,
385 CALL PCCHEKPAD( ICTXT, 'pcgebrd', WORKBRD-IPOSTPAD,
386 $ 1, MEM( IPW-IPREPAD ),
387 $ WORKBRD-IPOSTPAD, IPREPAD,
389 CALL PCFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
390 $ MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
391 $ IPREPAD, IPOSTPAD, PADVAL )
395 CALL PCGEBDRV( M, N, MEM( IPA ), 1, 1, DESCA,
396 $ MEM( IPD ), MEM( IPE ), MEM( IPTQ ),
397 $ MEM( IPTP ), MEM( IPW ), IERR( 1 ) )
398 CALL PCLAFCHK( 'no
', 'no
', M, N, MEM( IPA ), 1, 1,
399 $ DESCA, IASEED, ANORM, FRESID,
404 CALL PCCHEKPAD( ICTXT, 'pcgebdrv', MP, NQ,
405 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
406 $ IPREPAD, IPOSTPAD, PADVAL )
407 CALL PCCHEKPAD( ICTXT, 'pcgebdrv', NDIAG, 1,
408 $ MEM( IPD-IPREPAD ), NDIAG, IPREPAD,
410 CALL PCCHEKPAD( ICTXT, 'pcgebdrv', NOFFD, 1,
411 $ MEM( IPE-IPREPAD ), NOFFD, IPREPAD,
413 CALL PCCHEKPAD( ICTXT, 'pcgebdrv', WORKSIZ-IPOSTPAD,
414 $ 1, MEM( IPW-IPREPAD ),
415 $ WORKSIZ-IPOSTPAD, IPREPAD,
420.LE..AND..EQ.
IF( FRESIDTHRESH FRESID-FRESID0.0E+0
421.AND..EQ.
$ IERR( 1 )0 ) THEN
425.EQ..AND..EQ.
IF( MYROW0 MYCOL0 )
426 $ WRITE( NOUT, FMT = 9986 ) FRESID
432.EQ..AND..EQ..AND..NE.
IF( MYROW0 MYCOL0 IERR( 1 )0 )
433 $ WRITE( NOUT, FMT = * )
434 $ 'd or e copies incorrect ...
'
440 FRESID = FRESID - FRESID
447 CALL SLCOMBINE( ICTXT, 'all
', '>
', 'w
', 1, 1, WTIME )
448 CALL SLCOMBINE( ICTXT, 'all
', '>
', 'c
', 1, 1, CTIME )
452.EQ..AND..EQ.
IF( MYROW0 MYCOL0 ) THEN
458 NOPS = 16.0D+0 * DBLE( MINMN ) * DBLE( MINMN ) *
459 $ ( DBLE( MAXMN ) - DBLE( MINMN ) / 3.0D+0 )
464.GT.
IF( WTIME( 1 )0.0D+0 ) THEN
465 TMFLOPS = NOPS / WTIME( 1 )
469.GE.
IF( WTIME( 1 )0.0D+0 )
470 $ WRITE( NOUT, FMT = 9993 ) 'wall
', M, N, NB, NPROW,
471 $ NPCOL, WTIME( 1 ), TMFLOPS, FRESID, PASSED
475.GT.
IF( CTIME( 1 )0.0D+0 ) THEN
476 TMFLOPS = NOPS / CTIME( 1 )
480.GE.
IF( CTIME( 1 )0.0D+0 )
481 $ WRITE( NOUT, FMT = 9993 ) 'cpu
', M, N, NB, NPROW,
482 $ NPCOL, CTIME( 1 ), TMFLOPS, FRESID, PASSED
487 CALL BLACS_GRIDEXIT( ICTXT )
493 KTESTS = KPASS + KFAIL + KSKIP
494 WRITE( NOUT, FMT = * )
495 WRITE( NOUT, FMT = 9992 ) KTESTS
497 WRITE( NOUT, FMT = 9991 ) KPASS
498 WRITE( NOUT, FMT = 9989 ) KFAIL
500 WRITE( NOUT, FMT = 9990 ) KPASS
502 WRITE( NOUT, FMT = 9988 ) KSKIP
503 WRITE( NOUT, FMT = * )
504 WRITE( NOUT, FMT = * )
505 WRITE( NOUT, FMT = 9987 )
506.NE..AND..NE.
IF( NOUT6 NOUT0 ) CLOSE ( NOUT )
511 9999 FORMAT( 'illegal
', A6, ':
', A5, ' =
', I3,
512 $ '; it should be at least 1
' )
513 9998 FORMAT( 'illegal grid: nprow*npcol =
', I4, '. it can be at most
',
515 9997 FORMAT( 'bad
', A6, ' parameters: going on to next test case.
' )
516 9996 FORMAT( 'unable to perform
', A, ': need totmem of at least
',
518 9995 FORMAT( 'time m n nb p q brd time
',
519 $ ' mflops residual check
' )
520 9994 FORMAT( '---- ------ ------ --- ----- ----- ---------
',
521 $ '----------- -------- ------
' )
522 9993 FORMAT( A4, 1X, I6, 1X, I6, 1X, I3, 1X, I5, 1X, I5, 1X, F9.2, 1X,
523 $ F11.2, 1X, F8.2, 1X, A6 )
524 9992 FORMAT( 'finished
', I4, ' tests, with
the following results:
' )
525 9991 FORMAT( I5, ' tests completed and passed residual checks.
' )
526 9990 FORMAT( I5, ' tests completed without checking.
' )
527 9989 FORMAT( I5, ' tests completed and failed residual checks.
' )
528 9988 FORMAT( I5, ' tests skipped because of illegal input values.
' )
529 9987 FORMAT( 'END OF TESTS.
' )
530 9986 FORMAT( '||A - Q*B*P|| / (||A|| * N * eps) =
', G25.7 )
subroutine pclafchk(aform, diag, m, n, a, ia, ja, desca, iaseed, anorm, fresid, work)
subroutine pcmatgen(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
integer function iceil(inum, idenom)
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
subroutine descinit(desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
real function pclange(norm, m, n, a, ia, ja, desca, work)
subroutine blacs_gridexit(cntxt)
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
integer function numroc(n, nb, iproc, isrcproc, nprocs)
subroutine pcbrdinfo(summry, nout, nmat, mval, ldmval, nval, ldnval, nnb, nbval, ldnbval, ngrids, pval, ldpval, qval, ldqval, thresh, work, iam, nprocs)
subroutine pcchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
subroutine pcfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
subroutine pcgebdrv(m, n, a, ia, ja, desca, d, e, tauq, taup, work, info)
subroutine pcgebrd(m, n, a, ia, ja, desca, d, e, tauq, taup, work, lwork, info)
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)