544 $ IMBXVAL, MBXVAL, INBXVAL, NBXVAL,
545 $ RSCXVAL, CSCXVAL, IXVAL, JXVAL,
546 $ INCXVAL, MYVAL, NYVAL, IMBYVAL, MBYVAL,
547 $ INBYVAL, NBYVAL, RSCYVAL, CSCYVAL,
548 $ IYVAL, JYVAL, INCYVAL, LDVAL, NGRIDS,
549 $ PVAL, LDPVAL, QVAL, LDQVAL, LTEST, IAM,
550 $ NPROCS, ALPHA, WORK )
558 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NGRIDS, NMAT, NOUT,
563 CHARACTER*( * ) SUMMRY
565 INTEGER CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
566 $ IMBXVAL( LDVAL ), IMBYVAL( LDVAL ),
567 $ inbxval( ldval ), inbyval( ldval ),
568 $ incxval( ldval ), incyval( ldval ),
569 $ ixval( ldval ), iyval( ldval ), jxval( ldval ),
570 $ jyval( ldval ), mbxval( ldval ),
571 $ mbyval( ldval ), mxval( ldval ),
572 $ myval( ldval ), nbxval( ldval ),
573 $ nbyval( ldval ), nval( ldval ), nxval( ldval ),
574 $ nyval( ldval ), pval( ldpval ), qval( ldqval ),
575 $ rscxval( ldval ), rscyval( ldval ), work( * )
769 PARAMETER ( NIN = 11, nsubs = 8 )
780 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
781 $ blacs_gridinit, blacs_setup,
icopy, igebr2d,
782 $ igebs2d, sgebr2d, sgebs2d
788 CHARACTER*7 SNAMES( NSUBS )
789 COMMON /SNAMEC/SNAMES
801 OPEN( nin, file=
'PSBLAS1TIM.dat', status=
'OLD' )
802 READ( nin, fmt = * ) summry
807 READ( nin, fmt = 9999 ) usrinfo
811 READ( nin, fmt = * ) summry
812 READ( nin, fmt = * ) nout
813 IF( nout.NE.0 .AND. nout.NE.6 )
814 $
OPEN( nout, file = summry, status =
'UNKNOWN' )
820 READ( nin, fmt = * ) ngrids
821 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval )
THEN
822 WRITE( nout, fmt = 9998 )
'Grids', ldpval
824 ELSE IF( ngrids.GT.ldqval )
THEN
825 WRITE( nout, fmt = 9998 )
'Grids', ldqval
831 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
832 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
836 READ( nin, fmt = * ) alpha
840 READ( nin, fmt = * ) nmat
841 IF( nmat.LT.1 .OR. nmat.GT.ldval )
THEN
842 WRITE( nout, fmt = 9998 )
'Tests', ldval
848 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
849 READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
850 READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
851 READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
852 READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
853 READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
854 READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
855 READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
856 READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
857 READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
858 READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
859 READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
860 READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
861 READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
862 READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
863 READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
864 READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
865 READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
866 READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
867 READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
868 READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
869 READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
870 READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
879 READ( nin, fmt = 9996,
END = 50 ) SNAMET, ltestt
881 IF( snamet.EQ.snames( i ) )
885 WRITE( nout, fmt = 9995 )snamet
901 IF( nprocs.LT.1 )
THEN
904 nprocs =
max( nprocs, pval( i )*qval( i ) )
906 CALL blacs_setup( iam, nprocs )
912 CALL blacs_get( -1, 0, ictxt )
913 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
917 CALL sgebs2d( ictxt,
'All',
' ', 1, 1, alpha, 1 )
921 CALL igebs2d( ictxt,
'All',
' ', 2, 1, work, 2 )
924 CALL icopy( ngrids, pval, 1, work( i ), 1 )
926 CALL icopy( ngrids, qval, 1, work( i ), 1 )
928 CALL icopy( nmat, nval, 1, work( i ), 1 )
930 CALL icopy( nmat, mxval, 1, work( i ), 1 )
932 CALL icopy( nmat, nxval, 1, work( i ), 1 )
934 CALL icopy( nmat, imbxval, 1, work( i ), 1 )
936 CALL icopy( nmat, inbxval, 1, work( i ), 1 )
938 CALL icopy( nmat, mbxval, 1, work( i ), 1 )
940 CALL icopy( nmat, nbxval, 1, work( i ), 1 )
942 CALL icopy( nmat, rscxval, 1, work( i ), 1 )
944 CALL icopy( nmat, cscxval, 1, work( i ), 1 )
946 CALL icopy( nmat, ixval, 1, work( i ), 1 )
948 CALL icopy( nmat, jxval, 1, work( i ), 1 )
950 CALL icopy( nmat, incxval, 1, work( i ), 1 )
952 CALL icopy( nmat, myval, 1, work( i ), 1 )
954 CALL icopy( nmat, nyval, 1, work( i ), 1 )
956 CALL icopy( nmat, imbyval, 1, work( i ), 1 )
958 CALL icopy( nmat, inbyval, 1, work( i ), 1 )
960 CALL icopy( nmat, mbyval, 1, work( i ), 1 )
962 CALL icopy( nmat, nbyval, 1, work( i ), 1 )
964 CALL icopy( nmat, rscyval, 1, work( i ), 1 )
966 CALL icopy( nmat, cscyval, 1, work( i ), 1 )
968 CALL icopy( nmat, iyval, 1, work( i ), 1 )
970 CALL icopy( nmat, jyval, 1, work( i ), 1 )
972 CALL icopy( nmat, incyval, 1, work( i ), 1 )
976 IF( ltest( j ) )
THEN
984 CALL igebs2d( ictxt,
'All',
' ', i, 1, work, i )
988 WRITE( nout, fmt = 9999 )
989 $
'Level 1 PBLAS timing program.'
990 WRITE( nout, fmt = 9999 ) usrinfo
991 WRITE( nout, fmt = * )
992 WRITE( nout, fmt = 9999 )
993 $
'Timing of the real single precision '//
995 WRITE( nout, fmt = * )
996 WRITE( nout, fmt = 9999 )
997 $
'The following parameter values will be used:'
998 WRITE( nout, fmt = * )
999 WRITE( nout, fmt = 9993 ) nmat
1000 WRITE( nout, fmt = 9992 ) ngrids
1001 WRITE( nout, fmt = 9990 )
1002 $
'P', ( pval(i), i = 1,
min(ngrids, 5) )
1004 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 6,
1005 $
min( 10, ngrids ) )
1007 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 11,
1008 $
min( 15, ngrids ) )
1010 $
WRITE( nout, fmt = 9991 ) ( pval(i), i = 16, ngrids )
1011 WRITE( nout, fmt = 9990 )
1012 $
'Q', ( qval(i), i = 1,
min(ngrids, 5) )
1014 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 6,
1015 $
min( 10, ngrids ) )
1017 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 11,
1018 $
min( 15, ngrids ) )
1020 $
WRITE( nout, fmt = 9991 ) ( qval(i), i = 16, ngrids )
1021 WRITE( nout, fmt = 9994 ) alpha
1022 IF( ltest( 1 ) )
THEN
1023 WRITE( nout, fmt = 9989 ) snames( 1 ),
' ... Yes'
1025 WRITE( nout, fmt = 9989 ) snames( 1 ),
' ... No '
1028 IF( ltest( i ) )
THEN
1029 WRITE( nout, fmt = 9988 ) snames( i ),
' ... Yes'
1031 WRITE( nout, fmt = 9988 ) snames( i ),
' ... No '
1034 WRITE( nout, fmt = * )
1041 $
CALL blacs_setup( iam, nprocs )
1046 CALL blacs_get( -1, 0, ictxt )
1047 CALL blacs_gridinit( ictxt,
'Row-major', 1, nprocs )
1049 CALL sgebr2d( ictxt,
'All',
' ', 1, 1, alpha, 1, 0, 0 )
1051 CALL igebr2d( ictxt,
'All',
' ', 2, 1, work, 2, 0, 0 )
1055 i = 2*ngrids + 23*nmat + nsubs
1056 CALL igebr2d( ictxt,
'All',
' ', i, 1, work, i, 0, 0 )
1059 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1061 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1063 CALL icopy( nmat, work( i ), 1, nval, 1 )
1065 CALL icopy( nmat, work( i ), 1, mxval, 1 )
1067 CALL icopy( nmat, work( i ), 1, nxval, 1 )
1069 CALL icopy( nmat, work( i ), 1, imbxval, 1 )
1071 CALL icopy( nmat, work( i ), 1, inbxval, 1 )
1073 CALL icopy( nmat, work( i ), 1, mbxval, 1 )
1075 CALL icopy( nmat, work( i ), 1, nbxval, 1 )
1077 CALL icopy( nmat, work( i ), 1, rscxval, 1 )
1079 CALL icopy( nmat, work( i ), 1, cscxval, 1 )
1081 CALL icopy( nmat, work( i ), 1, ixval, 1 )
1083 CALL icopy( nmat, work( i ), 1, jxval, 1 )
1085 CALL icopy( nmat, work( i ), 1, incxval, 1 )
1087 CALL icopy( nmat, work( i ), 1, myval, 1 )
1089 CALL icopy( nmat, work( i ), 1, nyval, 1 )
1091 CALL icopy( nmat, work( i ), 1, imbyval, 1 )
1093 CALL icopy( nmat, work( i ), 1, inbyval, 1 )
1095 CALL icopy( nmat, work( i ), 1, mbyval, 1 )
1097 CALL icopy( nmat, work( i ), 1, nbyval, 1 )
1099 CALL icopy( nmat, work( i ), 1, rscyval, 1 )
1101 CALL icopy( nmat, work( i ), 1, cscyval, 1 )
1103 CALL icopy( nmat, work( i ), 1, iyval, 1 )
1105 CALL icopy( nmat, work( i ), 1, jyval, 1 )
1107 CALL icopy( nmat, work( i ), 1, incyval, 1 )
1111 IF( work( i ).EQ.1 )
THEN
1114 ltest( j ) = .false.
1121 CALL blacs_gridexit( ictxt )
1125 100
WRITE( nout, fmt = 9997 )
1127 IF( nout.NE.6 .AND. nout.NE.0 )
1129 CALL blacs_abort( ictxt, 1 )
1134 9998
FORMAT(
' Number of values of ',5a,
' is less than 1 or greater ',
1136 9997
FORMAT(
' Illegal input in file ',40a,
'. Aborting run.' )
1137 9996
FORMAT( a7, l2 )
1138 9995
FORMAT(
' Subprogram name ', a7,
' not recognized',
1139 $ /
' ******* TESTS ABANDONED *******' )
1140 9994
FORMAT( 2x,
'Alpha : ', g16.6 )
1141 9993
FORMAT( 2x,
'Number of Tests : ', i6 )
1142 9992
FORMAT( 2x,
'Number of process grids : ', i6 )
1143 9991
FORMAT( 2x,
' : ', 5i6 )
1144 9990
FORMAT( 2x, a1,
' : ', 5i6 )
1145 9989
FORMAT( 2x,
'Routines to be tested : ', a, a8 )
1146 9988
FORMAT( 2x,
' ', a, a8 )