4 CHARACTER*7 SNAMES( NSUBS )
6 DATA snames/
'PCSWAP ',
'PCSCAL ',
7 $
'PCSSCAL',
'PCCOPY ',
'PCAXPY ',
8 $
'PCDOTU ',
'PCDOTC ',
'PSCNRM2',
108 INTEGER maxtests, maxgrids, gapmul, cplxsz, totmem,
112 parameter( maxtests = 20, maxgrids = 20, gapmul = 10,
113 $ cplxsz = 8, totmem = 2000000,
114 $ memsiz = totmem / cplxsz,
115 $ padval = ( -9923.0e+0, -9923.0e+0 ),
116 $ rzero = 0.0e+0, zero = ( 0.0e+0, 0.0e+0 ),
118 INTEGER block_cyclic_2d_inb, csrc_, ctxt_, dlen_,
119 $ dtype_, imb_, inb_, lld_, mb_, m_, nb_, n_,
121 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
122 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
123 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
124 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
127 LOGICAL errflg, sof, tee
128 INTEGER csrcx, csrcy, i, iam, ictxt, igap, imbx, imby,
129 $ imidx, imidy, inbx, inby, incx, incy, ipmatx,
130 $ ipmaty, ipostx, iposty, iprex, iprey, ipw, ipx,
131 $ ipy, iverb, ix, ixseed, iy, iyseed, j, jx, jy,
132 $ k, ldx, ldy, mbx, mby, memreqd, mpx, mpy, mx,
133 $ my, mycol, myrow, n, nbx, nby, ngrids, nout,
134 $ npcol, nprocs, nprow, nqx, nqy, ntests, nx, ny,
135 $ pisclr, rsrcx, rsrcy, tskip, tstcnt
141 LOGICAL ltest( nsubs ), ycheck( nsubs )
142 INTEGER cscxval( maxtests ), cscyval( maxtests ),
143 $ descx( dlen_ ), descxr( dlen_ ),
144 $ descy( dlen_ ), descyr( dlen_ ), ierr( 4 ),
145 $ imbxval( maxtests ), imbyval( maxtests ),
146 $ inbxval( maxtests ), inbyval( maxtests ),
147 $ incxval( maxtests ), incyval( maxtests ),
148 $ ixval( maxtests ), iyval( maxtests ),
149 $ jxval( maxtests ), jyval( maxtests ),
150 $ kfail( nsubs ), kpass( nsubs ), kskip( nsubs ),
151 $ ktests( nsubs ), mbxval( maxtests ),
152 $ mbyval( maxtests ), mxval( maxtests ),
153 $ myval( maxtests ), nbxval( maxtests ),
154 $ nbyval( maxtests ), nval( maxtests ),
155 $ nxval( maxtests ), nyval( maxtests ),
156 $ pval( maxtests ), qval( maxtests ),
157 $ rscxval( maxtests ), rscyval( maxtests )
158 COMPLEX mem( memsiz )
161 EXTERNAL blacs_exit, blacs_get, blacs_gridexit,
162 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
171 INTRINSIC abs,
max, mod, real
174 CHARACTER*7 snames( nsubs )
177 COMMON /snamec/snames
178 COMMON /infoc/info, nblog
179 COMMON /pberrorc/nout, abrtflg
182 DATA ycheck/.true., .false., .false., .true.,
183 $ .true., .true., .true., .false., .false.,
219 CALL blacs_pinfo( iam, nprocs )
220 CALL pcbla1tstinfo( outfile, nout, ntests, nval, mxval, nxval,
221 $ imbxval, mbxval, inbxval, nbxval, rscxval,
222 $ cscxval, ixval, jxval, incxval, myval,
223 $ nyval, imbyval, mbyval, inbyval, nbyval,
224 $ rscyval, cscyval, iyval, jyval, incyval,
225 $ maxtests, ngrids, pval, maxgrids, qval,
226 $ maxgrids, ltest, sof, tee, iam, igap, iverb,
227 $ nprocs, alpha, mem )
230 WRITE( nout, fmt = 9979 )
231 WRITE( nout, fmt = * )
249 IF( nprow.LT.1 )
THEN
251 $
WRITE( nout, fmt = 9999 )
'GRID SIZE',
'NPROW', nprow
253 ELSE IF( npcol.LT.1 )
THEN
255 $
WRITE( nout, fmt = 9999 )
'GRID SIZE',
'NPCOL', npcol
257 ELSE IF( nprow*npcol.GT.nprocs )
THEN
259 $
WRITE( nout, fmt = 9998 ) nprow*npcol, nprocs
263 IF( ierr( 1 ).GT.0 )
THEN
265 $
WRITE( nout, fmt = 9997 )
'GRID'
272 CALL blacs_get( -1, 0, ictxt )
273 CALL blacs_gridinit( ictxt,
'Row-major', nprow, npcol )
274 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
279 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
314 WRITE( nout, fmt = * )
315 WRITE( nout, fmt = 9996 ) tstcnt, nprow, npcol
316 WRITE( nout, fmt = * )
318 WRITE( nout, fmt = 9995 )
319 WRITE( nout, fmt = 9994 )
320 WRITE( nout, fmt = 9995 )
321 WRITE( nout, fmt = 9993 ) n, ix, jx, mx, nx, imbx, inbx,
322 $ mbx, nbx, rsrcx, csrcx, incx
324 WRITE( nout, fmt = 9995 )
325 WRITE( nout, fmt = 9992 )
326 WRITE( nout, fmt = 9995 )
327 WRITE( nout, fmt = 9993 ) n, iy, jy, my, ny, imby, inby,
328 $ mby, nby, rsrcy, csrcy, incy
329 WRITE( nout, fmt = 9995 )
335 $ block_cyclic_2d_inb, mx, nx, imbx, inbx,
336 $ mbx, nbx, rsrcx, csrcx, incx, mpx, nqx,
337 $ iprex, imidx, ipostx, igap, gapmul,
340 $ block_cyclic_2d_inb, my, ny, imby, inby,
341 $ mby, nby, rsrcy, csrcy, incy, mpy, nqy,
342 $ iprey, imidy, iposty, igap, gapmul,
345 IF( ierr( 1 ).GT.0 .OR. ierr( 2 ).GT.0 )
THEN
357 ipy = ipx + descx( lld_ ) * nqx + ipostx + iprey
358 ipmatx = ipy + descy( lld_ ) * nqy + iposty
359 ipmaty = ipmatx + mx * nx
360 ipw = ipmaty + my * ny
368 $
max(
max( imbx, mbx ),
max( imby, mby ) )
370 IF( memreqd.GT.memsiz )
THEN
372 $
WRITE( nout, fmt = 9990 ) memreqd*cplxsz
378 CALL igsum2d( ictxt,
'All',
' ', 1, 1, ierr, 1, -1, 0 )
380 IF( ierr( 1 ).GT.0 )
THEN
382 $
WRITE( nout, fmt = 9991 )
393 IF( .NOT.ltest( k ) )
397 WRITE( nout, fmt = * )
398 WRITE( nout, fmt = 9989 ) snames( k )
403 CALL pvdimchk( ictxt, nout, n,
'X', ix, jx, descx, incx,
405 CALL pvdimchk( ictxt, nout, n,
'Y', iy, jy, descy, incy,
408 IF( ierr( 1 ).NE.0 .OR. ierr( 2 ).NE.0 )
THEN
409 kskip( k ) = kskip( k ) + 1
415 CALL pclagen( .false.,
'None',
'No diag', 0, mx, nx, 1,
416 $ 1, descx, ixseed, mem( ipx ),
419 $
CALL pclagen( .false.,
'None',
'No diag', 0, my, ny,
420 $ 1, 1, descy, iyseed, mem( ipy ),
425 CALL pb_descset2( descxr, mx, nx, imbx, inbx, mbx, nbx,
426 $ -1, -1, ictxt,
max( 1, mx ) )
427 CALL pclagen( .false.,
'None',
'No diag', 0, mx, nx, 1,
428 $ 1, descxr, ixseed, mem( ipmatx ),
430 IF( ycheck( k ) )
THEN
432 $ nby, -1, -1, ictxt,
max( 1, my ) )
433 CALL pclagen( .false.,
'None',
'No diag', 0, my, ny,
434 $ 1, 1, descyr, iyseed, mem( ipmaty ),
440 CALL pb_cfillpad( ictxt, mpx, nqx, mem( ipx-iprex ),
441 $ descx( lld_ ), iprex, ipostx, padval )
443 IF( ycheck( k ) )
THEN
444 CALL pb_cfillpad( ictxt, mpy, nqy, mem( ipy-iprey ),
445 $ descy( lld_ ), iprey, iposty,
452 CALL pcchkarg1( ictxt, nout, snames( k ), n, alpha, ix,
453 $ jx, descx, incx, iy, jy, descy, incy,
463 IF( iverb.EQ.2 )
THEN
464 IF( incx.EQ.descx( m_ ) )
THEN
466 $ 0, 0,
'PARALLEL_INITIAL_X', nout,
470 $ 0, 0,
'PARALLEL_INITIAL_X', nout,
473 IF( ycheck( k ) )
THEN
474 IF( incy.EQ.descy( m_ ) )
THEN
477 $
'PARALLEL_INITIAL_Y', nout,
482 $
'PARALLEL_INITIAL_Y', nout,
486 ELSE IF( iverb.GE.3 )
THEN
487 CALL pb_pclaprnt( mx, nx, mem( ipx ), 1, 1, descx, 0,
488 $ 0,
'PARALLEL_INITIAL_X', nout,
491 $
CALL pb_pclaprnt( my, ny, mem( ipy ), 1, 1, descy,
492 $ 0, 0,
'PARALLEL_INITIAL_Y', nout,
502 CALL pcswap( n, mem( ipx ), ix, jx, descx, incx,
503 $ mem( ipy ), iy, jy, descy, incy )
505 ELSE IF( k.EQ.2 )
THEN
510 CALL pcscal( n, alpha, mem( ipx ), ix, jx, descx,
513 ELSE IF( k.EQ.3 )
THEN
517 pusclr = real( alpha )
518 CALL pcsscal( n, real( alpha ), mem( ipx ), ix, jx,
521 ELSE IF( k.EQ.4 )
THEN
525 CALL pccopy( n, mem( ipx ), ix, jx, descx, incx,
526 $ mem( ipy ), iy, jy, descy, incy )
528 ELSE IF( k.EQ.5 )
THEN
533 CALL pcaxpy( n, alpha, mem( ipx ), ix, jx, descx,
534 $ incx, mem( ipy ), iy, jy, descy, incy )
536 ELSE IF( k.EQ.6 )
THEN
540 CALL pcdotu( n, psclr, mem( ipx ), ix, jx, descx,
541 $ incx, mem( ipy ), iy, jy, descy, incy )
543 ELSE IF( k.EQ.7 )
THEN
547 CALL pcdotc( n, psclr, mem( ipx ), ix, jx, descx,
548 $ incx, mem( ipy ), iy, jy, descy, incy )
550 ELSE IF( k.EQ.8 )
THEN
554 CALL pscnrm2( n, pusclr, mem( ipx ), ix, jx, descx,
557 ELSE IF( k.EQ.9 )
THEN
561 CALL pscasum( n, pusclr, mem( ipx ), ix, jx, descx,
564 ELSE IF( k.EQ.10 )
THEN
566 CALL pcamax( n, psclr, pisclr, mem( ipx ), ix, jx,
574 kskip( k ) = kskip( k ) + 1
576 $
WRITE( nout, fmt = 9978 ) info
583 $ pisclr, mem( ipmatx ), mem( ipx ),
584 $ ix, jx, descx, incx, mem( ipmaty ),
585 $ mem( ipy ), iy, jy, descy, incy,
587 IF( mod( info, 2 ).EQ.1 )
THEN
589 ELSE IF( mod( info / 2, 2 ).EQ.1 )
THEN
591 ELSE IF( info.NE.0 )
THEN
599 $ mem( ipx-iprex ), descx( lld_ ),
600 $ iprex, ipostx, padval )
601 IF( ycheck( k ) )
THEN
603 $ mem( ipy-iprey ), descy( lld_ ),
604 $ iprey, iposty, padval )
610 CALL pcchkarg1( ictxt, nout, snames( k ), n, alpha, ix,
611 $ jx, descx, incx, iy, jy, descy, incy,
616 CALL pcchkvout( n, mem( ipmatx ), mem( ipx ), ix, jx,
617 $ descx, incx, ierr( 3 ) )
619 IF( ierr( 3 ).NE.0 )
THEN
621 $
WRITE( nout, fmt = 9986 )
'PARALLEL_X', snames( k )
624 IF( ycheck( k ) )
THEN
625 CALL pcchkvout( n, mem( ipmaty ), mem( ipy ), iy, jy,
626 $ descy, incy, ierr( 4 ) )
627 IF( ierr( 4 ).NE.0 )
THEN
629 $
WRITE( nout, fmt = 9986 )
'PARALLEL_Y',
636 IF( info.NE.0 .OR. ierr( 1 ).NE.0 .OR.
637 $ ierr( 2 ).NE.0 .OR. ierr( 3 ).NE.0 .OR.
638 $ ierr( 4 ).NE. 0 )
THEN
640 $
WRITE( nout, fmt = 9988 ) snames( k )
641 kfail( k ) = kfail( k ) + 1
645 $
WRITE( nout, fmt = 9987 ) snames( k )
646 kpass( k ) = kpass( k ) + 1
651 IF( iverb.GE.1 .AND. errflg )
THEN
652 IF( ierr( 3 ).NE.0 .OR. iverb.GE.3 )
THEN
653 CALL pcmprnt( ictxt, nout, mx, nx, mem( ipmatx ),
654 $ ldx, 0, 0,
'SERIAL_X' )
656 $ 0, 0,
'PARALLEL_X', nout,
658 ELSE IF( ierr( 1 ).NE.0 )
THEN
660 $
CALL pcvprnt( ictxt, nout, n,
661 $ mem( ipmatx+ix-1+(jx-1)*ldx ),
662 $ incx, 0, 0,
'SERIAL_X' )
663 IF( incx.EQ.descx( m_ ) )
THEN
665 $ descx, 0, 0,
'PARALLEL_X',
666 $ nout, mem( ipmatx ) )
669 $ descx, 0, 0,
'PARALLEL_X',
670 $ nout, mem( ipmatx ) )
673 IF( ycheck( k ) )
THEN
674 IF( ierr( 4 ).NE.0 .OR. iverb.GE.3 )
THEN
675 CALL pcmprnt( ictxt, nout, my, ny,
676 $ mem( ipmaty ), ldy, 0, 0,
679 $ descy, 0, 0,
'PARALLEL_Y',
680 $ nout, mem( ipmatx ) )
681 ELSE IF( ierr( 2 ).NE.0 )
THEN
683 $
CALL pcvprnt( ictxt, nout, n,
684 $ mem( ipmaty+iy-1+(jy-1)*ldy ),
685 $ incy, 0, 0,
'SERIAL_Y' )
686 IF( incy.EQ.descy( m_ ) )
THEN
688 $ descy, 0, 0,
'PARALLEL_Y',
689 $ nout, mem( ipmatx ) )
692 $ descy, 0, 0,
'PARALLEL_Y',
693 $ nout, mem( ipmatx ) )
706 40
IF( iam.EQ.0 )
THEN
707 WRITE( nout, fmt = * )
708 WRITE( nout, fmt = 9985 ) j
713 CALL blacs_gridexit( ictxt )
724 IF( ltest( i ) )
THEN
725 kskip( i ) = kskip( i ) + tskip
726 ktests( i ) = kskip( i ) + kfail( i ) + kpass( i )
733 WRITE( nout, fmt = * )
734 WRITE( nout, fmt = 9981 )
735 WRITE( nout, fmt = * )
736 WRITE( nout, fmt = 9983 )
737 WRITE( nout, fmt = 9982 )
740 WRITE( nout, fmt = 9984 )
'|', snames( i ), ktests( i ),
741 $ kpass( i ), kfail( i ), kskip( i )
743 WRITE( nout, fmt = * )
744 WRITE( nout, fmt = 9980 )
745 WRITE( nout, fmt = * )
751 9999
FORMAT(
'ILLEGAL ', a,
': ', a,
' = ', i10,
752 $
' should be at least 1' )
753 9998
FORMAT(
'ILLEGAL GRID: NPROW*NPCOL = ', i4,
754 $
'. It can be at most', i4 )
755 9997
FORMAT(
'Bad ', a,
' parameters: going on to next test case.' )
756 9996
FORMAT( 2x,
'Test number ', i4 ,
' started on a ', i6,
' x ',
757 $ i6,
' process grid.' )
758 9995
FORMAT( 2x,
'---------------------------------------------------',
759 $
'--------------------------' )
760 9994
FORMAT( 2x,
' N IX JX MX NX IMBX INBX',
761 $
' MBX NBX RSRCX CSRCX INCX' )
762 9993
FORMAT( 2x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i5,1x,i5,1x,i5,1x,i5,1x,
764 9992
FORMAT( 2x,
' N IY JY MY NY IMBY INBY',
765 $
' MBY NBY RSRCY CSRCY INCY' )
766 9991
FORMAT(
'Not enough memory for this test: going on to',
767 $
' next test case.' )
768 9990
FORMAT(
'Not enough memory. Need: ', i12 )
769 9989
FORMAT( 2x,
' Tested Subroutine: ', a )
770 9988
FORMAT( 2x,
' ***** Computational check: ', a,
' ',
771 $
' FAILED ',
' *****' )
772 9987
FORMAT( 2x,
' ***** Computational check: ', a,
' ',
773 $
' PASSED ',
' *****' )
774 9986
FORMAT( 2x,
' ***** ERROR ***** Matrix operand ', a,
775 $
' modified by ', a,
' *****' )
776 9985
FORMAT( 2x,
'Test number ', i4,
' completed.' )
777 9984
FORMAT( 2x,a1,2x,a7,8x,i4,6x,i4,5x,i4,4x,i4 )
778 9983
FORMAT( 2x,
' SUBROUTINE TOTAL TESTS PASSED FAILED ',
780 9982
FORMAT( 2x,
' ---------- ----------- ------ ------ ',
782 9981
FORMAT( 2x,
'Testing Summary')
783 9980
FORMAT( 2x,
'End of Tests.' )
784 9979
FORMAT( 2x,
'Tests started.' )
785 9978
FORMAT( 2x,
' ***** Operation not supported, error code: ',
794 $ NXVAL, IMBXVAL, MBXVAL, INBXVAL,
795 $ NBXVAL, RSCXVAL, CSCXVAL, IXVAL,
796 $ JXVAL, INCXVAL, MYVAL, NYVAL, IMBYVAL,
797 $ MBYVAL, INBYVAL, NBYVAL, RSCYVAL,
798 $ CSCYVAL, IYVAL, JYVAL, INCYVAL,
799 $ LDVAL, NGRIDS, PVAL, LDPVAL, QVAL,
800 $ LDQVAL, LTEST, SOF, TEE, IAM, IGAP,
801 $ IVERB, NPROCS, ALPHA, WORK )
810 INTEGER IAM, IGAP, IVERB, LDPVAL, LDQVAL, LDVAL,
811 $ NGRIDS, NMAT, NOUT, NPROCS
815 CHARACTER*( * ) SUMMRY
817 INTEGER CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
818 $ imbxval( ldval ), imbyval( ldval ),
819 $ inbxval( ldval ), inbyval( ldval ),
820 $ incxval( ldval ), incyval( ldval ),
821 $ ixval( ldval ), iyval( ldval ), jxval( ldval ),
822 $ jyval( ldval ), mbxval( ldval ),
823 $ mbyval( ldval ), mxval( ldval ),
824 $ myval( ldval ), nbxval( ldval ),
825 $ nbyval( ldval ), nval( ldval ), nxval( ldval ),
826 $ nyval( ldval ), pval( ldpval ), qval( ldqval ),
827 $ rscxval( ldval ), rscyval( ldval ), work( * )
1037 PARAMETER ( NIN = 11, nsubs = 10 )
1046 CHARACTER*79 USRINFO
1049 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
1050 $ blacs_gridinit, blacs_setup, cgebr2d, cgebs2d,
1051 $
icopy, igebr2d, igebs2d, sgebr2d, sgebs2d
1061 CHARACTER*7 SNAMES( NSUBS )
1062 COMMON /snamec/snames
1073 OPEN( nin, file=
'PCBLAS1TST.dat', status=
'OLD' )
1074 READ( nin, fmt = * ) summry
1079 READ( nin, fmt = 9999 ) usrinfo
1083 READ( nin, fmt = * ) summry
1084 READ( nin, fmt = * ) nout
1085 IF( nout.NE.0 .AND. nout.NE.6 )
1086 $
OPEN( nout, file = summry, status =
'UNKNOWN' )
1092 READ( nin, fmt = * ) sof
1096 READ( nin, fmt = * ) tee
1100 READ( nin, fmt = * ) iverb
1101 IF( iverb.LT.0 .OR. iverb.GT.3 )
1106 READ( nin, fmt = * ) igap
1112 READ( nin, fmt = * ) ngrids
1113 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval )
THEN
1114 WRITE( nout, fmt = 9998 )
'Grids', ldpval
1116 ELSE IF( ngrids.GT.ldqval )
THEN
1117 WRITE( nout, fmt = 9998 )
'Grids', ldqval
1123 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
1124 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
1128 READ( nin, fmt = * ) alpha
1132 READ( nin, fmt = * ) nmat
1133 IF( nmat.LT.1 .OR. nmat.GT.ldval )
THEN
1134 WRITE( nout, fmt = 9998 )
'Tests', ldval
1140 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
1141 READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
1142 READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
1143 READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
1144 READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
1145 READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
1146 READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
1147 READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
1148 READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
1149 READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
1150 READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
1151 READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
1152 READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
1153 READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
1154 READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
1155 READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
1156 READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
1157 READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
1158 READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
1159 READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
1160 READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
1161 READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
1162 READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
1168 ltest( i ) = .false.
1171 READ( nin, fmt = 9996,
END = 50 ) SNAMET, ltestt
1173 IF( snamet.EQ.snames( i ) )
1177 WRITE( nout, fmt = 9995 )snamet
1193 IF( nprocs.LT.1 )
THEN
1196 nprocs =
max( nprocs, pval( i )*qval( i ) )
1198 CALL blacs_setup( iam, nprocs )
1204 CALL blacs_get( -1, 0, ictxt )
1205 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
1213 CALL cgebs2d( ictxt,
'All',
' ', 1, 1, alpha, 1 )
1217 CALL igebs2d( ictxt,
'All',
' ', 2, 1, work, 2 )
1236 CALL icopy( ngrids, pval, 1, work( i ), 1 )
1238 CALL icopy( ngrids, qval, 1, work( i ), 1 )
1240 CALL icopy( nmat, nval, 1, work( i ), 1 )
1242 CALL icopy( nmat, mxval, 1, work( i ), 1 )
1244 CALL icopy( nmat, nxval, 1, work( i ), 1 )
1246 CALL icopy( nmat, imbxval, 1, work( i ), 1 )
1248 CALL icopy( nmat, inbxval, 1, work( i ), 1 )
1250 CALL icopy( nmat, mbxval, 1, work( i ), 1 )
1252 CALL icopy( nmat, nbxval, 1, work( i ), 1 )
1254 CALL icopy( nmat, rscxval, 1, work( i ), 1 )
1256 CALL icopy( nmat, cscxval, 1, work( i ), 1 )
1258 CALL icopy( nmat, ixval, 1, work( i ), 1 )
1260 CALL icopy( nmat, jxval, 1, work( i ), 1 )
1262 CALL icopy( nmat, incxval, 1, work( i ), 1 )
1264 CALL icopy( nmat, myval, 1, work( i ), 1 )
1266 CALL icopy( nmat, nyval, 1, work( i ), 1 )
1268 CALL icopy( nmat, imbyval, 1, work( i ), 1 )
1270 CALL icopy( nmat, inbyval, 1, work( i ), 1 )
1272 CALL icopy( nmat, mbyval, 1, work( i ), 1 )
1274 CALL icopy( nmat, nbyval, 1, work( i ), 1 )
1276 CALL icopy( nmat, rscyval, 1, work( i ), 1 )
1278 CALL icopy( nmat, cscyval, 1, work( i ), 1 )
1280 CALL icopy( nmat, iyval, 1, work( i ), 1 )
1282 CALL icopy( nmat, jyval, 1, work( i ), 1 )
1284 CALL icopy( nmat, incyval, 1, work( i ), 1 )
1288 IF( ltest( j ) )
THEN
1296 CALL igebs2d( ictxt,
'All',
' ', i, 1, work, i )
1300 WRITE( nout, fmt = 9999 )
'Level 1 PBLAS testing program.'
1301 WRITE( nout, fmt = 9999 ) usrinfo
1302 WRITE( nout, fmt = * )
1303 WRITE( nout, fmt = 9999 )
1304 $
'Tests of the complex single precision '//
1306 WRITE( nout, fmt = * )
1307 WRITE( nout, fmt = 9999 )
1308 $
'The following parameter values will be used:'
1309 WRITE( nout, fmt = * )
1310 WRITE( nout, fmt = 9993 ) nmat
1311 WRITE( nout, fmt = 9992 ) ngrids
1312 WRITE( nout, fmt = 9990 )
1313 $
'P', ( pval(i), i = 1,
min(ngrids, 5) )
1315 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 6,
1316 $
min( 10, ngrids ) )
1318 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 11,
1319 $
min( 15, ngrids ) )
1321 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 16, ngrids )
1322 WRITE( nout, fmt = 9990 )
1323 $
'Q', ( qval(i), i = 1,
min(ngrids, 5) )
1325 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 6,
1326 $
min( 10, ngrids ) )
1328 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 11,
1329 $
min( 15, ngrids ) )
1331 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 16, ngrids )
1332 WRITE( nout, fmt = 9988 ) sof
1333 WRITE( nout, fmt = 9987 ) tee
1334 WRITE( nout, fmt = 9983 ) igap
1335 WRITE( nout, fmt = 9986 ) iverb
1336 WRITE( nout, fmt = 9982 ) alpha
1337 IF( ltest( 1 ) )
THEN
1338 WRITE( nout, fmt = 9985 ) snames( 1 ),
' ... Yes'
1340 WRITE( nout, fmt = 9985 ) snames( 1 ),
' ... No '
1343 IF( ltest( i ) )
THEN
1344 WRITE( nout, fmt = 9984 ) snames( i ),
' ... Yes'
1346 WRITE( nout, fmt = 9984 ) snames( i ),
' ... No '
1349 WRITE( nout, fmt = 9994 ) eps
1350 WRITE( nout, fmt = * )
1357 $
CALL blacs_setup( iam, nprocs )
1362 CALL blacs_get( -1, 0, ictxt )
1363 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
1369 CALL cgebr2d( ictxt,
'All',
' ', 1, 1, alpha, 1, 0, 0 )
1371 CALL igebr2d( ictxt,
'All',
' ', 2, 1, work, 2, 0, 0 )
1375 i = 2*ngrids + 23*nmat + nsubs + 4
1376 CALL igebr2d( ictxt,
'All',
' ', i, 1, work, i, 0, 0 )
1379 IF( work( i ).EQ.1 )
THEN
1385 IF( work( i ).EQ.1 )
THEN
1395 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1397 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1399 CALL icopy( nmat, work( i ), 1, nval, 1 )
1401 CALL icopy( nmat, work( i ), 1, mxval, 1 )
1403 CALL icopy( nmat, work( i ), 1, nxval, 1 )
1405 CALL icopy( nmat, work( i ), 1, imbxval, 1 )
1407 CALL icopy( nmat, work( i ), 1, inbxval, 1 )
1409 CALL icopy( nmat, work( i ), 1, mbxval, 1 )
1411 CALL icopy( nmat, work( i ), 1, nbxval, 1 )
1413 CALL icopy( nmat, work( i ), 1, rscxval, 1 )
1415 CALL icopy( nmat, work( i ), 1, cscxval, 1 )
1417 CALL icopy( nmat, work( i ), 1, ixval, 1 )
1419 CALL icopy( nmat, work( i ), 1, jxval, 1 )
1421 CALL icopy( nmat, work( i ), 1, incxval, 1 )
1423 CALL icopy( nmat, work( i ), 1, myval, 1 )
1425 CALL icopy( nmat, work( i ), 1, nyval, 1 )
1427 CALL icopy( nmat, work( i ), 1, imbyval, 1 )
1429 CALL icopy( nmat, work( i ), 1, inbyval, 1 )
1431 CALL icopy( nmat, work( i ), 1, mbyval, 1 )
1433 CALL icopy( nmat, work( i ), 1, nbyval, 1 )
1435 CALL icopy( nmat, work( i ), 1, rscyval, 1 )
1437 CALL icopy( nmat, work( i ), 1, cscyval, 1 )
1439 CALL icopy( nmat, work( i ), 1, iyval, 1 )
1441 CALL icopy( nmat, work( i ), 1, jyval, 1 )
1443 CALL icopy( nmat, work( i ), 1, incyval, 1 )
1447 IF( work( i ).EQ.1 )
THEN
1450 ltest( j ) = .false.
1457 CALL blacs_gridexit( ictxt )
1461 100
WRITE( nout, fmt = 9997 )
1463 IF( nout.NE.6 .AND. nout.NE.0 )
1465 CALL blacs_abort( ictxt, 1 )
1470 9998
FORMAT(
' Number of values of ',5a,
' is less than 1 or greater ',
1472 9997
FORMAT(
' Illegal input in file ',40a,
'. Aborting run.' )
1473 9996
FORMAT( a7, l2 )
1474 9995
FORMAT(
' Subprogram name ', a7,
' not recognized',
1475 $ /
' ******* TESTS ABANDONED *******' )
1476 9994
FORMAT( 2x,
'Relative machine precision (eps) is taken to be ',
1478 9993
FORMAT( 2x,
'Number of Tests : ', i6 )
1479 9992
FORMAT( 2x,
'Number of process grids : ', i6 )
1480 9991
FORMAT( 2x,
' : ', 5i6 )
1481 9990
FORMAT( 2x, a1,
' : ', 5i6 )
1482 9988
FORMAT( 2x,
'Stop on failure flag : ', l6 )
1483 9987
FORMAT( 2x,
'Test for error exits flag : ', l6 )
1484 9986
FORMAT( 2x,
'Verbosity level : ', i6 )
1485 9985
FORMAT( 2x,
'Routines to be tested : ', a, a8 )
1486 9984
FORMAT( 2x,
' ', a, a8 )
1487 9983
FORMAT( 2x,
'Leading dimension gap : ', i6 )
1488 9982
FORMAT( 2x,
'Alpha : (', g16.6,
1502 INTEGER INOUT, NPROCS
1638 PARAMETER ( NSUBS = 10 )
1642 INTEGER I, ICTXT, MYCOL, MYROW, NPCOL, NPROW
1645 INTEGER SCODE( NSUBS )
1648 EXTERNAL blacs_get, blacs_gridexit, blacs_gridinfo,
1649 $ blacs_gridinit, pcamax, pcaxpy, pccopy,
1650 $
pcdimee, pcdotc, pcdotu, pcscal, pcsscal,
1651 $ pcswap,
pcvecee, pscasum, pscnrm2
1656 CHARACTER*7 SNAMES( NSUBS )
1657 COMMON /SNAMEC/SNAMES
1658 COMMON /PBERRORC/NOUT, ABRTFLG
1661 DATA SCODE/11, 12, 12, 11, 13, 13, 13, 15, 15, 14/
1668 CALL blacs_get( -1, 0, ictxt )
1669 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
1670 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
1683 IF( ltest( i ) )
THEN
1684 CALL pcdimee( ictxt, nout, pcswap, scode( i ), snames( i ) )
1685 CALL pcvecee( ictxt, nout, pcswap, scode( i ), snames( i ) )
1691 IF( ltest( i ) )
THEN
1692 CALL pcdimee( ictxt, nout, pcscal, scode( i ), snames( i ) )
1693 CALL pcvecee( ictxt, nout, pcscal, scode( i ), snames( i ) )
1699 IF( ltest( i ) )
THEN
1700 CALL pcdimee( ictxt, nout, pcsscal, scode( i ), snames( i ) )
1701 CALL pcvecee( ictxt, nout, pcsscal, scode( i ), snames( i ) )
1707 IF( ltest( i ) )
THEN
1708 CALL pcdimee( ictxt, nout, pccopy, scode( i ), snames( i ) )
1709 CALL pcvecee( ictxt, nout, pccopy, scode( i ), snames( i ) )
1715 IF( ltest( i ) )
THEN
1716 CALL pcdimee( ictxt, nout, pcaxpy, scode( i ), snames( i ) )
1717 CALL pcvecee( ictxt, nout, pcaxpy, scode( i ), snames( i ) )
1723 IF( ltest( i ) )
THEN
1724 CALL pcdimee( ictxt, nout, pcdotu, scode( i ), snames( i ) )
1725 CALL pcvecee( ictxt, nout, pcdotu, scode( i ), snames( i ) )
1731 IF( ltest( i ) )
THEN
1732 CALL pcdimee( ictxt, nout, pcdotc, scode( i ), snames( i ) )
1733 CALL pcvecee( ictxt, nout, pcdotc, scode( i ), snames( i ) )
1739 IF( ltest( i ) )
THEN
1740 CALL pcdimee( ictxt, nout, pscnrm2, scode( i ), snames( i ) )
1741 CALL pcvecee( ictxt, nout, pscnrm2, scode( i ), snames( i ) )
1747 IF( ltest( i ) )
THEN
1748 CALL pcdimee( ictxt, nout, pscasum, scode( i ), snames( i ) )
1749 CALL pcvecee( ictxt, nout, pscasum, scode( i ), snames( i ) )
1755 IF( ltest( i ) )
THEN
1756 CALL pcdimee( ictxt, nout, pcamax, scode( i ), snames( i ) )
1757 CALL pcvecee( ictxt, nout, pcamax, scode( i ), snames( i ) )
1760 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
1761 $
WRITE( nout, fmt = 9999 )
1763 CALL blacs_gridexit( ictxt )
1769 9999
FORMAT( 2x,
'Error-exit tests completed.' )
1777 $ DESCX, INCX, IY, JY, DESCY, INCY, INFO )
1785 INTEGER ICTXT, INCX, INCY, INFO, IX, IY, JX, JY, N,
1791 INTEGER DESCX( * ), DESCY( * )
1936 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
1937 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
1939 PARAMETER ( BLOCK_CYCLIC_2D_INB = 2, dlen_ = 11,
1940 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
1941 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
1942 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
1945 INTEGER I, INCXREF, INCYREF, IXREF, IYREF, JXREF,
1946 $ JYREF, MYCOL, MYROW, NPCOL, NPROW, NREF
1950 CHARACTER*15 ARGNAME
1951 INTEGER DESCXREF( DLEN_ ), DESCYREF( DLEN_ )
1954 EXTERNAL blacs_gridinfo, igsum2d
1963 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
1967 IF( info.EQ.0 )
THEN
1973 descxref( i ) = descx( i )
1979 descyref( i ) = descy( i )
1989 IF( n.NE.nref )
THEN
1990 WRITE( argname, fmt =
'(A)' )
'N'
1991 ELSE IF( ix.NE.ixref )
THEN
1992 WRITE( argname, fmt =
'(A)' )
'IX'
1993 ELSE IF( jx.NE.jxref )
THEN
1994 WRITE( argname, fmt =
'(A)' )
'JX'
1995 ELSE IF( descx( dtype_ ).NE.descxref( dtype_ ) )
THEN
1996 WRITE( argname, fmt =
'(A)' )
'DESCX( DTYPE_ )'
1997 ELSE IF( descx( m_ ).NE.descxref( m_ ) )
THEN
1998 WRITE( argname, fmt =
'(A)' )
'DESCX( M_ )'
1999 ELSE IF( descx( n_ ).NE.descxref( n_ ) )
THEN
2000 WRITE( argname, fmt =
'(A)' )
'DESCX( N_ )'
2001 ELSE IF( descx( imb_ ).NE.descxref( imb_ ) )
THEN
2002 WRITE( argname, fmt =
'(A)' )
'DESCX( IMB_ )'
2003 ELSE IF( descx( inb_ ).NE.descxref( inb_ ) )
THEN
2004 WRITE( argname, fmt =
'(A)' )
'DESCX( INB_ )'
2005 ELSE IF( descx( mb_ ).NE.descxref( mb_ ) )
THEN
2006 WRITE( argname, fmt =
'(A)' )
'DESCX( MB_ )'
2007 ELSE IF( descx( nb_ ).NE.descxref( nb_ ) )
THEN
2008 WRITE( argname, fmt =
'(A)' )
'DESCX( NB_ )'
2009 ELSE IF( descx( rsrc_ ).NE.descxref( rsrc_ ) )
THEN
2010 WRITE( argname, fmt =
'(A)' )
'DESCX( RSRC_ )'
2011 ELSE IF( descx( csrc_ ).NE.descxref( csrc_ ) )
THEN
2012 WRITE( argname, fmt =
'(A)' )
'DESCX( CSRC_ )'
2013 ELSE IF( descx( ctxt_ ).NE.descxref( ctxt_ ) )
THEN
2014 WRITE( argname, fmt =
'(A)' )
'DESCX( CTXT_ )'
2015 ELSE IF( descx( lld_ ).NE.descxref( lld_ ) )
THEN
2016 WRITE( argname, fmt =
'(A)' )
'DESCX( LLD_ )'
2017 ELSE IF( incx.NE.incxref )
THEN
2018 WRITE( argname, fmt =
'(A)' )
'INCX'
2019 ELSE IF( iy.NE.iyref )
THEN
2020 WRITE( argname, fmt =
'(A)' )
'IY'
2021 ELSE IF( jy.NE.jyref )
THEN
2022 WRITE( argname, fmt =
'(A)' )
'JY'
2023 ELSE IF( descy( dtype_ ).NE.descyref( dtype_ ) )
THEN
2024 WRITE( argname, fmt =
'(A)' )
'DESCY( DTYPE_ )'
2025 ELSE IF( descy( m_ ).NE.descyref( m_ ) )
THEN
2026 WRITE( argname, fmt =
'(A)' )
'DESCY( M_ )'
2027 ELSE IF( descy( n_ ).NE.descyref( n_ ) )
THEN
2028 WRITE( argname, fmt =
'(A)' )
'DESCY( N_ )'
2029 ELSE IF( descy( imb_ ).NE.descyref( imb_ ) )
THEN
2030 WRITE( argname, fmt =
'(A)' )
'DESCY( IMB_ )'
2031 ELSE IF( descy( inb_ ).NE.descyref( inb_ ) )
THEN
2032 WRITE( argname, fmt =
'(A)' )
'DESCY( INB_ )'
2033 ELSE IF( descy( mb_ ).NE.descyref( mb_ ) )
THEN
2034 WRITE( argname, fmt =
'(A)' )
'DESCY( MB_ )'
2035 ELSE IF( descy( nb_ ).NE.descyref( nb_ ) )
THEN
2036 WRITE( argname, fmt =
'(A)' )
'DESCY( NB_ )'
2037 ELSE IF( descy( rsrc_ ).NE.descyref( rsrc_ ) )
THEN
2038 WRITE( argname, fmt =
'(A)' )
'DESCY( RSRC_ )'
2039 ELSE IF( descy( csrc_ ).NE.descyref( csrc_ ) )
THEN
2040 WRITE( argname, fmt =
'(A)' )
'DESCY( CSRC_ )'
2041 ELSE IF( descy( ctxt_ ).NE.descyref( ctxt_ ) )
THEN
2042 WRITE( argname, fmt =
'(A)' )
'DESCY( CTXT_ )'
2043 ELSE IF( descy( lld_ ).NE.descyref( lld_ ) )
THEN
2044 WRITE( argname, fmt =
'(A)' )
'DESCY( LLD_ )'
2045 ELSE IF( incy.NE.incyref )
THEN
2046 WRITE( argname, fmt =
'(A)' )
'INCY'
2047 ELSE IF( alpha.NE.alpharef )
THEN
2048 WRITE( argname, fmt =
'(A)' )
'ALPHA'
2053 CALL igsum2d( ictxt,
'All',
' ', 1, 1, info, 1, -1, 0 )
2055 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
2057 IF( info.GT.0 )
THEN
2058 WRITE( nout, fmt = 9999 ) argname, sname
2060 WRITE( nout, fmt = 9998 ) sname
2067 9999
FORMAT( 2x,
' ***** Input-only parameter check: ', a,
2068 $
' FAILED changed ', a,
' *****' )
2069 9998
FORMAT( 2x,
' ***** Input-only parameter check: ', a,
2085 INTEGER ictxt, incx, ix, jx, n
2196 INTEGER block_cyclic_2d_inb, csrc_, ctxt_, dlen_,
2197 $ dtype_, imb_, inb_, lld_, mb_, m_, nb_, n_,
2199 PARAMETER ( block_cyclic_2d_inb = 2, dlen_ = 11,
2200 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2201 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2202 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2205 LOGICAL colrep, rowrep
2206 INTEGER iix, ixcol, ixrow, jjx, mycol, myrow, npcol,
2214 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2216 CALL pb_infog2l( ix, jx, descx, nprow, npcol, myrow, mycol,
2217 $ iix, jjx, ixrow, ixcol )
2218 rowrep = ( ixrow.EQ.-1 )
2219 colrep = ( ixcol.EQ.-1 )
2221 IF( descx( m_ ).EQ.1 .AND. n.EQ.1 )
THEN
2226 pisinscope = ( ( ixrow.EQ.myrow .OR. rowrep ) .AND.
2227 $ ( ixcol.EQ.mycol .OR. colrep ) )
2231 IF( incx.EQ.descx( m_ ) )
THEN
2253 $ PISCLR, X, PX, IX, JX, DESCX, INCX, Y,
2254 $ PY, IY, JY, DESCY, INCY, INFO )
2262 INTEGER ICTXT, INCX, INCY, INFO, IX, IY, JX, JY, N,
2263 $ nout, nrout, pisclr
2268 INTEGER DESCX( * ), DESCY( * )
2269 COMPLEX PX( * ), PY( * ), X( * ), Y( * )
2449 PARAMETER ( ZERO = ( 0.0e+0, 0.0e+0 ),
2451 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2452 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2454 PARAMETER ( BLOCK_CYCLIC_2D_INB = 2, dlen_ = 11,
2455 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2456 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2457 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2460 LOGICAL COLREP, INXSCOPE, INYSCOPE, ROWREP
2461 INTEGER I, IB, ICURCOL, ICURROW, IDUMM, IIX, IIY, IN,
2462 $ ioffx, ioffy, isclr, ixcol, ixrow, iycol,
2463 $ iyrow, j, jb, jjx, jjy, jn, kk, ldx, ldy,
2464 $ mycol, myrow, npcol, nprow
2465 REAL ERR, ERRMAX, PREC, USCLR
2470 CHARACTER*5 ARGIN1, ARGIN2, ARGOUT1, ARGOUT2
2473 EXTERNAL blacs_gridinfo, ccopy, cswap, igamx2d,
2482 EXTERNAL ICAMAX, PISINSCOPE, PSLAMCH
2496 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2506 prec = pslamch( ictxt,
'precision' )
2508 IF( nrout.EQ.1 )
THEN
2512 ioffx = ix + ( jx - 1 ) * descx( m_ )
2513 ioffy = iy + ( jy - 1 ) * descy( m_ )
2514 CALL cswap( n, x( ioffx ), incx, y( ioffy ), incy )
2515 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
2517 CALL pcchkvin( errmax, n, y, py, iy, jy, descy, incy,
2520 ELSE IF( nrout.EQ.2 )
THEN
2525 ioffx = ix + ( jx - 1 ) * descx( m_ )
2526 CALL pb_infog2l( ix, jx, descx, nprow, npcol, myrow, mycol,
2527 $ iix, jjx, ixrow, ixcol )
2530 rowrep = ( ixrow.EQ.-1 )
2531 colrep = ( ixcol.EQ.-1 )
2533 IF( incx.EQ.descx( m_ ) )
THEN
2537 jb = descx( inb_ ) - jx + 1
2539 $ jb = ( (-jb ) / descx( nb_ ) + 1 ) * descx( nb_ ) + jb
2545 CALL pcerrscal( err, psclr, x( ioffx ), prec )
2547 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2548 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2549 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2555 ioffx = ioffx + incx
2559 icurcol = mod( icurcol+1, npcol )
2561 DO 40 j = jn+1, jx+n-1, descx( nb_ )
2562 jb =
min( jx+n-j, descx( nb_ ) )
2566 CALL pcerrscal( err, psclr, x( ioffx ), prec )
2568 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2569 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2570 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2576 ioffx = ioffx + incx
2580 icurcol = mod( icurcol+1, npcol )
2588 ib = descx( imb_ ) - ix + 1
2590 $ ib = ( (-ib ) / descx( mb_ ) + 1 ) * descx( mb_ ) + ib
2596 CALL pcerrscal( err, psclr, x( ioffx ), prec )
2598 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2599 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2600 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2606 ioffx = ioffx + incx
2610 icurrow = mod( icurrow+1, nprow )
2612 DO 70 i = in+1, ix+n-1, descx( mb_ )
2613 ib =
min( ix+n-i, descx( mb_ ) )
2617 CALL pcerrscal( err, psclr, x( ioffx ), prec )
2619 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2620 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2621 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2627 ioffx = ioffx + incx
2630 icurrow = mod( icurrow+1, nprow )
2636 ELSE IF( nrout.EQ.3 )
THEN
2641 ioffx = ix + ( jx - 1 ) * descx( m_ )
2642 CALL pb_infog2l( ix, jx, descx, nprow, npcol, myrow, mycol,
2643 $ iix, jjx, ixrow, ixcol )
2646 rowrep = ( ixrow.EQ.-1 )
2647 colrep = ( ixcol.EQ.-1 )
2649 IF( incx.EQ.descx( m_ ) )
THEN
2653 jb = descx( inb_ ) - jx + 1
2655 $ jb = ( (-jb ) / descx( nb_ ) + 1 ) * descx( nb_ ) + jb
2661 CALL pcserrscal( err, pusclr, x( ioffx ), prec )
2663 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2664 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2665 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2671 ioffx = ioffx + incx
2675 icurcol = mod( icurcol+1, npcol )
2677 DO 100 j = jn+1, jx+n-1, descx( nb_ )
2678 jb =
min( jx+n-j, descx( nb_ ) )
2682 CALL pcserrscal( err, pusclr, x( ioffx ), prec )
2684 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2685 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2686 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2692 ioffx = ioffx + incx
2696 icurcol = mod( icurcol+1, npcol )
2704 ib = descx( imb_ ) - ix + 1
2706 $ ib = ( (-ib ) / descx( mb_ ) + 1 ) * descx( mb_ ) + ib
2712 CALL pcserrscal( err, pusclr, x( ioffx ), prec )
2714 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2715 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2716 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2722 ioffx = ioffx + incx
2726 icurrow = mod( icurrow+1, nprow )
2728 DO 130 i = in+1, ix+n-1, descx( mb_ )
2729 ib =
min( ix+n-i, descx( mb_ ) )
2733 CALL pcserrscal( err, pusclr, x( ioffx ), prec )
2735 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2736 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2737 IF( abs( px( iix+(jjx-1)*ldx ) - x( ioffx ) ).GT.
2743 ioffx = ioffx + incx
2746 icurrow = mod( icurrow+1, nprow )
2752 ELSE IF( nrout.EQ.4 )
THEN
2756 ioffx = ix + ( jx - 1 ) * descx( m_ )
2757 ioffy = iy + ( jy - 1 ) * descy( m_ )
2758 CALL ccopy( n, x( ioffx ), incx, y( ioffy ), incy )
2759 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
2761 CALL pcchkvin( errmax, n, y, py, iy, jy, descy, incy,
2764 ELSE IF( nrout.EQ.5 )
THEN
2768 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
2771 ioffx = ix + ( jx - 1 ) * descx( m_ )
2772 ioffy = iy + ( jy - 1 ) * descy( m_ )
2773 CALL pb_infog2l( iy, jy, descy, nprow, npcol, myrow, mycol,
2774 $ iiy, jjy, iyrow, iycol )
2777 rowrep = ( iyrow.EQ.-1 )
2778 colrep = ( iycol.EQ.-1 )
2780 IF( incy.EQ.descy( m_ ) )
THEN
2784 jb = descy( inb_ ) - jy + 1
2786 $ jb = ( (-jb ) / descy( nb_ ) + 1 ) * descy( nb_ ) + jb
2792 CALL pcerraxpy( err, psclr, x( ioffx ), y( ioffy ),
2795 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2796 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2797 IF( abs( py( iiy+(jjy-1)*ldy ) - y( ioffy ) ).GT.
2804 ioffx = ioffx + incx
2805 ioffy = ioffy + incy
2809 icurcol = mod( icurcol+1, npcol )
2811 DO 160 j = jn+1, jy+n-1, descy( nb_ )
2812 jb =
min( jy+n-j, descy( nb_ ) )
2816 CALL pcerraxpy( err, psclr, x( ioffx ), y( ioffy ),
2819 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2820 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2821 IF( abs( py( iiy+(jjy-1)*ldy ) - y( ioffy ) ).GT.
2828 ioffx = ioffx + incx
2829 ioffy = ioffy + incy
2833 icurcol = mod( icurcol+1, npcol )
2841 ib = descy( imb_ ) - iy + 1
2843 $ ib = ( (-ib ) / descy( mb_ ) + 1 ) * descy( mb_ ) + ib
2849 CALL pcerraxpy( err, psclr, x( ioffx ), y( ioffy ),
2852 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2853 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2854 IF( abs( py( iiy+(jjy-1)*ldy ) - y( ioffy ) ).GT.
2861 ioffx = ioffx + incx
2862 ioffy = ioffy + incy
2866 icurrow = mod( icurrow+1, nprow )
2868 DO 190 i = in+1, iy+n-1, descy( mb_ )
2869 ib =
min( iy+n-i, descy( mb_ ) )
2873 CALL pcerraxpy( err, psclr, x( ioffx ), y( ioffy ),
2876 IF( ( myrow.EQ.icurrow .OR. rowrep ) .AND.
2877 $ ( mycol.EQ.icurcol .OR. colrep ) )
THEN
2878 IF( abs( py( iiy+(jjy-1)*ldy ) - y( ioffy ) ).GT.
2885 ioffx = ioffx + incx
2886 ioffy = ioffy + incy
2890 icurrow = mod( icurrow+1, nprow )
2896 ELSE IF( nrout.EQ.6 )
THEN
2900 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
2902 CALL pcchkvin( errmax, n, y, py, iy, jy, descy, incy,
2904 ioffx = ix + ( jx - 1 ) * descx( m_ )
2905 ioffy = iy + ( jy - 1 ) * descy( m_ )
2906 CALL pcerrdotu( err, n, sclr, x( ioffx ), incx, y( ioffy ),
2908 inxscope = pisinscope( ictxt, n, ix, jx, descx, incx )
2909 inyscope = pisinscope( ictxt, n, iy, jy, descy, incy )
2910 IF( inxscope.OR.inyscope )
THEN
2911 IF( abs( psclr - sclr ).GT.err )
THEN
2913 WRITE( argin1, fmt =
'(A)' )
'DOTU'
2914 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
2915 WRITE( nout, fmt = 9998 ) argin1
2916 WRITE( nout, fmt = 9996 ) sclr, psclr
2921 IF( psclr.NE.sclr )
THEN
2923 WRITE( argout1, fmt =
'(A)' )
'DOTU'
2924 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
2925 WRITE( nout, fmt = 9997 ) argout1
2926 WRITE( nout, fmt = 9996 ) sclr, psclr
2931 ELSE IF( nrout.EQ.7 )
THEN
2935 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
2937 CALL pcchkvin( errmax, n, y, py, iy, jy, descy, incy,
2939 ioffx = ix + ( jx - 1 ) * descx( m_ )
2940 ioffy = iy + ( jy - 1 ) * descy( m_ )
2941 CALL pcerrdotc( err, n, sclr, x( ioffx ), incx, y( ioffy ),
2943 inxscope = pisinscope( ictxt, n, ix, jx, descx, incx )
2944 inyscope = pisinscope( ictxt, n, iy, jy, descy, incy )
2945 IF( inxscope.OR.inyscope )
THEN
2946 IF( abs( psclr - sclr ).GT.err )
THEN
2948 WRITE( argin1, fmt =
'(A)' )
'DOTC'
2949 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
2950 WRITE( nout, fmt = 9998 ) argin1
2951 WRITE( nout, fmt = 9996 ) sclr, psclr
2956 IF( psclr.NE.sclr )
THEN
2958 WRITE( argout1, fmt =
'(A)' )
'DOTC'
2959 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
2960 WRITE( nout, fmt = 9997 ) argout1
2961 WRITE( nout, fmt = 9996 ) sclr, psclr
2966 ELSE IF( nrout.EQ.8 )
THEN
2970 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
2972 ioffx = ix + ( jx - 1 ) * descx( m_ )
2973 CALL pcerrnrm2( err, n, usclr, x( ioffx ), incx, prec )
2974 IF( pisinscope( ictxt, n, ix, jx, descx, incx ) )
THEN
2975 IF( abs( pusclr - usclr ).GT.err )
THEN
2977 WRITE( argin1, fmt =
'(A)' )
'NRM2'
2978 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
2979 WRITE( nout, fmt = 9998 ) argin1
2980 WRITE( nout, fmt = 9994 ) usclr, pusclr
2985 IF( pusclr.NE.usclr )
THEN
2987 WRITE( argout1, fmt =
'(A)' )
'NRM2'
2988 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
2989 WRITE( nout, fmt = 9997 ) argout1
2990 WRITE( nout, fmt = 9994 ) usclr, pusclr
2995 ELSE IF( nrout.EQ.9 )
THEN
2999 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
3001 ioffx = ix + ( jx - 1 ) * descx( m_ )
3002 CALL pcerrasum( err, n, usclr, x( ioffx ), incx, prec )
3003 IF( pisinscope( ictxt, n, ix, jx, descx, incx ) )
THEN
3004 IF( abs( pusclr - usclr ) .GT. err )
THEN
3006 WRITE( argin1, fmt =
'(A)' )
'ASUM'
3007 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
3008 WRITE( nout, fmt = 9998 ) argin1
3009 WRITE( nout, fmt = 9994 ) usclr, pusclr
3014 IF( pusclr.NE.usclr )
THEN
3016 WRITE( argout1, fmt =
'(A)' )
'ASUM'
3017 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
3018 WRITE( nout, fmt = 9997 ) argout1
3019 WRITE( nout, fmt = 9994 ) usclr, pusclr
3024 ELSE IF( nrout.EQ.10 )
THEN
3028 CALL pcchkvin( errmax, n, x, px, ix, jx, descx, incx,
3030 ioffx = ix + ( jx - 1 ) * descx( m_ )
3031 IF( pisinscope( ictxt, n, ix, jx, descx, incx ) )
THEN
3032 isclr = icamax( n, x( ioffx ), incx )
3035 ELSE IF( ( incx.EQ.1 ).AND.( descx( m_ ).EQ.1 ).AND.
3039 ELSE IF( incx.EQ.descx( m_ ) )
THEN
3040 isclr = jx + isclr - 1
3041 sclr = x( ix + ( isclr - 1 ) * descx( m_ ) )
3043 isclr = ix + isclr - 1
3044 sclr = x( isclr + ( jx - 1 ) * descx( m_ ) )
3047 IF( psclr.NE.sclr )
THEN
3049 WRITE( argin1, fmt =
'(A)' )
'AMAX'
3050 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
3051 WRITE( nout, fmt = 9998 ) argin1
3052 WRITE( nout, fmt = 9996 ) sclr, psclr
3056 IF( pisclr.NE.isclr )
THEN
3058 WRITE( argin2, fmt =
'(A)' )
'INDX'
3059 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
3060 WRITE( nout, fmt = 9998 ) argin2
3061 WRITE( nout, fmt = 9995 ) isclr, pisclr
3067 IF( psclr.NE.sclr )
THEN
3069 WRITE( argout1, fmt =
'(A)' )
'AMAX'
3070 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
3071 WRITE( nout, fmt = 9997 ) argout1
3072 WRITE( nout, fmt = 9996 ) sclr, psclr
3075 IF( pisclr.NE.isclr )
THEN
3077 WRITE( argout2, fmt =
'(A)' )
'INDX'
3078 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
THEN
3079 WRITE( nout, fmt = 9997 ) argout2
3080 WRITE( nout, fmt = 9995 ) isclr, pisclr
3089 CALL igamx2d( ictxt,
'All',
' ', 6, 1, ierr, 6, idumm, idumm, -1,
3094 IF( ierr( 1 ).NE.0 )
THEN
3096 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
3097 $
WRITE( nout, fmt = 9999 )
'X'
3100 IF( ierr( 2 ).NE.0 )
THEN
3102 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
3103 $
WRITE( nout, fmt = 9999 )
'Y'
3106 IF( ierr( 3 ).NE.0 )
3109 IF( ierr( 4 ).NE.0 )
3112 IF( ierr( 5 ).NE.0 )
3115 IF( ierr( 6 ).NE.0 )
3118 9999
FORMAT( 2x,
' ***** ERROR: Vector operand ', a,
3119 $
' is incorrect.' )
3120 9998
FORMAT( 2x,
' ***** ERROR: Output scalar result ', a,
3121 $
' in scope is incorrect.' )
3122 9997
FORMAT( 2x,
' ***** ERROR: Output scalar result ', a,
3123 $
' out of scope is incorrect.' )
3124 9996
FORMAT( 2x,
' ***** Expected value is: ', e16.8,
'+i*(',
3125 $ e16.8,
'),', /2x,
' Obtained value is: ',
3126 $ e16.8,
'+i*(', e16.8,
')' )
3127 9995
FORMAT( 2x,
' ***** Expected value is: ', i6, /2x,
3128 $
' Obtained value is: ', i6 )
3129 9994
FORMAT( 2x,
' ***** Expected value is: ', e16.8, /2x,
3130 $
' Obtained value is: ', e16.8 )
3137 SUBROUTINE pcerrdotu( ERRBND, N, SCLR, X, INCX, Y, INCY, PREC )
3145 INTEGER INCX, INCY, N
3150 COMPLEX X( * ), Y( * )
3213 PARAMETER ( ONE = 1.0e+0, two = 2.0e+0,
3218 REAL ADDBND, FACT, SUMINEG, SUMIPOS, SUMRNEG,
3222 INTRINSIC ABS, AIMAG, MAX, REAL
3233 fact = two * ( one + prec )
3234 addbnd = two * two * two * prec
3238 sclr = sclr + x( ix ) * y( iy )
3240 tmp = real( x( ix ) ) * real( y( iy ) )
3241 IF( tmp.GE.zero )
THEN
3242 sumrpos = sumrpos + tmp * fact
3244 sumrneg = sumrneg - tmp * fact
3247 tmp = - aimag( x( ix ) ) * aimag( y( iy ) )
3248 IF( tmp.GE.zero )
THEN
3249 sumrpos = sumrpos + tmp * fact
3251 sumrneg = sumrneg - tmp * fact
3254 tmp = aimag( x( ix ) ) * real( y( iy ) )
3255 IF( tmp.GE.zero )
THEN
3256 sumipos = sumipos + tmp * fact
3258 sumineg = sumineg - tmp * fact
3261 tmp = real( x( ix ) ) * aimag( y( iy ) )
3262 IF( tmp.GE.zero )
THEN
3263 sumipos = sumipos + tmp * fact
3265 sumineg = sumineg - tmp * fact
3273 errbnd = addbnd * max( max( sumrpos, sumrneg ),
3274 $ max( sumipos, sumineg ) )
3281 SUBROUTINE pcerrdotc( ERRBND, N, SCLR, X, INCX, Y, INCY, PREC )
3289 INTEGER INCX, INCY, N
3294 COMPLEX X( * ), Y( * )
3357 PARAMETER ( ONE = 1.0e+0, two = 2.0e+0,
3362 REAL ADDBND, FACT, SUMINEG, SUMIPOS, SUMRNEG,
3366 INTRINSIC ABS, AIMAG, CONJG, MAX, REAL
3377 fact = two * ( one + prec )
3378 addbnd = two * two * two * prec
3382 sclr = sclr + conjg( x( ix ) ) * y( iy )
3384 tmp = real( x( ix ) ) * real( y( iy ) )
3385 IF( tmp.GE.zero )
THEN
3386 sumrpos = sumrpos + tmp * fact
3388 sumrneg = sumrneg - tmp * fact
3391 tmp = aimag( x( ix ) ) * aimag( y( iy ) )
3392 IF( tmp.GE.zero )
THEN
3393 sumrpos = sumrpos + tmp * fact
3395 sumrneg = sumrneg - tmp * fact
3398 tmp = - aimag( x( ix ) ) * real( y( iy ) )
3399 IF( tmp.GE.zero )
THEN
3400 sumipos = sumipos + tmp * fact
3402 sumineg = sumineg - tmp * fact
3405 tmp = real( x( ix ) ) * aimag( y( iy ) )
3406 IF( tmp.GE.zero )
THEN
3407 sumipos = sumipos + tmp * fact
3409 sumineg = sumineg - tmp * fact
3417 errbnd = addbnd * max( max( sumrpos, sumrneg ),
3418 $ max( sumipos, sumineg ) )
3434 REAL ERRBND, PREC, USCLR
3490 PARAMETER ( ONE = 1.0e+0, two = 2.0e+0,
3495 REAL ABSXI, ADDBND, FACT, SCALE, SSQ, SUMSCA, SUMSSQ
3498 INTRINSIC ABS, AIMAG, REAL
3505 addbnd = two * two * two * prec
3506 fact = one + two * ( ( one + prec )**3 - one )
3510 DO 10 ix = 1, 1 + ( n - 1 )*incx, incx
3511 IF( real( x( ix ) ).NE.zero )
THEN
3512 absxi = abs( real( x( ix ) ) )
3513 IF( scale.LT.absxi )
THEN
3514 sumssq = one + ( ssq*( scale/absxi )**2 ) * fact
3515 errbnd = addbnd * sumssq
3516 sumssq = sumssq + errbnd
3517 ssq = one + ssq*( scale/absxi )**2
3521 sumssq = ssq + ( ( absxi/scale )**2 ) * fact
3522 errbnd = addbnd * sumssq
3523 sumssq = sumssq + errbnd
3524 ssq = ssq + ( absxi/scale )**2
3527 IF( aimag( x( ix ) ).NE.zero )
THEN
3528 absxi = abs( aimag( x( ix ) ) )
3529 IF( scale.LT.absxi )
THEN
3530 sumssq = one + ( ssq*( scale/absxi )**2 ) * fact
3531 errbnd = addbnd * sumssq
3532 sumssq = sumssq + errbnd
3533 ssq = one + ssq*( scale/absxi )**2
3537 sumssq = ssq + ( ( absxi/scale )**2 ) * fact
3538 errbnd = addbnd * sumssq
3539 sumssq = sumssq + errbnd
3540 ssq = ssq + ( absxi/scale )**2
3545 usclr = scale * sqrt( ssq )
3549 errbnd = sqrt( sumssq ) * ( one + two * ( 1.00001e+0 * prec ) )
3551 errbnd = ( sumsca * errbnd ) - usclr
3567 REAL ERRBND, PREC, USCLR
3614 PARAMETER ( TWO = 2.0e+0, zero = 0.0e+0 )
3621 INTRINSIC ABS, AIMAG, REAL
3627 addbnd = two * two * two * prec
3629 DO 10 ix = 1, 1 + ( n - 1 )*incx, incx
3630 usclr = usclr + abs( real( x( ix ) ) ) +
3631 $ abs( aimag( x( ix ) ) )
3634 errbnd = addbnd * usclr
3693 PARAMETER ( TWO = 2.0e+0 )
3702 errbnd = ( two * prec ) * abs( x )
3717 REAL ERRBND, PREC, PUSCLR
3761 PARAMETER ( TWO = 2.0e+0 )
3764 INTRINSIC abs, aimag,
cmplx, real
3768 x =
cmplx( pusclr * real( x ), pusclr * aimag( x ) )
3770 errbnd = ( two * prec ) * abs( x )
3822 PARAMETER ( ONE = 1.0e+0, two = 2.0e+0,
3826 REAL ADDBND, FACT, SUMINEG, SUMIPOS, SUMRNEG,
3831 INTRINSIC AIMAG, MAX, REAL
3839 fact = one + two * prec
3840 addbnd = two * two * two * prec
3843 IF( real( tmp ).GE.zero )
THEN
3844 sumrpos = sumrpos + real( tmp ) * fact
3846 sumrneg = sumrneg - real( tmp ) * fact
3848 IF( aimag( tmp ).GE.zero )
THEN
3849 sumipos = sumipos + aimag( tmp ) * fact
3851 sumineg = sumineg - aimag( tmp ) * fact
3855 IF( real( tmp ).GE.zero )
THEN
3856 sumrpos = sumrpos + real( tmp )
3858 sumrneg = sumrneg - real( tmp )
3860 IF( aimag( tmp ).GE.zero )
THEN
3861 sumipos = sumipos + aimag( tmp )
3863 sumineg = sumineg - aimag( tmp )
3866 y = y + ( psclr * x )
3868 errbnd = addbnd * max( max( sumrpos, sumrneg ),
3869 $ max( sumipos, sumineg ) )
subroutine pvdimchk(ictxt, nout, n, matrix, ix, jx, descx, incx, info)
subroutine icopy(n, sx, incx, sy, incy)
subroutine pb_descset2(desc, m, n, imb, inb, mb, nb, rsrc, csrc, ctxt, lld)
subroutine pb_infog2l(i, j, desc, nprow, npcol, myrow, mycol, ii, jj, prow, pcol)
subroutine pvdescchk(ictxt, nout, matrix, descx, dtx, mx, nx, imbx, inbx, mbx, nbx, rsrcx, csrcx, incx, mpx, nqx, iprex, imidx, ipostx, igap, gapmul, info)
subroutine pcerrnrm2(errbnd, n, usclr, x, incx, prec)
subroutine pcbla1tstinfo(summry, nout, nmat, nval, mxval, nxval, imbxval, mbxval, inbxval, nbxval, rscxval, cscxval, ixval, jxval, incxval, myval, nyval, imbyval, mbyval, inbyval, nbyval, rscyval, cscyval, iyval, jyval, incyval, ldval, ngrids, pval, ldpval, qval, ldqval, ltest, sof, tee, iam, igap, iverb, nprocs, alpha, work)
subroutine pcserrscal(errbnd, pusclr, x, prec)
subroutine pcerrdotu(errbnd, n, sclr, x, incx, y, incy, prec)
subroutine pcerrscal(errbnd, psclr, x, prec)
subroutine pcerrdotc(errbnd, n, sclr, x, incx, y, incy, prec)
subroutine pcblas1tstchke(ltest, inout, nprocs)
subroutine pcchkarg1(ictxt, nout, sname, n, alpha, ix, jx, descx, incx, iy, jy, descy, incy, info)
subroutine pcblas1tstchk(ictxt, nout, nrout, n, psclr, pusclr, pisclr, x, px, ix, jx, descx, incx, y, py, iy, jy, descy, incy, info)
logical function pisinscope(ictxt, n, ix, jx, descx, incx)
subroutine pcerraxpy(errbnd, psclr, x, y, prec)
subroutine pcerrasum(errbnd, n, usclr, x, incx, prec)
subroutine pclagen(inplace, aform, diag, offa, m, n, ia, ja, desca, iaseed, a, lda)
subroutine pcchkvout(n, x, px, ix, jx, descx, incx, info)
subroutine pcchkvin(errmax, n, x, px, ix, jx, descx, incx, info)
subroutine pb_cchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
subroutine pcvecee(ictxt, nout, subptr, scode, sname)
subroutine pb_pclaprnt(m, n, a, ia, ja, desca, irprnt, icprnt, cmatnm, nout, work)
subroutine pcmprnt(ictxt, nout, m, n, a, lda, irprnt, icprnt, cmatnm)
subroutine pcdimee(ictxt, nout, subptr, scode, sname)
subroutine pb_cfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
subroutine pcvprnt(ictxt, nout, n, x, incx, irprnt, icprnt, cvecnm)
real function pslamch(ictxt, cmach)