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

Go to the source code of this file.

Functions/Subroutines

program pzbla3tim
subroutine pzbla3timinfo (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

◆ pzbla3tim()

program pzbla3tim

Definition at line 12 of file pzblas3tim.f.

◆ pzbla3timinfo()

subroutine pzbla3timinfo ( 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,
complex*16 alpha,
complex*16 beta,
integer, dimension( * ) work )

Definition at line 955 of file pzblas3tim.f.

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