SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
All Classes Files Functions Variables Typedefs Macros

◆ 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*
subroutine icopy(n, sx, incx, sy, incy)
Definition pblastst.f:1525
#define max(A, B)
Definition pcgemr.c:180
#define min(A, B)
Definition pcgemr.c:181
Here is the call graph for this function:
Here is the caller graph for this function: