543 $ IMBXVAL, MBXVAL, INBXVAL, NBXVAL,
544 $ RSCXVAL, CSCXVAL, IXVAL, JXVAL,
545 $ INCXVAL, MYVAL, NYVAL, IMBYVAL, MBYVAL,
546 $ INBYVAL, NBYVAL, RSCYVAL, CSCYVAL,
547 $ IYVAL, JYVAL, INCYVAL, LDVAL, NGRIDS,
548 $ PVAL, LDPVAL, QVAL, LDQVAL, LTEST, IAM,
549 $ NPROCS, ALPHA, WORK )
557 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NGRIDS, NMAT, NOUT,
559 DOUBLE PRECISION ALPHA
562 CHARACTER*( * ) SUMMRY
564 INTEGER CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
565 $ IMBXVAL( LDVAL ), IMBYVAL( LDVAL ),
566 $ inbxval( ldval ), inbyval( ldval ),
567 $ incxval( ldval ), incyval( ldval ),
568 $ ixval( ldval ), iyval( ldval ), jxval( ldval ),
569 $ jyval( ldval ), mbxval( ldval ),
570 $ mbyval( ldval ), mxval( ldval ),
571 $ myval( ldval ), nbxval( ldval ),
572 $ nbyval( ldval ), nval( ldval ), nxval( ldval ),
573 $ nyval( ldval ), pval( ldpval ), qval( ldqval ),
574 $ rscxval( ldval ), rscyval( ldval ), work( * )
768 PARAMETER ( NIN = 11, nsubs = 8 )
779 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
780 $ blacs_gridinit, blacs_setup, dgebr2d, dgebs2d,
781 $
icopy, igebr2d, igebs2d, sgebr2d, sgebs2d
787 CHARACTER*7 SNAMES( NSUBS )
788 COMMON /SNAMEC/SNAMES
800 OPEN( nin, file=
'PDBLAS1TIM.dat', status=
'OLD' )
801 READ( nin, fmt = * ) summry
806 READ( nin, fmt = 9999 ) usrinfo
810 READ( nin, fmt = * ) summry
811 READ( nin, fmt = * ) nout
812 IF( nout.NE.0 .AND. nout.NE.6 )
813 $
OPEN( nout, file = summry, status =
'UNKNOWN' )
819 READ( nin, fmt = * ) ngrids
820 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval )
THEN
821 WRITE( nout, fmt = 9998 )
'Grids', ldpval
823 ELSE IF( ngrids.GT.ldqval )
THEN
824 WRITE( nout, fmt = 9998 )
'Grids', ldqval
830 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
831 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
835 READ( nin, fmt = * ) alpha
839 READ( nin, fmt = * ) nmat
840 IF( nmat.LT.1 .OR. nmat.GT.ldval )
THEN
841 WRITE( nout, fmt = 9998 )
'Tests', ldval
847 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
848 READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
849 READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
850 READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
851 READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
852 READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
853 READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
854 READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
855 READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
856 READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
857 READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
858 READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
859 READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
860 READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
861 READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
862 READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
863 READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
864 READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
865 READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
866 READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
867 READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
868 READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
869 READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
878 READ( nin, fmt = 9996,
END = 50 ) SNAMET, ltestt
880 IF( snamet.EQ.snames( i ) )
884 WRITE( nout, fmt = 9995 )snamet
900 IF( nprocs.LT.1 )
THEN
903 nprocs =
max( nprocs, pval( i )*qval( i ) )
905 CALL blacs_setup( iam, nprocs )
911 CALL blacs_get( -1, 0, ictxt )
912 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
916 CALL dgebs2d( ictxt,
'All',
' ', 1, 1, alpha, 1 )
920 CALL igebs2d( ictxt,
'All',
' ', 2, 1, work, 2 )
923 CALL icopy( ngrids, pval, 1, work( i ), 1 )
925 CALL icopy( ngrids, qval, 1, work( i ), 1 )
927 CALL icopy( nmat, nval, 1, work( i ), 1 )
929 CALL icopy( nmat, mxval, 1, work( i ), 1 )
931 CALL icopy( nmat, nxval, 1, work( i ), 1 )
933 CALL icopy( nmat, imbxval, 1, work( i ), 1 )
935 CALL icopy( nmat, inbxval, 1, work( i ), 1 )
937 CALL icopy( nmat, mbxval, 1, work( i ), 1 )
939 CALL icopy( nmat, nbxval, 1, work( i ), 1 )
941 CALL icopy( nmat, rscxval, 1, work( i ), 1 )
943 CALL icopy( nmat, cscxval, 1, work( i ), 1 )
945 CALL icopy( nmat, ixval, 1, work( i ), 1 )
947 CALL icopy( nmat, jxval, 1, work( i ), 1 )
949 CALL icopy( nmat, incxval, 1, work( i ), 1 )
951 CALL icopy( nmat, myval, 1, work( i ), 1 )
953 CALL icopy( nmat, nyval, 1, work( i ), 1 )
955 CALL icopy( nmat, imbyval, 1, work( i ), 1 )
957 CALL icopy( nmat, inbyval, 1, work( i ), 1 )
959 CALL icopy( nmat, mbyval, 1, work( i ), 1 )
961 CALL icopy( nmat, nbyval, 1, work( i ), 1 )
963 CALL icopy( nmat, rscyval, 1, work( i ), 1 )
965 CALL icopy( nmat, cscyval, 1, work( i ), 1 )
967 CALL icopy( nmat, iyval, 1, work( i ), 1 )
969 CALL icopy( nmat, jyval, 1, work( i ), 1 )
971 CALL icopy( nmat, incyval, 1, work( i ), 1 )
975 IF( ltest( j ) )
THEN
983 CALL igebs2d( ictxt,
'All',
' ', i, 1, work, i )
987 WRITE( nout, fmt = 9999 )
988 $
'Level 1 PBLAS timing program.'
989 WRITE( nout, fmt = 9999 ) usrinfo
990 WRITE( nout, fmt = * )
991 WRITE( nout, fmt = 9999 )
992 $
'Timing of the real double precision '//
994 WRITE( nout, fmt = * )
995 WRITE( nout, fmt = 9999 )
996 $
'The following parameter values will be used:'
997 WRITE( nout, fmt = * )
998 WRITE( nout, fmt = 9993 ) nmat
999 WRITE( nout, fmt = 9992 ) ngrids
1000 WRITE( nout, fmt = 9990 )
1001 $
'P', ( pval(i), i = 1,
min(ngrids, 5) )
1003 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 6,
1004 $
min( 10, ngrids ) )
1006 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 11,
1007 $
min( 15, ngrids ) )
1009 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 16, ngrids )
1010 WRITE( nout, fmt = 9990 )
1011 $
'Q', ( qval(i), i = 1,
min(ngrids, 5) )
1013 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 6,
1014 $
min( 10, ngrids ) )
1016 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 11,
1017 $
min( 15, ngrids ) )
1019 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 16, ngrids )
1020 WRITE( nout, fmt = 9994 ) alpha
1021 IF( ltest( 1 ) )
THEN
1022 WRITE( nout, fmt = 9989 ) snames( 1 ),
' ... Yes'
1024 WRITE( nout, fmt = 9989 ) snames( 1 ),
' ... No '
1027 IF( ltest( i ) )
THEN
1028 WRITE( nout, fmt = 9988 ) snames( i ),
' ... Yes'
1030 WRITE( nout, fmt = 9988 ) snames( i ),
' ... No '
1033 WRITE( nout, fmt = * )
1040 $
CALL blacs_setup( iam, nprocs )
1045 CALL blacs_get( -1, 0, ictxt )
1046 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
1048 CALL dgebr2d( ictxt,
'All',
' ', 1, 1, alpha, 1, 0, 0 )
1050 CALL igebr2d( ictxt,
'All',
' ', 2, 1, work, 2, 0, 0 )
1054 i = 2*ngrids + 23*nmat + nsubs
1055 CALL igebr2d( ictxt,
'All',
' ', i, 1, work, i, 0, 0 )
1058 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1060 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1062 CALL icopy( nmat, work( i ), 1, nval, 1 )
1064 CALL icopy( nmat, work( i ), 1, mxval, 1 )
1066 CALL icopy( nmat, work( i ), 1, nxval, 1 )
1068 CALL icopy( nmat, work( i ), 1, imbxval, 1 )
1070 CALL icopy( nmat, work( i ), 1, inbxval, 1 )
1072 CALL icopy( nmat, work( i ), 1, mbxval, 1 )
1074 CALL icopy( nmat, work( i ), 1, nbxval, 1 )
1076 CALL icopy( nmat, work( i ), 1, rscxval, 1 )
1078 CALL icopy( nmat, work( i ), 1, cscxval, 1 )
1080 CALL icopy( nmat, work( i ), 1, ixval, 1 )
1082 CALL icopy( nmat, work( i ), 1, jxval, 1 )
1084 CALL icopy( nmat, work( i ), 1, incxval, 1 )
1086 CALL icopy( nmat, work( i ), 1, myval, 1 )
1088 CALL icopy( nmat, work( i ), 1, nyval, 1 )
1090 CALL icopy( nmat, work( i ), 1, imbyval, 1 )
1092 CALL icopy( nmat, work( i ), 1, inbyval, 1 )
1094 CALL icopy( nmat, work( i ), 1, mbyval, 1 )
1096 CALL icopy( nmat, work( i ), 1, nbyval, 1 )
1098 CALL icopy( nmat, work( i ), 1, rscyval, 1 )
1100 CALL icopy( nmat, work( i ), 1, cscyval, 1 )
1102 CALL icopy( nmat, work( i ), 1, iyval, 1 )
1104 CALL icopy( nmat, work( i ), 1, jyval, 1 )
1106 CALL icopy( nmat, work( i ), 1, incyval, 1 )
1110 IF( work( i ).EQ.1 )
THEN
1113 ltest( j ) = .false.
1120 CALL blacs_gridexit( ictxt )
1124 100
WRITE( nout, fmt = 9997 )
1126 IF( nout.NE.6 .AND. nout.NE.0 )
1128 CALL blacs_abort( ictxt, 1 )
1133 9998
FORMAT(
' Number of values of ',5a,
' is less than 1 or greater ',
1135 9997
FORMAT(
' Illegal input in file ',40a,
'. Aborting run.' )
1136 9996
FORMAT( a7, l2 )
1137 9995
FORMAT(
' Subprogram name ', a7,
' not recognized',
1138 $ /
' ******* TESTS ABANDONED *******' )
1139 9994
FORMAT( 2x,
'Alpha : ', g16.6 )
1140 9993
FORMAT( 2x,
'Number of Tests : ', i6 )
1141 9992
FORMAT( 2x,
'Number of process grids : ', i6 )
1142 9991
FORMAT( 2x,
' : ', 5i6 )
1143 9990
FORMAT( 2x, a1,
' : ', 5i6 )
1144 9989
FORMAT( 2x,
'Routines to be tested : ', a, a8 )
1145 9988
FORMAT( 2x,
' ', a, a8 )