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

◆ pdbla3timinfo()

subroutine pdbla3timinfo ( 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,
double precision  alpha,
double precision  beta,
integer, dimension( * )  work 
)

Definition at line 864 of file pdblas3tim.f.

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