4 CHARACTER*7 SNAMES( NSUBS )
6 DATA snames/
'PCSWAP ',
'PCSCAL ',
7 $
'PCSSCAL',
'PCCOPY',
'PCAXPY ',
8 $
'PCDOTU ',
'PCDOTC' ,
'PSCNRM2',
9 $
'PSCASUM',
'PCAMAX '/
104 INTEGER maxtests, maxgrids, cplxsz, totmem, memsiz,
106 parameter( maxtests = 20, maxgrids = 20, cplxsz = 8,
107 $ totmem = 2000000, nsubs = 10,
108 $ memsiz = totmem / cplxsz )
109 INTEGER block_cyclic_2d_inb, csrc_, ctxt_, dlen_,
110 $ dtype_, imb_, inb_, lld_, mb_, m_, nb_, n_,
112 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
113 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
114 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
115 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
118 INTEGER csrcx, csrcy, i, iam, ictxt, imbx, imby, imidx,
119 $ imidy, inbx, inby, incx, incy, ipostx, iposty,
120 $ iprex, iprey, ipx, ipy, ix, ixseed, iy, iyseed,
121 $ j, jx, jy, k, mbx, mby, memreqd, mpx, mpy, mx,
122 $ my, mycol, myrow, n, nbx, nby, ngrids, nout,
123 $ npcol, nprocs, nprow, nqx, nqy, ntests, nx, ny,
124 $ pisclr, rsrcx, rsrcy
126 DOUBLE PRECISION adds, cflops, mults, nops, wflops
131 LOGICAL ltest( nsubs ), ycheck( nsubs )
132 INTEGER cscxval( maxtests ), cscyval( maxtests ),
133 $ descx( dlen_ ), descy( dlen_ ), ierr( 2 ),
134 $ imbxval( maxtests ), imbyval( maxtests ),
135 $ inbxval( maxtests ), inbyval( maxtests ),
136 $ incxval( maxtests ), incyval( maxtests ),
137 $ ixval( maxtests ), iyval( maxtests ),
138 $ jxval( maxtests ), jyval( maxtests ),
139 $ mbxval( maxtests ), mbyval( maxtests ),
140 $ mxval( maxtests ), myval( maxtests ),
141 $ nbxval( maxtests ), nbyval( maxtests ),
142 $ nval( maxtests ), nxval( maxtests ),
143 $ nyval( maxtests ), pval( maxtests ),
144 $ qval( maxtests ), rscxval( maxtests ),
145 $ rscyval( maxtests )
146 DOUBLE PRECISION ctime( 1 ), wtime( 1 )
147 COMPLEX mem( memsiz )
150 EXTERNAL blacs_barrier, blacs_exit, blacs_get,
151 $ blacs_gridexit, blacs_gridinfo, blacs_gridinit,
154 $ pccopy, pcdotc, pcdotu,
pclagen, pcscal,
155 $ pcsscal, pcswap, pscasum, pscnrm2,
pvdescchk,
162 CHARACTER*7 snames( nsubs )
165 COMMON /snamec/snames
166 COMMON /infoc/info, nblog
167 COMMON /pberrorc/nout, abrtflg
170 DATA ycheck/.true., .false., .false., .true.,
171 $ .true., .true., .true., .false., .false.,
190 CALL blacs_pinfo( iam, nprocs )
191 CALL pcbla1timinfo( outfile, nout, ntests, nval, mxval, nxval,
192 $ imbxval, mbxval, inbxval, nbxval, rscxval,
193 $ cscxval, ixval, jxval, incxval, myval,
194 $ nyval, imbyval, mbyval, inbyval, nbyval,
195 $ rscyval, cscyval, iyval, jyval, incyval,
196 $ maxtests, ngrids, pval, maxgrids, qval,
197 $ maxgrids, ltest, iam, nprocs, alpha, mem )
200 $
WRITE( nout, fmt = 9986 )
212 IF( nprow.LT.1 )
THEN
214 $
WRITE( nout, fmt = 9999 )
'GRID SIZE',
'NPROW', nprow
216 ELSE IF( npcol.LT.1 )
THEN
218 $
WRITE( nout, fmt = 9999 )
'GRID SIZE',
'NPCOL', npcol
220 ELSE IF( nprow*npcol.GT.nprocs )
THEN
222 $
WRITE( nout, fmt = 9998 ) nprow*npcol, nprocs
226 IF( ierr( 1 ).GT.0 )
THEN
228 $
WRITE( nout, fmt = 9997 )
'GRID'
234 CALL blacs_get( -1, 0, ictxt )
235 CALL blacs_gridinit( ictxt,
'Row-major', nprow, npcol )
236 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
241 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
275 WRITE( nout, fmt = * )
276 WRITE( nout, fmt = 9996 ) j, nprow, npcol
277 WRITE( nout, fmt = * )
279 WRITE( nout, fmt = 9995 )
280 WRITE( nout, fmt = 9994 )
281 WRITE( nout, fmt = 9995 )
282 WRITE( nout, fmt = 9993 ) n, ix, jx, mx, nx, imbx, inbx,
283 $ mbx, nbx, rsrcx, csrcx, incx
285 WRITE( nout, fmt = 9995 )
286 WRITE( nout, fmt = 9992 )
287 WRITE( nout, fmt = 9995 )
288 WRITE( nout, fmt = 9993 ) n, iy, jy, my, ny, imby, inby,
289 $ mby, nby, rsrcy, csrcy, incy
290 WRITE( nout, fmt = 9995 )
291 WRITE( nout, fmt = 9983 )
297 $ block_cyclic_2d_inb, mx, nx, imbx, inbx,
298 $ mbx, nbx, rsrcx, csrcx, incx, mpx, nqx,
299 $ iprex, imidx, ipostx, 0, 0, ierr( 1 ) )
301 $ block_cyclic_2d_inb, my, ny, imby, inby,
302 $ mby, nby, rsrcy, csrcy, incy, mpy, nqy,
303 $ iprey, imidy, iposty, 0, 0, ierr( 2 ) )
305 IF( ierr( 1 ).GT.0 .OR. ierr( 2 ).GT.0 )
312 ipy = ipx + descx( lld_ ) * nqx
316 memreqd = ipy + descy( lld_ ) * nqy - 1
318 IF( memreqd.GT.memsiz )
THEN
320 $
WRITE( nout, fmt = 9990 ) memreqd*cplxsz
326 CALL igsum2d( ictxt,
'All',
' ', 1, 1, ierr, 1, -1, 0 )
328 IF( ierr( 1 ).GT.0 )
THEN
330 $
WRITE( nout, fmt = 9991 )
340 IF( .NOT.ltest( k ) )
345 CALL pvdimchk( ictxt, nout, n,
'X', ix, jx, descx, incx,
347 CALL pvdimchk( ictxt, nout, n,
'Y', iy, jy, descy, incy,
350 IF( ierr( 1 ).NE.0 .OR. ierr( 2 ).NE.0 )
355 CALL pclagen( .false.,
'None',
'No diag', 0, mx, nx, 1,
356 $ 1, descx, ixseed, mem( ipx ),
359 $
CALL pclagen( .false.,
'None',
'No diag', 0, my, ny,
360 $ 1, 1, descy, iyseed, mem( ipy ),
365 CALL blacs_barrier( ictxt,
'All' )
376 CALL pcswap( n, mem( ipx ), ix, jx, descx, incx,
377 $ mem( ipy ), iy, jy, descy, incy )
380 ELSE IF( k.EQ.2 )
THEN
387 CALL pcscal( n, alpha, mem( ipx ), ix, jx, descx,
391 ELSE IF( k.EQ.3 )
THEN
398 CALL pcsscal( n, real( alpha ), mem( ipx ), ix, jx,
402 ELSE IF( k.EQ.4 )
THEN
409 CALL pccopy( n, mem( ipx ), ix, jx, descx, incx,
410 $ mem( ipy ), iy, jy, descy, incy )
413 ELSE IF( k.EQ.5 )
THEN
420 CALL pcaxpy( n, alpha, mem( ipx ), ix, jx, descx,
421 $ incx, mem( ipy ), iy, jy, descy, incy )
424 ELSE IF( k.EQ.6 )
THEN
428 adds = dble( 2 * ( n - 1 ) )
431 CALL pcdotu( n, psclr, mem( ipx ), ix, jx, descx,
432 $ incx, mem( ipy ), iy, jy, descy, incy )
435 ELSE IF( k.EQ.7 )
THEN
439 adds = dble( 2 * ( n - 1 ) )
442 CALL pcdotc( n, psclr, mem( ipx ), ix, jx, descx,
443 $ incx, mem( ipy ), iy, jy, descy, incy )
446 ELSE IF( k.EQ.8 )
THEN
450 adds = dble( 2 * ( n - 1 ) )
453 CALL pscnrm2( n, pusclr, mem( ipx ), ix, jx, descx,
457 ELSE IF( k.EQ.9 )
THEN
461 adds = dble( 2 * ( n - 1 ) )
464 CALL pscasum( n, pusclr, mem( ipx ), ix, jx, descx,
468 ELSE IF( k.EQ.10 )
THEN
473 CALL pcamax( n, psclr, pisclr, mem( ipx ), ix, jx,
483 $
WRITE( nout, fmt = 9985 ) info
487 CALL pb_combine( ictxt,
'All',
'>',
'W', 1, 1, wtime )
488 CALL pb_combine( ictxt,
'All',
'>',
'C', 1, 1, ctime )
500 IF( wtime( 1 ).GT.0.0d+0 )
THEN
501 wflops = nops / ( wtime( 1 ) * 1.0d+6 )
508 IF( ctime( 1 ).GT.0.0d+0 )
THEN
509 cflops = nops / ( ctime( 1 ) * 1.0d+6 )
514 WRITE( nout, fmt = 9984 ) snames( k ), wtime( 1 ),
515 $ wflops, ctime( 1 ), cflops
521 40
IF( iam.EQ.0 )
THEN
522 WRITE( nout, fmt = 9995 )
523 WRITE( nout, fmt = * )
524 WRITE( nout, fmt = 9988 ) j
530 WRITE( nout, fmt = * )
531 WRITE( nout, fmt = 9987 )
532 WRITE( nout, fmt = * )
535 CALL blacs_gridexit( ictxt )
541 9999
FORMAT(
'ILLEGAL ', a,
': ', a,
' = ', i10,
542 $
' should be at least 1' )
543 9998
FORMAT(
'ILLEGAL GRID: NPROW*NPCOL = ', i4,
544 $
'. It can be at most', i4 )
545 9997
FORMAT(
'Bad ', a,
' parameters: going on to next test case.' )
546 9996
FORMAT( 2x,
'Test number ', i2 ,
' started on a ', i4,
' x ',
547 $ i4,
' process grid.' )
548 9995
FORMAT( 2x,
'---------------------------------------------------',
549 $
'--------------------------' )
550 9994
FORMAT( 2x,
' N IX JX MX NX IMBX INBX',
551 $
' MBX NBX RSRCX CSRCX INCX' )
552 9993
FORMAT( 2x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i5,1x,i5,1x,i5,1x,i5,1x,
554 9992
FORMAT( 2x,
' N IY JY MY NY IMBY INBY',
555 $
' MBY NBY RSRCY CSRCY INCY' )
556 9991
FORMAT(
'Not enough memory for this test: going on to',
557 $
' next test case.' )
558 9990
FORMAT(
'Not enough memory. Need: ', i12 )
559 9988
FORMAT( 2x,
'Test number ', i2,
' completed.' )
560 9987
FORMAT( 2x,
'End of Tests.' )
561 9986
FORMAT( 2x,
'Tests started.' )
562 9985
FORMAT( 2x,
' ***** Operation not supported, error code: ',
564 9984
FORMAT( 2x,
'| ', a, 2x, f13.3, 2x, f13.3, 2x, f13.3, 2x, f13.3 )
565 9983
FORMAT( 2x,
' WALL time (s) WALL Mflops ',
566 $
' CPU time (s) CPU Mflops' )
573 SUBROUTINE pcbla1timinfo( SUMMRY, NOUT, NMAT, NVAL, MXVAL, NXVAL,
574 $ IMBXVAL, MBXVAL, INBXVAL, NBXVAL,
575 $ RSCXVAL, CSCXVAL, IXVAL, JXVAL,
576 $ INCXVAL, MYVAL, NYVAL, IMBYVAL, MBYVAL,
577 $ INBYVAL, NBYVAL, RSCYVAL, CSCYVAL,
578 $ IYVAL, JYVAL, INCYVAL, LDVAL, NGRIDS,
579 $ PVAL, LDPVAL, QVAL, LDQVAL, LTEST, IAM,
580 $ NPROCS, ALPHA, WORK )
588 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NGRIDS, NMAT, NOUT,
593 CHARACTER*( * ) SUMMRY
595 INTEGER CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
596 $ IMBXVAL( LDVAL ), IMBYVAL( LDVAL ),
597 $ inbxval( ldval ), inbyval( ldval ),
598 $ incxval( ldval ), incyval( ldval ),
599 $ ixval( ldval ), iyval( ldval ), jxval( ldval ),
600 $ jyval( ldval ), mbxval( ldval ),
601 $ mbyval( ldval ), mxval( ldval ),
602 $ myval( ldval ), nbxval( ldval ),
603 $ nbyval( ldval ), nval( ldval ), nxval( ldval ),
604 $ nyval( ldval ), pval( ldpval ), qval( ldqval ),
605 $ rscxval( ldval ), rscyval( ldval ), work( * )
799 PARAMETER ( NIN = 11, nsubs = 10 )
810 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
811 $ blacs_gridinit, blacs_setup, cgebr2d, cgebs2d,
812 $
icopy, igebr2d, igebs2d, sgebr2d, sgebs2d
818 CHARACTER*7 SNAMES( NSUBS )
819 COMMON /SNAMEC/SNAMES
831 OPEN( nin, file=
'PCBLAS1TIM.dat', status=
'OLD' )
832 READ( nin, fmt = * ) summry
837 READ( nin, fmt = 9999 ) usrinfo
841 READ( nin, fmt = * ) summry
842 READ( nin, fmt = * ) nout
843 IF( nout.NE.0 .AND. nout.NE.6 )
844 $
OPEN( nout, file = summry, status =
'UNKNOWN' )
850 READ( nin, fmt = * ) ngrids
851 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval )
THEN
852 WRITE( nout, fmt = 9998 )
'Grids', ldpval
854 ELSE IF( ngrids.GT.ldqval )
THEN
855 WRITE( nout, fmt = 9998 )
'Grids', ldqval
861 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
862 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
866 READ( nin, fmt = * ) alpha
870 READ( nin, fmt = * ) nmat
871 IF( nmat.LT.1 .OR. nmat.GT.ldval )
THEN
872 WRITE( nout, fmt = 9998 )
'Tests', ldval
878 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
879 READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
880 READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
881 READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
882 READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
883 READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
884 READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
885 READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
886 READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
887 READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
888 READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
889 READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
890 READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
891 READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
892 READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
893 READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
894 READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
895 READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
896 READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
897 READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
898 READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
899 READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
900 READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
909 READ( nin, fmt = 9996,
END = 50 ) SNAMET, ltestt
911 IF( snamet.EQ.snames( i ) )
915 WRITE( nout, fmt = 9995 )snamet
931 IF( nprocs.LT.1 )
THEN
934 nprocs =
max( nprocs, pval( i )*qval( i ) )
936 CALL blacs_setup( iam, nprocs )
942 CALL blacs_get( -1, 0, ictxt )
943 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
947 CALL cgebs2d( ictxt,
'All',
' ', 1, 1, alpha, 1 )
951 CALL igebs2d( ictxt,
'All',
' ', 2, 1, work, 2 )
954 CALL icopy( ngrids, pval, 1, work( i ), 1 )
956 CALL icopy( ngrids, qval, 1, work( i ), 1 )
958 CALL icopy( nmat, nval, 1, work( i ), 1 )
960 CALL icopy( nmat, mxval, 1, work( i ), 1 )
962 CALL icopy( nmat, nxval, 1, work( i ), 1 )
964 CALL icopy( nmat, imbxval, 1, work( i ), 1 )
966 CALL icopy( nmat, inbxval, 1, work( i ), 1 )
968 CALL icopy( nmat, mbxval, 1, work( i ), 1 )
970 CALL icopy( nmat, nbxval, 1, work( i ), 1 )
972 CALL icopy( nmat, rscxval, 1, work( i ), 1 )
974 CALL icopy( nmat, cscxval, 1, work( i ), 1 )
976 CALL icopy( nmat, ixval, 1, work( i ), 1 )
978 CALL icopy( nmat, jxval, 1, work( i ), 1 )
980 CALL icopy( nmat, incxval, 1, work( i ), 1 )
982 CALL icopy( nmat, myval, 1, work( i ), 1 )
984 CALL icopy( nmat, nyval, 1, work( i ), 1 )
986 CALL icopy( nmat, imbyval, 1, work( i ), 1 )
988 CALL icopy( nmat, inbyval, 1, work( i ), 1 )
990 CALL icopy( nmat, mbyval, 1, work( i ), 1 )
992 CALL icopy( nmat, nbyval, 1, work( i ), 1 )
994 CALL icopy( nmat, rscyval, 1, work( i ), 1 )
996 CALL icopy( nmat, cscyval, 1, work( i ), 1 )
998 CALL icopy( nmat, iyval, 1, work( i ), 1 )
1000 CALL icopy( nmat, jyval, 1, work( i ), 1 )
1002 CALL icopy( nmat, incyval, 1, work( i ), 1 )
1006 IF( ltest( j ) )
THEN
1014 CALL igebs2d( ictxt,
'All',
' ', i, 1, work, i )
1018 WRITE( nout, fmt = 9999 )
1019 $
'Level 1 PBLAS timing program.'
1020 WRITE( nout, fmt = 9999 ) usrinfo
1021 WRITE( nout, fmt = * )
1022 WRITE( nout, fmt = 9999 )
1023 $
'Timing of the complex single precision '//
1025 WRITE( nout, fmt = * )
1026 WRITE( nout, fmt = 9999 )
1027 $
'The following parameter values will be used:'
1028 WRITE( nout, fmt = * )
1029 WRITE( nout, fmt = 9993 ) nmat
1030 WRITE( nout, fmt = 9992 ) ngrids
1031 WRITE( nout, fmt = 9990 )
1032 $
'P', ( pval(i), i = 1,
min(ngrids, 5) )
1034 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 6,
1035 $
min( 10, ngrids ) )
1037 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 11,
1038 $
min( 15, ngrids ) )
1040 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 16, ngrids )
1041 WRITE( nout, fmt = 9990 )
1042 $
'Q', ( qval(i), i = 1,
min(ngrids, 5) )
1044 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 6,
1045 $
min( 10, ngrids ) )
1047 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 11,
1048 $
min( 15, ngrids ) )
1050 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 16, ngrids )
1051 WRITE( nout, fmt = 9994 ) alpha
1052 IF( ltest( 1 ) )
THEN
1053 WRITE( nout, fmt = 9989 ) snames( 1 ),
' ... Yes'
1055 WRITE( nout, fmt = 9989 ) snames( 1 ),
' ... No '
1058 IF( ltest( i ) )
THEN
1059 WRITE( nout, fmt = 9988 ) snames( i ),
' ... Yes'
1061 WRITE( nout, fmt = 9988 ) snames( i ),
' ... No '
1064 WRITE( nout, fmt = * )
1071 $
CALL blacs_setup( iam, nprocs )
1076 CALL blacs_get( -1, 0, ictxt )
1077 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
1079 CALL cgebr2d( ictxt,
'All',
' ', 1, 1, alpha, 1, 0, 0 )
1081 CALL igebr2d( ictxt,
'All',
' ', 2, 1, work, 2, 0, 0 )
1085 i = 2*ngrids + 23*nmat + nsubs
1086 CALL igebr2d( ictxt,
'All',
' ', i, 1, work, i, 0, 0 )
1089 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1091 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1093 CALL icopy( nmat, work( i ), 1, nval, 1 )
1095 CALL icopy( nmat, work( i ), 1, mxval, 1 )
1097 CALL icopy( nmat, work( i ), 1, nxval, 1 )
1099 CALL icopy( nmat, work( i ), 1, imbxval, 1 )
1101 CALL icopy( nmat, work( i ), 1, inbxval, 1 )
1103 CALL icopy( nmat, work( i ), 1, mbxval, 1 )
1105 CALL icopy( nmat, work( i ), 1, nbxval, 1 )
1107 CALL icopy( nmat, work( i ), 1, rscxval, 1 )
1109 CALL icopy( nmat, work( i ), 1, cscxval, 1 )
1111 CALL icopy( nmat, work( i ), 1, ixval, 1 )
1113 CALL icopy( nmat, work( i ), 1, jxval, 1 )
1115 CALL icopy( nmat, work( i ), 1, incxval, 1 )
1117 CALL icopy( nmat, work( i ), 1, myval, 1 )
1119 CALL icopy( nmat, work( i ), 1, nyval, 1 )
1121 CALL icopy( nmat, work( i ), 1, imbyval, 1 )
1123 CALL icopy( nmat, work( i ), 1, inbyval, 1 )
1125 CALL icopy( nmat, work( i ), 1, mbyval, 1 )
1127 CALL icopy( nmat, work( i ), 1, nbyval, 1 )
1129 CALL icopy( nmat, work( i ), 1, rscyval, 1 )
1131 CALL icopy( nmat, work( i ), 1, cscyval, 1 )
1133 CALL icopy( nmat, work( i ), 1, iyval, 1 )
1135 CALL icopy( nmat, work( i ), 1, jyval, 1 )
1137 CALL icopy( nmat, work( i ), 1, incyval, 1 )
1141 IF( work( i ).EQ.1 )
THEN
1144 ltest( j ) = .false.
1151 CALL blacs_gridexit( ictxt )
1155 100
WRITE( nout, fmt = 9997 )
1157 IF( nout.NE.6 .AND. nout.NE.0 )
1159 CALL blacs_abort( ictxt, 1 )
1164 9998
FORMAT(
' Number of values of ',5a,
' is less than 1 or greater ',
1166 9997
FORMAT(
' Illegal input in file ',40a,
'. Aborting run.' )
1167 9996
FORMAT( a7, l2 )
1168 9995
FORMAT(
' Subprogram name ', a7,
' not recognized',
1169 $ /
' ******* TESTS ABANDONED *******' )
1170 9994
FORMAT( 2x,
'Alpha : (', g16.6,
1172 9993
FORMAT( 2x,
'Number of Tests : ', i6 )
1173 9992
FORMAT( 2x,
'Number of process grids : ', i6 )
1174 9991
FORMAT( 2x,
' : ', 5i6 )
1175 9990
FORMAT( 2x, a1,
' : ', 5i6 )
1176 9989
FORMAT( 2x,
'Routines to be tested : ', a, a8 )
1177 9988
FORMAT( 2x,
' ', a, a8 )