SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pcbla3timinfo()

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

Definition at line 955 of file pcblas3tim.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 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* PCBLA3TIMINFO 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
1251* On exit, ALPHA specifies the value of alpha to be used in all
1252* the test cases.
1253*
1254* BETA (global output) COMPLEX
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, cgebr2d, cgebs2d,
1284 $ icopy, igebr2d, igebs2d, sgebr2d, sgebs2d
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='PCBLAS3TIM.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 cgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
1441 CALL cgebs2d( 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 single 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 cgebr2d( ictxt, 'All', ' ', 1, 1, alpha, 1, 0, 0 )
1602 CALL cgebr2d( 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 PCBLA3TIMINFO
1735*
icopy
subroutine icopy(n, sx, incx, sy, incy)
Definition pblastst.f:1525
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
Here is the call graph for this function:
Here is the caller graph for this function: