OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
psblas3tim.f File Reference

Go to the source code of this file.

Functions/Subroutines

program psbla3tim
subroutine psbla3timinfo (summry, nout, nmat, diagval, sideval, trnaval, trnbval, uploval, mval, nval, kval, maval, naval, imbaval, mbaval, inbaval, nbaval, rscaval, cscaval, iaval, javal, mbval, nbval, imbbval, mbbval, inbbval, nbbval, rscbval, cscbval, ibval, jbval, mcval, ncval, imbcval, mbcval, inbcval, nbcval, rsccval, csccval, icval, jcval, ldval, ngrids, pval, ldpval, qval, ldqval, nblog, ltest, iam, nprocs, alpha, beta, work)

Function/Subroutine Documentation

◆ psbla3tim()

program psbla3tim

Definition at line 11 of file psblas3tim.f.

◆ psbla3timinfo()

subroutine psbla3timinfo ( character*( * ) summry,
integer nout,
integer nmat,
character*1, dimension( ldval ) diagval,
character*1, dimension( ldval ) sideval,
character*1, dimension( ldval ) trnaval,
character*1, dimension( ldval ) trnbval,
character*1, dimension( ldval ) uploval,
integer, dimension( ldval ) mval,
integer, dimension( ldval ) nval,
integer, dimension( ldval ) kval,
integer, dimension( ldval ) maval,
integer, dimension( ldval ) naval,
integer, dimension( ldval ) imbaval,
integer, dimension( ldval ) mbaval,
integer, dimension( ldval ) inbaval,
integer, dimension( ldval ) nbaval,
integer, dimension( ldval ) rscaval,
integer, dimension( ldval ) cscaval,
integer, dimension( ldval ) iaval,
integer, dimension( ldval ) javal,
integer, dimension( ldval ) mbval,
integer, dimension( ldval ) nbval,
integer, dimension( ldval ) imbbval,
integer, dimension( ldval ) mbbval,
integer, dimension( ldval ) inbbval,
integer, dimension( ldval ) nbbval,
integer, dimension( ldval ) rscbval,
integer, dimension( ldval ) cscbval,
integer, dimension( ldval ) ibval,
integer, dimension( ldval ) jbval,
integer, dimension( ldval ) mcval,
integer, dimension( ldval ) ncval,
integer, dimension( ldval ) imbcval,
integer, dimension( ldval ) mbcval,
integer, dimension( ldval ) inbcval,
integer, dimension( ldval ) nbcval,
integer, dimension( ldval ) rsccval,
integer, dimension( ldval ) csccval,
integer, dimension( ldval ) icval,
integer, dimension( ldval ) jcval,
integer ldval,
integer ngrids,
integer, dimension( ldpval ) pval,
integer ldpval,
integer, dimension( ldqval ) qval,
integer ldqval,
integer nblog,
logical, dimension( * ) ltest,
integer iam,
integer nprocs,
real alpha,
real beta,
integer, dimension( * ) work )

Definition at line 866 of file psblas3tim.f.

878*
879* -- PBLAS test routine (version 2.0) --
880* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
881* and University of California, Berkeley.
882* April 1, 1998
883*
884* .. Scalar Arguments ..
885 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NBLOG, NGRIDS,
886 $ NMAT, NOUT, NPROCS
887 REAL ALPHA, BETA
888* ..
889* .. Array Arguments ..
890 CHARACTER*( * ) SUMMRY
891 CHARACTER*1 DIAGVAL( LDVAL ), SIDEVAL( LDVAL ),
892 $ TRNAVAL( LDVAL ), TRNBVAL( LDVAL ),
893 $ UPLOVAL( LDVAL )
894 LOGICAL LTEST( * )
895 INTEGER CSCAVAL( LDVAL ), CSCBVAL( LDVAL ),
896 $ CSCCVAL( LDVAL ), IAVAL( LDVAL ),
897 $ IBVAL( LDVAL ), ICVAL( LDVAL ),
898 $ IMBAVAL( LDVAL ), IMBBVAL( LDVAL ),
899 $ IMBCVAL( LDVAL ), INBAVAL( LDVAL ),
900 $ INBBVAL( LDVAL ), INBCVAL( LDVAL ),
901 $ JAVAL( LDVAL ), JBVAL( LDVAL ), JCVAL( LDVAL ),
902 $ KVAL( LDVAL ), MAVAL( LDVAL ), MBAVAL( LDVAL ),
903 $ MBBVAL( LDVAL ), MBCVAL( LDVAL ),
904 $ MBVAL( LDVAL ), MCVAL( LDVAL ), MVAL( LDVAL ),
905 $ NAVAL( LDVAL ), NBAVAL( LDVAL ),
906 $ NBBVAL( LDVAL ), NBCVAL( LDVAL ),
907 $ NBVAL( LDVAL ), NCVAL( LDVAL ), NVAL( LDVAL ),
908 $ PVAL( LDPVAL ), QVAL( LDQVAL ),
909 $ RSCAVAL( LDVAL ), RSCBVAL( LDVAL ),
910 $ RSCCVAL( LDVAL ), WORK( * )
911* ..
912*
913* Purpose
914* =======
915*
916* PSBLA3TIMINFO get the needed startup information for timing various
917* Level 3 PBLAS routines, and transmits it to all processes.
918*
919* Notes
920* =====
921*
922* For packing the information we assumed that the length in bytes of an
923* integer is equal to the length in bytes of a real single precision.
924*
925* Arguments
926* =========
927*
928* SUMMRY (global output) CHARACTER*(*)
929* On exit, SUMMRY is the name of output (summary) file (if
930* any). SUMMRY is only defined for process 0.
931*
932* NOUT (global output) INTEGER
933* On exit, NOUT specifies the unit number for the output file.
934* When NOUT is 6, output to screen, when NOUT is 0, output to
935* stderr. NOUT is only defined for process 0.
936*
937* NMAT (global output) INTEGER
938* On exit, NMAT specifies the number of different test cases.
939*
940* DIAGVAL (global output) CHARACTER array
941* On entry, DIAGVAL is an array of dimension LDVAL. On exit,
942* this array contains the values of DIAG to run the code with.
943*
944* SIDEVAL (global output) CHARACTER array
945* On entry, SIDEVAL is an array of dimension LDVAL. On exit,
946* this array contains the values of SIDE to run the code with.
947*
948* TRNAVAL (global output) CHARACTER array
949* On entry, TRNAVAL is an array of dimension LDVAL. On exit,
950* this array contains the values of TRANSA to run the code
951* with.
952*
953* TRNBVAL (global output) CHARACTER array
954* On entry, TRNBVAL is an array of dimension LDVAL. On exit,
955* this array contains the values of TRANSB to run the code
956* with.
957*
958* UPLOVAL (global output) CHARACTER array
959* On entry, UPLOVAL is an array of dimension LDVAL. On exit,
960* this array contains the values of UPLO to run the code with.
961*
962* MVAL (global output) INTEGER array
963* On entry, MVAL is an array of dimension LDVAL. On exit, this
964* array contains the values of M to run the code with.
965*
966* NVAL (global output) INTEGER array
967* On entry, NVAL is an array of dimension LDVAL. On exit, this
968* array contains the values of N to run the code with.
969*
970* KVAL (global output) INTEGER array
971* On entry, KVAL is an array of dimension LDVAL. On exit, this
972* array contains the values of K to run the code with.
973*
974* MAVAL (global output) INTEGER array
975* On entry, MAVAL is an array of dimension LDVAL. On exit, this
976* array contains the values of DESCA( M_ ) to run the code
977* with.
978*
979* NAVAL (global output) INTEGER array
980* On entry, NAVAL is an array of dimension LDVAL. On exit, this
981* array contains the values of DESCA( N_ ) to run the code
982* with.
983*
984* IMBAVAL (global output) INTEGER array
985* On entry, IMBAVAL is an array of dimension LDVAL. On exit,
986* this array contains the values of DESCA( IMB_ ) to run the
987* code with.
988*
989* MBAVAL (global output) INTEGER array
990* On entry, MBAVAL is an array of dimension LDVAL. On exit,
991* this array contains the values of DESCA( MB_ ) to run the
992* code with.
993*
994* INBAVAL (global output) INTEGER array
995* On entry, INBAVAL is an array of dimension LDVAL. On exit,
996* this array contains the values of DESCA( INB_ ) to run the
997* code with.
998*
999* NBAVAL (global output) INTEGER array
1000* On entry, NBAVAL is an array of dimension LDVAL. On exit,
1001* this array contains the values of DESCA( NB_ ) to run the
1002* code with.
1003*
1004* RSCAVAL (global output) INTEGER array
1005* On entry, RSCAVAL is an array of dimension LDVAL. On exit,
1006* this array contains the values of DESCA( RSRC_ ) to run the
1007* code with.
1008*
1009* CSCAVAL (global output) INTEGER array
1010* On entry, CSCAVAL is an array of dimension LDVAL. On exit,
1011* this array contains the values of DESCA( CSRC_ ) to run the
1012* code with.
1013*
1014* IAVAL (global output) INTEGER array
1015* On entry, IAVAL is an array of dimension LDVAL. On exit, this
1016* array contains the values of IA to run the code with.
1017*
1018* JAVAL (global output) INTEGER array
1019* On entry, JAVAL is an array of dimension LDVAL. On exit, this
1020* array contains the values of JA to run the code with.
1021*
1022* MBVAL (global output) INTEGER array
1023* On entry, MBVAL is an array of dimension LDVAL. On exit, this
1024* array contains the values of DESCB( M_ ) to run the code
1025* with.
1026*
1027* NBVAL (global output) INTEGER array
1028* On entry, NBVAL is an array of dimension LDVAL. On exit, this
1029* array contains the values of DESCB( N_ ) to run the code
1030* with.
1031*
1032* IMBBVAL (global output) INTEGER array
1033* On entry, IMBBVAL is an array of dimension LDVAL. On exit,
1034* this array contains the values of DESCB( IMB_ ) to run the
1035* code with.
1036*
1037* MBBVAL (global output) INTEGER array
1038* On entry, MBBVAL is an array of dimension LDVAL. On exit,
1039* this array contains the values of DESCB( MB_ ) to run the
1040* code with.
1041*
1042* INBBVAL (global output) INTEGER array
1043* On entry, INBBVAL is an array of dimension LDVAL. On exit,
1044* this array contains the values of DESCB( INB_ ) to run the
1045* code with.
1046*
1047* NBBVAL (global output) INTEGER array
1048* On entry, NBBVAL is an array of dimension LDVAL. On exit,
1049* this array contains the values of DESCB( NB_ ) to run the
1050* code with.
1051*
1052* RSCBVAL (global output) INTEGER array
1053* On entry, RSCBVAL is an array of dimension LDVAL. On exit,
1054* this array contains the values of DESCB( RSRC_ ) to run the
1055* code with.
1056*
1057* CSCBVAL (global output) INTEGER array
1058* On entry, CSCBVAL is an array of dimension LDVAL. On exit,
1059* this array contains the values of DESCB( CSRC_ ) to run the
1060* code with.
1061*
1062* IBVAL (global output) INTEGER array
1063* On entry, IBVAL is an array of dimension LDVAL. On exit, this
1064* array contains the values of IB to run the code with.
1065*
1066* JBVAL (global output) INTEGER array
1067* On entry, JBVAL is an array of dimension LDVAL. On exit, this
1068* array contains the values of JB to run the code with.
1069*
1070* MCVAL (global output) INTEGER array
1071* On entry, MCVAL is an array of dimension LDVAL. On exit, this
1072* array contains the values of DESCC( M_ ) to run the code
1073* with.
1074*
1075* NCVAL (global output) INTEGER array
1076* On entry, NCVAL is an array of dimension LDVAL. On exit, this
1077* array contains the values of DESCC( N_ ) to run the code
1078* with.
1079*
1080* IMBCVAL (global output) INTEGER array
1081* On entry, IMBCVAL is an array of dimension LDVAL. On exit,
1082* this array contains the values of DESCC( IMB_ ) to run the
1083* code with.
1084*
1085* MBCVAL (global output) INTEGER array
1086* On entry, MBCVAL is an array of dimension LDVAL. On exit,
1087* this array contains the values of DESCC( MB_ ) to run the
1088* code with.
1089*
1090* INBCVAL (global output) INTEGER array
1091* On entry, INBCVAL is an array of dimension LDVAL. On exit,
1092* this array contains the values of DESCC( INB_ ) to run the
1093* code with.
1094*
1095* NBCVAL (global output) INTEGER array
1096* On entry, NBCVAL is an array of dimension LDVAL. On exit,
1097* this array contains the values of DESCC( NB_ ) to run the
1098* code with.
1099*
1100* RSCCVAL (global output) INTEGER array
1101* On entry, RSCCVAL is an array of dimension LDVAL. On exit,
1102* this array contains the values of DESCC( RSRC_ ) to run the
1103* code with.
1104*
1105* CSCCVAL (global output) INTEGER array
1106* On entry, CSCCVAL is an array of dimension LDVAL. On exit,
1107* this array contains the values of DESCC( CSRC_ ) to run the
1108* code with.
1109*
1110* ICVAL (global output) INTEGER array
1111* On entry, ICVAL is an array of dimension LDVAL. On exit, this
1112* array contains the values of IC to run the code with.
1113*
1114* JCVAL (global output) INTEGER array
1115* On entry, JCVAL is an array of dimension LDVAL. On exit, this
1116* array contains the values of JC to run the code with.
1117*
1118* LDVAL (global input) INTEGER
1119* On entry, LDVAL specifies the maximum number of different va-
1120* lues that can be used for DIAG, SIDE, TRANSA, TRANSB, UPLO,
1121* M, N, K, DESCA(:), IA, JA, DESCB(:), IB, JB, DESCC(:), IC,
1122* JC. This is also the maximum number of test cases.
1123*
1124* NGRIDS (global output) INTEGER
1125* On exit, NGRIDS specifies the number of different values that
1126* can be used for P and Q.
1127*
1128* PVAL (global output) INTEGER array
1129* On entry, PVAL is an array of dimension LDPVAL. On exit, this
1130* array contains the values of P to run the code with.
1131*
1132* LDPVAL (global input) INTEGER
1133* On entry, LDPVAL specifies the maximum number of different
1134* values that can be used for P.
1135*
1136* QVAL (global output) INTEGER array
1137* On entry, QVAL is an array of dimension LDQVAL. On exit, this
1138* array contains the values of Q to run the code with.
1139*
1140* LDQVAL (global input) INTEGER
1141* On entry, LDQVAL specifies the maximum number of different
1142* values that can be used for Q.
1143*
1144* NBLOG (global output) INTEGER
1145* On exit, NBLOG specifies the logical computational block size
1146* to run the tests with. NBLOG must be at least one.
1147*
1148* LTEST (global output) LOGICAL array
1149* On entry, LTEST is an array of dimension at least eight. On
1150* exit, if LTEST( i ) is .TRUE., the i-th Level 3 PBLAS routine
1151* will be tested. See the input file for the ordering of the
1152* routines.
1153*
1154* IAM (local input) INTEGER
1155* On entry, IAM specifies the number of the process executing
1156* this routine.
1157*
1158* NPROCS (global input) INTEGER
1159* On entry, NPROCS specifies the total number of processes.
1160*
1161* ALPHA (global output) REAL
1162* On exit, ALPHA specifies the value of alpha to be used in all
1163* the test cases.
1164*
1165* BETA (global output) REAL
1166* On exit, BETA specifies the value of beta to be used in all
1167* the test cases.
1168*
1169* WORK (local workspace) INTEGER array
1170* On entry, WORK is an array of dimension at least
1171* MAX( 3, 2*NGRIDS+38*NMAT+NSUBS ) with NSUBS = 8. This array
1172* is used to pack all output arrays in order to send info in
1173* one message.
1174*
1175* -- Written on April 1, 1998 by
1176* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1177*
1178* =====================================================================
1179*
1180* .. Parameters ..
1181 INTEGER NIN, NSUBS
1182 parameter( nin = 11, nsubs = 8 )
1183* ..
1184* .. Local Scalars ..
1185 LOGICAL LTESTT
1186 INTEGER I, ICTXT, J
1187* ..
1188* .. Local Arrays ..
1189 CHARACTER*7 SNAMET
1190 CHARACTER*79 USRINFO
1191* ..
1192* .. External Subroutines ..
1193 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
1194 $ blacs_gridinit, blacs_setup, icopy, igebr2d,
1195 $ igebs2d, sgebr2d, sgebs2d
1196* ..
1197* .. Intrinsic Functions ..
1198 INTRINSIC char, ichar, max, min
1199* ..
1200* .. Common Blocks ..
1201 CHARACTER*7 SNAMES( NSUBS )
1202 COMMON /snamec/snames
1203* ..
1204* .. Executable Statements ..
1205*
1206* Process 0 reads the input data, broadcasts to other processes and
1207* writes needed information to NOUT
1208*
1209 IF( iam.EQ.0 ) THEN
1210*
1211* Open file and skip data file header
1212*
1213 OPEN( nin, file='PSBLAS3TIM.dat', status='OLD' )
1214 READ( nin, fmt = * ) summry
1215 summry = ' '
1216*
1217* Read in user-supplied info about machine type, compiler, etc.
1218*
1219 READ( nin, fmt = 9999 ) usrinfo
1220*
1221* Read name and unit number for summary output file
1222*
1223 READ( nin, fmt = * ) summry
1224 READ( nin, fmt = * ) nout
1225 IF( nout.NE.0 .AND. nout.NE.6 )
1226 $ OPEN( nout, file = summry, status = 'UNKNOWN' )
1227*
1228* Read and check the parameter values for the tests.
1229*
1230* Get logical computational block size
1231*
1232 READ( nin, fmt = * ) nblog
1233 IF( nblog.LT.1 )
1234 $ nblog = 32
1235*
1236* Get number of grids
1237*
1238 READ( nin, fmt = * ) ngrids
1239 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
1240 WRITE( nout, fmt = 9998 ) 'Grids', ldpval
1241 GO TO 120
1242 ELSE IF( ngrids.GT.ldqval ) THEN
1243 WRITE( nout, fmt = 9998 ) 'Grids', ldqval
1244 GO TO 120
1245 END IF
1246*
1247* Get values of P and Q
1248*
1249 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
1250 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
1251*
1252* Read ALPHA, BETA
1253*
1254 READ( nin, fmt = * ) alpha
1255 READ( nin, fmt = * ) beta
1256*
1257* Read number of tests.
1258*
1259 READ( nin, fmt = * ) nmat
1260 IF( nmat.LT.1 .OR. nmat.GT.ldval ) THEN
1261 WRITE( nout, fmt = 9998 ) 'Tests', ldval
1262 GO TO 120
1263 ENDIF
1264*
1265* Read in input data into arrays.
1266*
1267 READ( nin, fmt = * ) ( diagval( i ), i = 1, nmat )
1268 READ( nin, fmt = * ) ( sideval( i ), i = 1, nmat )
1269 READ( nin, fmt = * ) ( trnaval( i ), i = 1, nmat )
1270 READ( nin, fmt = * ) ( trnbval( i ), i = 1, nmat )
1271 READ( nin, fmt = * ) ( uploval( i ), i = 1, nmat )
1272 READ( nin, fmt = * ) ( mval( i ), i = 1, nmat )
1273 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
1274 READ( nin, fmt = * ) ( kval( i ), i = 1, nmat )
1275 READ( nin, fmt = * ) ( maval( i ), i = 1, nmat )
1276 READ( nin, fmt = * ) ( naval( i ), i = 1, nmat )
1277 READ( nin, fmt = * ) ( imbaval( i ), i = 1, nmat )
1278 READ( nin, fmt = * ) ( inbaval( i ), i = 1, nmat )
1279 READ( nin, fmt = * ) ( mbaval( i ), i = 1, nmat )
1280 READ( nin, fmt = * ) ( nbaval( i ), i = 1, nmat )
1281 READ( nin, fmt = * ) ( rscaval( i ), i = 1, nmat )
1282 READ( nin, fmt = * ) ( cscaval( i ), i = 1, nmat )
1283 READ( nin, fmt = * ) ( iaval( i ), i = 1, nmat )
1284 READ( nin, fmt = * ) ( javal( i ), i = 1, nmat )
1285 READ( nin, fmt = * ) ( mbval( i ), i = 1, nmat )
1286 READ( nin, fmt = * ) ( nbval( i ), i = 1, nmat )
1287 READ( nin, fmt = * ) ( imbbval( i ), i = 1, nmat )
1288 READ( nin, fmt = * ) ( inbbval( i ), i = 1, nmat )
1289 READ( nin, fmt = * ) ( mbbval( i ), i = 1, nmat )
1290 READ( nin, fmt = * ) ( nbbval( i ), i = 1, nmat )
1291 READ( nin, fmt = * ) ( rscbval( i ), i = 1, nmat )
1292 READ( nin, fmt = * ) ( cscbval( i ), i = 1, nmat )
1293 READ( nin, fmt = * ) ( ibval( i ), i = 1, nmat )
1294 READ( nin, fmt = * ) ( jbval( i ), i = 1, nmat )
1295 READ( nin, fmt = * ) ( mcval( i ), i = 1, nmat )
1296 READ( nin, fmt = * ) ( ncval( i ), i = 1, nmat )
1297 READ( nin, fmt = * ) ( imbcval( i ), i = 1, nmat )
1298 READ( nin, fmt = * ) ( inbcval( i ), i = 1, nmat )
1299 READ( nin, fmt = * ) ( mbcval( i ), i = 1, nmat )
1300 READ( nin, fmt = * ) ( nbcval( i ), i = 1, nmat )
1301 READ( nin, fmt = * ) ( rsccval( i ), i = 1, nmat )
1302 READ( nin, fmt = * ) ( csccval( i ), i = 1, nmat )
1303 READ( nin, fmt = * ) ( icval( i ), i = 1, nmat )
1304 READ( nin, fmt = * ) ( jcval( i ), i = 1, nmat )
1305*
1306* Read names of subroutines and flags which indicate
1307* whether they are to be tested.
1308*
1309 DO 10 i = 1, nsubs
1310 ltest( i ) = .false.
1311 10 CONTINUE
1312 20 CONTINUE
1313 READ( nin, fmt = 9996, END = 50 ) SNAMET, ltestt
1314 DO 30 i = 1, nsubs
1315 IF( snamet.EQ.snames( i ) )
1316 $ GO TO 40
1317 30 CONTINUE
1318*
1319 WRITE( nout, fmt = 9995 )snamet
1320 GO TO 120
1321*
1322 40 CONTINUE
1323 ltest( i ) = ltestt
1324 GO TO 20
1325*
1326 50 CONTINUE
1327*
1328* Close input file
1329*
1330 CLOSE ( nin )
1331*
1332* For pvm only: if virtual machine not set up, allocate it and
1333* spawn the correct number of processes.
1334*
1335 IF( nprocs.LT.1 ) THEN
1336 nprocs = 0
1337 DO 60 i = 1, ngrids
1338 nprocs = max( nprocs, pval( i )*qval( i ) )
1339 60 CONTINUE
1340 CALL blacs_setup( iam, nprocs )
1341 END IF
1342*
1343* Temporarily define blacs grid to include all processes so
1344* information can be broadcast to all processes
1345*
1346 CALL blacs_get( -1, 0, ictxt )
1347 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1348*
1349* Pack information arrays and broadcast
1350*
1351 CALL sgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
1352 CALL sgebs2d( ictxt, 'All', ' ', 1, 1, beta, 1 )
1353*
1354 work( 1 ) = ngrids
1355 work( 2 ) = nmat
1356 work( 3 ) = nblog
1357 CALL igebs2d( ictxt, 'All', ' ', 3, 1, work, 3 )
1358*
1359 i = 1
1360 DO 70 j = 1, nmat
1361 work( i ) = ichar( diagval( j ) )
1362 work( i+1 ) = ichar( sideval( j ) )
1363 work( i+2 ) = ichar( trnaval( j ) )
1364 work( i+3 ) = ichar( trnbval( j ) )
1365 work( i+4 ) = ichar( uploval( j ) )
1366 i = i + 5
1367 70 CONTINUE
1368 CALL icopy( ngrids, pval, 1, work( i ), 1 )
1369 i = i + ngrids
1370 CALL icopy( ngrids, qval, 1, work( i ), 1 )
1371 i = i + ngrids
1372 CALL icopy( nmat, mval, 1, work( i ), 1 )
1373 i = i + nmat
1374 CALL icopy( nmat, nval, 1, work( i ), 1 )
1375 i = i + nmat
1376 CALL icopy( nmat, kval, 1, work( i ), 1 )
1377 i = i + nmat
1378 CALL icopy( nmat, maval, 1, work( i ), 1 )
1379 i = i + nmat
1380 CALL icopy( nmat, naval, 1, work( i ), 1 )
1381 i = i + nmat
1382 CALL icopy( nmat, imbaval, 1, work( i ), 1 )
1383 i = i + nmat
1384 CALL icopy( nmat, inbaval, 1, work( i ), 1 )
1385 i = i + nmat
1386 CALL icopy( nmat, mbaval, 1, work( i ), 1 )
1387 i = i + nmat
1388 CALL icopy( nmat, nbaval, 1, work( i ), 1 )
1389 i = i + nmat
1390 CALL icopy( nmat, rscaval, 1, work( i ), 1 )
1391 i = i + nmat
1392 CALL icopy( nmat, cscaval, 1, work( i ), 1 )
1393 i = i + nmat
1394 CALL icopy( nmat, iaval, 1, work( i ), 1 )
1395 i = i + nmat
1396 CALL icopy( nmat, javal, 1, work( i ), 1 )
1397 i = i + nmat
1398 CALL icopy( nmat, mbval, 1, work( i ), 1 )
1399 i = i + nmat
1400 CALL icopy( nmat, nbval, 1, work( i ), 1 )
1401 i = i + nmat
1402 CALL icopy( nmat, imbbval, 1, work( i ), 1 )
1403 i = i + nmat
1404 CALL icopy( nmat, inbbval, 1, work( i ), 1 )
1405 i = i + nmat
1406 CALL icopy( nmat, mbbval, 1, work( i ), 1 )
1407 i = i + nmat
1408 CALL icopy( nmat, nbbval, 1, work( i ), 1 )
1409 i = i + nmat
1410 CALL icopy( nmat, rscbval, 1, work( i ), 1 )
1411 i = i + nmat
1412 CALL icopy( nmat, cscbval, 1, work( i ), 1 )
1413 i = i + nmat
1414 CALL icopy( nmat, ibval, 1, work( i ), 1 )
1415 i = i + nmat
1416 CALL icopy( nmat, jbval, 1, work( i ), 1 )
1417 i = i + nmat
1418 CALL icopy( nmat, mcval, 1, work( i ), 1 )
1419 i = i + nmat
1420 CALL icopy( nmat, ncval, 1, work( i ), 1 )
1421 i = i + nmat
1422 CALL icopy( nmat, imbcval, 1, work( i ), 1 )
1423 i = i + nmat
1424 CALL icopy( nmat, inbcval, 1, work( i ), 1 )
1425 i = i + nmat
1426 CALL icopy( nmat, mbcval, 1, work( i ), 1 )
1427 i = i + nmat
1428 CALL icopy( nmat, nbcval, 1, work( i ), 1 )
1429 i = i + nmat
1430 CALL icopy( nmat, rsccval, 1, work( i ), 1 )
1431 i = i + nmat
1432 CALL icopy( nmat, csccval, 1, work( i ), 1 )
1433 i = i + nmat
1434 CALL icopy( nmat, icval, 1, work( i ), 1 )
1435 i = i + nmat
1436 CALL icopy( nmat, jcval, 1, work( i ), 1 )
1437 i = i + nmat
1438*
1439 DO 80 j = 1, nsubs
1440 IF( ltest( j ) ) THEN
1441 work( i ) = 1
1442 ELSE
1443 work( i ) = 0
1444 END IF
1445 i = i + 1
1446 80 CONTINUE
1447 i = i - 1
1448 CALL igebs2d( ictxt, 'All', ' ', i, 1, work, i )
1449*
1450* regurgitate input
1451*
1452 WRITE( nout, fmt = 9999 )
1453 $ 'Level 3 PBLAS timing program.'
1454 WRITE( nout, fmt = 9999 ) usrinfo
1455 WRITE( nout, fmt = * )
1456 WRITE( nout, fmt = 9999 )
1457 $ 'Tests of the real single precision '//
1458 $ 'Level 3 PBLAS'
1459 WRITE( nout, fmt = * )
1460 WRITE( nout, fmt = 9992 ) nmat
1461 WRITE( nout, fmt = 9986 ) nblog
1462 WRITE( nout, fmt = 9991 ) ngrids
1463 WRITE( nout, fmt = 9989 )
1464 $ 'P', ( pval(i), i = 1, min(ngrids, 5) )
1465 IF( ngrids.GT.5 )
1466 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 6,
1467 $ min( 10, ngrids ) )
1468 IF( ngrids.GT.10 )
1469 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 11,
1470 $ min( 15, ngrids ) )
1471 IF( ngrids.GT.15 )
1472 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 16, ngrids )
1473 WRITE( nout, fmt = 9989 )
1474 $ 'Q', ( qval(i), i = 1, min(ngrids, 5) )
1475 IF( ngrids.GT.5 )
1476 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 6,
1477 $ min( 10, ngrids ) )
1478 IF( ngrids.GT.10 )
1479 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 11,
1480 $ min( 15, ngrids ) )
1481 IF( ngrids.GT.15 )
1482 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 16, ngrids )
1483 WRITE( nout, fmt = 9994 ) alpha
1484 WRITE( nout, fmt = 9993 ) beta
1485 IF( ltest( 1 ) ) THEN
1486 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... Yes'
1487 ELSE
1488 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... No '
1489 END IF
1490 DO 90 i = 2, nsubs
1491 IF( ltest( i ) ) THEN
1492 WRITE( nout, fmt = 9987 ) snames( i ), ' ... Yes'
1493 ELSE
1494 WRITE( nout, fmt = 9987 ) snames( i ), ' ... No '
1495 END IF
1496 90 CONTINUE
1497 WRITE( nout, fmt = * )
1498*
1499 ELSE
1500*
1501* If in pvm, must participate setting up virtual machine
1502*
1503 IF( nprocs.LT.1 )
1504 $ CALL blacs_setup( iam, nprocs )
1505*
1506* Temporarily define blacs grid to include all processes so
1507* information can be broadcast to all processes
1508*
1509 CALL blacs_get( -1, 0, ictxt )
1510 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1511*
1512 CALL sgebr2d( ictxt, 'All', ' ', 1, 1, alpha, 1, 0, 0 )
1513 CALL sgebr2d( ictxt, 'All', ' ', 1, 1, beta, 1, 0, 0 )
1514*
1515 CALL igebr2d( ictxt, 'All', ' ', 3, 1, work, 3, 0, 0 )
1516 ngrids = work( 1 )
1517 nmat = work( 2 )
1518 nblog = work( 3 )
1519*
1520 i = 2*ngrids + 38*nmat + nsubs
1521 CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
1522*
1523 i = 1
1524 DO 100 j = 1, nmat
1525 diagval( j ) = char( work( i ) )
1526 sideval( j ) = char( work( i+1 ) )
1527 trnaval( j ) = char( work( i+2 ) )
1528 trnbval( j ) = char( work( i+3 ) )
1529 uploval( j ) = char( work( i+4 ) )
1530 i = i + 5
1531 100 CONTINUE
1532 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1533 i = i + ngrids
1534 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1535 i = i + ngrids
1536 CALL icopy( nmat, work( i ), 1, mval, 1 )
1537 i = i + nmat
1538 CALL icopy( nmat, work( i ), 1, nval, 1 )
1539 i = i + nmat
1540 CALL icopy( nmat, work( i ), 1, kval, 1 )
1541 i = i + nmat
1542 CALL icopy( nmat, work( i ), 1, maval, 1 )
1543 i = i + nmat
1544 CALL icopy( nmat, work( i ), 1, naval, 1 )
1545 i = i + nmat
1546 CALL icopy( nmat, work( i ), 1, imbaval, 1 )
1547 i = i + nmat
1548 CALL icopy( nmat, work( i ), 1, inbaval, 1 )
1549 i = i + nmat
1550 CALL icopy( nmat, work( i ), 1, mbaval, 1 )
1551 i = i + nmat
1552 CALL icopy( nmat, work( i ), 1, nbaval, 1 )
1553 i = i + nmat
1554 CALL icopy( nmat, work( i ), 1, rscaval, 1 )
1555 i = i + nmat
1556 CALL icopy( nmat, work( i ), 1, cscaval, 1 )
1557 i = i + nmat
1558 CALL icopy( nmat, work( i ), 1, iaval, 1 )
1559 i = i + nmat
1560 CALL icopy( nmat, work( i ), 1, javal, 1 )
1561 i = i + nmat
1562 CALL icopy( nmat, work( i ), 1, mbval, 1 )
1563 i = i + nmat
1564 CALL icopy( nmat, work( i ), 1, nbval, 1 )
1565 i = i + nmat
1566 CALL icopy( nmat, work( i ), 1, imbbval, 1 )
1567 i = i + nmat
1568 CALL icopy( nmat, work( i ), 1, inbbval, 1 )
1569 i = i + nmat
1570 CALL icopy( nmat, work( i ), 1, mbbval, 1 )
1571 i = i + nmat
1572 CALL icopy( nmat, work( i ), 1, nbbval, 1 )
1573 i = i + nmat
1574 CALL icopy( nmat, work( i ), 1, rscbval, 1 )
1575 i = i + nmat
1576 CALL icopy( nmat, work( i ), 1, cscbval, 1 )
1577 i = i + nmat
1578 CALL icopy( nmat, work( i ), 1, ibval, 1 )
1579 i = i + nmat
1580 CALL icopy( nmat, work( i ), 1, jbval, 1 )
1581 i = i + nmat
1582 CALL icopy( nmat, work( i ), 1, mcval, 1 )
1583 i = i + nmat
1584 CALL icopy( nmat, work( i ), 1, ncval, 1 )
1585 i = i + nmat
1586 CALL icopy( nmat, work( i ), 1, imbcval, 1 )
1587 i = i + nmat
1588 CALL icopy( nmat, work( i ), 1, inbcval, 1 )
1589 i = i + nmat
1590 CALL icopy( nmat, work( i ), 1, mbcval, 1 )
1591 i = i + nmat
1592 CALL icopy( nmat, work( i ), 1, nbcval, 1 )
1593 i = i + nmat
1594 CALL icopy( nmat, work( i ), 1, rsccval, 1 )
1595 i = i + nmat
1596 CALL icopy( nmat, work( i ), 1, csccval, 1 )
1597 i = i + nmat
1598 CALL icopy( nmat, work( i ), 1, icval, 1 )
1599 i = i + nmat
1600 CALL icopy( nmat, work( i ), 1, jcval, 1 )
1601 i = i + nmat
1602*
1603 DO 110 j = 1, nsubs
1604 IF( work( i ).EQ.1 ) THEN
1605 ltest( j ) = .true.
1606 ELSE
1607 ltest( j ) = .false.
1608 END IF
1609 i = i + 1
1610 110 CONTINUE
1611*
1612 END IF
1613*
1614 CALL blacs_gridexit( ictxt )
1615*
1616 RETURN
1617*
1618 120 WRITE( nout, fmt = 9997 )
1619 CLOSE( nin )
1620 IF( nout.NE.6 .AND. nout.NE.0 )
1621 $ CLOSE( nout )
1622 CALL blacs_abort( ictxt, 1 )
1623*
1624 stop
1625*
1626 9999 FORMAT( a )
1627 9998 FORMAT( ' Number of values of ',5a, ' is less than 1 or greater ',
1628 $ 'than ', i2 )
1629 9997 FORMAT( ' Illegal input in file ',40a,'. Aborting run.' )
1630 9996 FORMAT( a7, l2 )
1631 9995 FORMAT( ' Subprogram name ', a7, ' not recognized',
1632 $ /' ******* TESTS ABANDONED *******' )
1633 9994 FORMAT( 2x, 'Alpha : ', g16.6 )
1634 9993 FORMAT( 2x, 'Beta : ', g16.6 )
1635 9992 FORMAT( 2x, 'Number of Tests : ', i6 )
1636 9991 FORMAT( 2x, 'Number of process grids : ', i6 )
1637 9990 FORMAT( 2x, ' : ', 5i6 )
1638 9989 FORMAT( 2x, a1, ' : ', 5i6 )
1639 9988 FORMAT( 2x, 'Routines to be tested : ', a, a8 )
1640 9987 FORMAT( 2x, ' ', a, a8 )
1641 9986 FORMAT( 2x, 'Logical block size : ', i6 )
1642*
1643* End of PSBLA3TIMINFO
1644*
alpha
#define alpha
Definition eval.h:35
icopy
subroutine icopy(n, sx, incx, sy, incy)
ICOPY
Definition icopy.f:75
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
sgebs2d
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1072
blacs_gridinit
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
sgebr2d
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762