|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
00001 BLOCK DATA 00002 INTEGER NSUBS 00003 PARAMETER (NSUBS = 11) 00004 CHARACTER*7 SNAMES( NSUBS ) 00005 COMMON /SNAMEC/SNAMES 00006 DATA SNAMES/'PZGEMM ', 'PZSYMM ', 'PZHEMM ', 00007 $ 'PZSYRK ', 'PZHERK ', 'PZSYR2K', 00008 $ 'PZHER2K', 'PZTRMM ', 'PZTRSM ', 00009 $ 'PZGEADD', 'PZTRADD'/ 00010 END BLOCK DATA 00011 00012 PROGRAM PZBLA3TIM 00013 * 00014 * -- PBLAS timing driver (version 2.0.2) -- 00015 * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver 00016 * May 1 2012 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * PZBLA3TIM is the main timing program for the Level 3 PBLAS routines. 00022 * 00023 * The program must be driven by a short data file. An annotated exam- 00024 * ple of a data file can be obtained by deleting the first 3 characters 00025 * from the following 59 lines: 00026 * 'Level 3 PBLAS, Timing input file' 00027 * 'Intel iPSC/860 hypercube, gamma model.' 00028 * 'PZBLAS3TIM.SUMM' output file name (if any) 00029 * 6 device out 00030 * 10 value of the logical computational blocksize NB 00031 * 1 number of process grids (ordered pairs of P & Q) 00032 * 2 2 1 4 2 3 8 values of P 00033 * 2 2 4 1 3 2 1 values of Q 00034 * (1.0D0, 0.0D0) value of ALPHA 00035 * (1.0D0, 0.0D0) value of BETA 00036 * 2 number of tests problems 00037 * 'N' 'U' values of DIAG 00038 * 'L' 'R' values of SIDE 00039 * 'N' 'T' values of TRANSA 00040 * 'N' 'T' values of TRANSB 00041 * 'U' 'L' values of UPLO 00042 * 3 4 values of M 00043 * 3 4 values of N 00044 * 3 4 values of K 00045 * 6 10 values of M_A 00046 * 6 10 values of N_A 00047 * 2 5 values of IMB_A 00048 * 2 5 values of INB_A 00049 * 2 5 values of MB_A 00050 * 2 5 values of NB_A 00051 * 0 1 values of RSRC_A 00052 * 0 0 values of CSRC_A 00053 * 1 1 values of IA 00054 * 1 1 values of JA 00055 * 6 10 values of M_B 00056 * 6 10 values of N_B 00057 * 2 5 values of IMB_B 00058 * 2 5 values of INB_B 00059 * 2 5 values of MB_B 00060 * 2 5 values of NB_B 00061 * 0 1 values of RSRC_B 00062 * 0 0 values of CSRC_B 00063 * 1 1 values of IB 00064 * 1 1 values of JB 00065 * 6 10 values of M_C 00066 * 6 10 values of N_C 00067 * 2 5 values of IMB_C 00068 * 2 5 values of INB_C 00069 * 2 5 values of MB_C 00070 * 2 5 values of NB_C 00071 * 0 1 values of RSRC_C 00072 * 0 0 values of CSRC_C 00073 * 1 1 values of IC 00074 * 1 1 values of JC 00075 * PZGEMM T put F for no test in the same column 00076 * PZSYMM T put F for no test in the same column 00077 * PZHEMM T put F for no test in the same column 00078 * PZSYRK T put F for no test in the same column 00079 * PZHERK T put F for no test in the same column 00080 * PZSYR2K T put F for no test in the same column 00081 * PZHER2K T put F for no test in the same column 00082 * PZTRMM T put F for no test in the same column 00083 * PZTRSM T put F for no test in the same column 00084 * PZGEADD T put F for no test in the same column 00085 * PZTRADD T put F for no test in the same column 00086 * 00087 * Internal Parameters 00088 * =================== 00089 * 00090 * TOTMEM INTEGER 00091 * TOTMEM is a machine-specific parameter indicating the maxi- 00092 * mum amount of available memory per process in bytes. The 00093 * user should customize TOTMEM to his platform. Remember to 00094 * leave room in memory for the operating system, the BLACS 00095 * buffer, etc. For example, on a system with 8 MB of memory 00096 * per process (e.g., one processor on an Intel iPSC/860), the 00097 * parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS, 00098 * code, BLACS buffer, etc). However, for PVM, we usually set 00099 * TOTMEM = 2000000. Some experimenting with the maximum value 00100 * of TOTMEM may be required. By default, TOTMEM is 2000000. 00101 * 00102 * DBLESZ INTEGER 00103 * ZPLXSZ INTEGER 00104 * DBLESZ and ZPLXSZ indicate the length in bytes on the given 00105 * platform for a double precision real and a double precision 00106 * complex. By default, DBLESZ is set to eight and ZPLXSZ is set 00107 * to sixteen. 00108 * 00109 * MEM COMPLEX*16 array 00110 * MEM is an array of dimension TOTMEM / ZPLXSZ. 00111 * All arrays used by SCALAPACK routines are allocated from this 00112 * array MEM and referenced by pointers. The integer IPA, for 00113 * example, is a pointer to the starting element of MEM for the 00114 * matrix A. 00115 * 00116 * -- Written on April 1, 1998 by 00117 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 00118 * 00119 * ===================================================================== 00120 * 00121 * .. Parameters .. 00122 INTEGER MAXTESTS, MAXGRIDS, ZPLXSZ, TOTMEM, MEMSIZ, 00123 $ NSUBS 00124 COMPLEX*16 ONE 00125 PARAMETER ( MAXTESTS = 20, MAXGRIDS = 20, ZPLXSZ = 16, 00126 $ ONE = ( 1.0D+0, 0.0D+0 ), TOTMEM = 2000000, 00127 $ NSUBS = 11, MEMSIZ = TOTMEM / ZPLXSZ ) 00128 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_, 00129 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_, 00130 $ RSRC_ 00131 PARAMETER ( BLOCK_CYCLIC_2D_INB = 2, DLEN_ = 11, 00132 $ DTYPE_ = 1, CTXT_ = 2, M_ = 3, N_ = 4, 00133 $ IMB_ = 5, INB_ = 6, MB_ = 7, NB_ = 8, 00134 $ RSRC_ = 9, CSRC_ = 10, LLD_ = 11 ) 00135 * .. 00136 * .. Local Scalars .. 00137 CHARACTER*1 ADIAGDO, AFORM, CFORM, DIAG, SIDE, TRANSA, 00138 $ TRANSB, UPLO 00139 INTEGER CSRCA, CSRCB, CSRCC, I, IA, IAM, IASEED, IB, 00140 $ IBSEED, IC, ICSEED, ICTXT, IMBA, IMBB, IMBC, 00141 $ IMIDA, IMIDB, IMIDC, INBA, INBB, INBC, IPA, 00142 $ IPB, IPC, IPOSTA, IPOSTB, IPOSTC, IPREA, IPREB, 00143 $ IPREC, J, JA, JB, JC, K, L, M, MA, MB, MBA, 00144 $ MBB, MBC, MC, MEMREQD, MPA, MPB, MPC, MYCOL, 00145 $ MYROW, N, NA, NB, NBA, NBB, NBC, NC, NCOLA, 00146 $ NCOLB, NCOLC, NGRIDS, NOUT, NPCOL, NPROCS, 00147 $ NPROW, NQA, NQB, NQC, NROWA, NROWB, NROWC, 00148 $ NTESTS, OFFDA, OFFDC, RSRCA, RSRCB, RSRCC 00149 DOUBLE PRECISION CFLOPS, NOPS, WFLOPS 00150 COMPLEX*16 ALPHA, BETA, SCALE 00151 * .. 00152 * .. Local Arrays .. 00153 LOGICAL LTEST( NSUBS ), BCHECK( NSUBS ), 00154 $ CCHECK( NSUBS ) 00155 CHARACTER*1 DIAGVAL( MAXTESTS ), SIDEVAL( MAXTESTS ), 00156 $ TRNAVAL( MAXTESTS ), TRNBVAL( MAXTESTS ), 00157 $ UPLOVAL( MAXTESTS ) 00158 CHARACTER*80 OUTFILE 00159 INTEGER CSCAVAL( MAXTESTS ), CSCBVAL( MAXTESTS ), 00160 $ CSCCVAL( MAXTESTS ), DESCA( DLEN_ ), 00161 $ DESCB( DLEN_ ), DESCC( DLEN_ ), 00162 $ IAVAL( MAXTESTS ), IBVAL( MAXTESTS ), 00163 $ ICVAL( MAXTESTS ), IERR( 3 ), 00164 $ IMBAVAL( MAXTESTS ), IMBBVAL( MAXTESTS ), 00165 $ IMBCVAL( MAXTESTS ), INBAVAL( MAXTESTS ), 00166 $ INBBVAL( MAXTESTS ), INBCVAL( MAXTESTS ), 00167 $ JAVAL( MAXTESTS ), JBVAL( MAXTESTS ), 00168 $ JCVAL( MAXTESTS ), KVAL( MAXTESTS ), 00169 $ MAVAL( MAXTESTS ), MBAVAL( MAXTESTS ), 00170 $ MBBVAL( MAXTESTS ), MBCVAL( MAXTESTS ), 00171 $ MBVAL( MAXTESTS ), MCVAL( MAXTESTS ), 00172 $ MVAL( MAXTESTS ), NAVAL( MAXTESTS ), 00173 $ NBAVAL( MAXTESTS ), NBBVAL( MAXTESTS ), 00174 $ NBCVAL( MAXTESTS ), NBVAL( MAXTESTS ), 00175 $ NCVAL( MAXTESTS ), NVAL( MAXTESTS ), 00176 $ PVAL( MAXTESTS ), QVAL( MAXTESTS ), 00177 $ RSCAVAL( MAXTESTS ), RSCBVAL( MAXTESTS ), 00178 $ RSCCVAL( MAXTESTS ) 00179 DOUBLE PRECISION CTIME( 1 ), WTIME( 1 ) 00180 COMPLEX*16 MEM( MEMSIZ ) 00181 * .. 00182 * .. External Subroutines .. 00183 EXTERNAL BLACS_BARRIER, BLACS_EXIT, BLACS_GET, 00184 $ BLACS_GRIDEXIT, BLACS_GRIDINFO, BLACS_GRIDINIT, 00185 $ BLACS_PINFO, IGSUM2D, PB_BOOT, PB_COMBINE, 00186 $ PB_TIMER, PMDESCCHK, PMDIMCHK, PZBLA3TIMINFO, 00187 $ PZGEADD, PZGEMM, PZHEMM, PZHER2K, PZHERK, 00188 $ PZLAGEN, PZLASCAL, PZSYMM, PZSYR2K, PZSYRK, 00189 $ PZTRADD, PZTRMM, PZTRSM 00190 * .. 00191 * .. External Functions .. 00192 LOGICAL LSAME 00193 DOUBLE PRECISION PDOPBL3 00194 EXTERNAL LSAME, PDOPBL3 00195 * .. 00196 * .. Intrinsic Functions .. 00197 INTRINSIC DBLE, DCMPLX, MAX 00198 * .. 00199 * .. Common Blocks .. 00200 CHARACTER*7 SNAMES( NSUBS ) 00201 LOGICAL ABRTFLG 00202 INTEGER INFO, NBLOG 00203 COMMON /SNAMEC/SNAMES 00204 COMMON /INFOC/INFO, NBLOG 00205 COMMON /PBERRORC/NOUT, ABRTFLG 00206 * .. 00207 * .. Data Statements .. 00208 DATA BCHECK/.TRUE., .TRUE., .TRUE., .FALSE., 00209 $ .FALSE., .TRUE., .TRUE., .TRUE., .TRUE., 00210 $ .FALSE., .FALSE./ 00211 DATA CCHECK/.TRUE., .TRUE., .TRUE., .TRUE., .TRUE., 00212 $ .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., 00213 $ .TRUE./ 00214 * .. 00215 * .. Executable Statements .. 00216 * 00217 * Initialization 00218 * 00219 * Set flag so that the PBLAS error handler won't abort on errors, so 00220 * that the tester will detect unsupported operations. 00221 * 00222 ABRTFLG = .FALSE. 00223 * 00224 * Seeds for random matrix generations. 00225 * 00226 IASEED = 100 00227 IBSEED = 200 00228 ICSEED = 300 00229 * 00230 * Get starting information 00231 * 00232 CALL BLACS_PINFO( IAM, NPROCS ) 00233 CALL PZBLA3TIMINFO( OUTFILE, NOUT, NTESTS, DIAGVAL, SIDEVAL, 00234 $ TRNAVAL, TRNBVAL, UPLOVAL, MVAL, NVAL, 00235 $ KVAL, MAVAL, NAVAL, IMBAVAL, MBAVAL, 00236 $ INBAVAL, NBAVAL, RSCAVAL, CSCAVAL, IAVAL, 00237 $ JAVAL, MBVAL, NBVAL, IMBBVAL, MBBVAL, 00238 $ INBBVAL, NBBVAL, RSCBVAL, CSCBVAL, IBVAL, 00239 $ JBVAL, MCVAL, NCVAL, IMBCVAL, MBCVAL, 00240 $ INBCVAL, NBCVAL, RSCCVAL, CSCCVAL, ICVAL, 00241 $ JCVAL, MAXTESTS, NGRIDS, PVAL, MAXGRIDS, 00242 $ QVAL, MAXGRIDS, NBLOG, LTEST, IAM, NPROCS, 00243 $ ALPHA, BETA, MEM ) 00244 * 00245 IF( IAM.EQ.0 ) 00246 $ WRITE( NOUT, FMT = 9984 ) 00247 * 00248 * Loop over different process grids 00249 * 00250 DO 60 I = 1, NGRIDS 00251 * 00252 NPROW = PVAL( I ) 00253 NPCOL = QVAL( I ) 00254 * 00255 * Make sure grid information is correct 00256 * 00257 IERR( 1 ) = 0 00258 IF( NPROW.LT.1 ) THEN 00259 IF( IAM.EQ.0 ) 00260 $ WRITE( NOUT, FMT = 9999 ) 'GRID SIZE', 'NPROW', NPROW 00261 IERR( 1 ) = 1 00262 ELSE IF( NPCOL.LT.1 ) THEN 00263 IF( IAM.EQ.0 ) 00264 $ WRITE( NOUT, FMT = 9999 ) 'GRID SIZE', 'NPCOL', NPCOL 00265 IERR( 1 ) = 1 00266 ELSE IF( NPROW*NPCOL.GT.NPROCS ) THEN 00267 IF( IAM.EQ.0 ) 00268 $ WRITE( NOUT, FMT = 9998 ) NPROW*NPCOL, NPROCS 00269 IERR( 1 ) = 1 00270 END IF 00271 * 00272 IF( IERR( 1 ).GT.0 ) THEN 00273 IF( IAM.EQ.0 ) 00274 $ WRITE( NOUT, FMT = 9997 ) 'GRID' 00275 GO TO 60 00276 END IF 00277 * 00278 * Define process grid 00279 * 00280 CALL BLACS_GET( -1, 0, ICTXT ) 00281 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', NPROW, NPCOL ) 00282 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 00283 * 00284 * Go to bottom of process grid loop if this case doesn't use my 00285 * process 00286 * 00287 IF( MYROW.GE.NPROW .OR. MYCOL.GE.NPCOL ) 00288 $ GO TO 60 00289 * 00290 * Loop over number of tests 00291 * 00292 DO 50 J = 1, NTESTS 00293 * 00294 * Get the test parameters 00295 * 00296 DIAG = DIAGVAL( J ) 00297 SIDE = SIDEVAL( J ) 00298 TRANSA = TRNAVAL( J ) 00299 TRANSB = TRNBVAL( J ) 00300 UPLO = UPLOVAL( J ) 00301 * 00302 M = MVAL( J ) 00303 N = NVAL( J ) 00304 K = KVAL( J ) 00305 * 00306 MA = MAVAL( J ) 00307 NA = NAVAL( J ) 00308 IMBA = IMBAVAL( J ) 00309 MBA = MBAVAL( J ) 00310 INBA = INBAVAL( J ) 00311 NBA = NBAVAL( J ) 00312 RSRCA = RSCAVAL( J ) 00313 CSRCA = CSCAVAL( J ) 00314 IA = IAVAL( J ) 00315 JA = JAVAL( J ) 00316 * 00317 MB = MBVAL( J ) 00318 NB = NBVAL( J ) 00319 IMBB = IMBBVAL( J ) 00320 MBB = MBBVAL( J ) 00321 INBB = INBBVAL( J ) 00322 NBB = NBBVAL( J ) 00323 RSRCB = RSCBVAL( J ) 00324 CSRCB = CSCBVAL( J ) 00325 IB = IBVAL( J ) 00326 JB = JBVAL( J ) 00327 * 00328 MC = MCVAL( J ) 00329 NC = NCVAL( J ) 00330 IMBC = IMBCVAL( J ) 00331 MBC = MBCVAL( J ) 00332 INBC = INBCVAL( J ) 00333 NBC = NBCVAL( J ) 00334 RSRCC = RSCCVAL( J ) 00335 CSRCC = CSCCVAL( J ) 00336 IC = ICVAL( J ) 00337 JC = JCVAL( J ) 00338 * 00339 IF( IAM.EQ.0 ) THEN 00340 * 00341 WRITE( NOUT, FMT = * ) 00342 WRITE( NOUT, FMT = 9996 ) J, NPROW, NPCOL 00343 WRITE( NOUT, FMT = * ) 00344 * 00345 WRITE( NOUT, FMT = 9995 ) 00346 WRITE( NOUT, FMT = 9994 ) 00347 WRITE( NOUT, FMT = 9995 ) 00348 WRITE( NOUT, FMT = 9993 ) M, N, K, SIDE, UPLO, TRANSA, 00349 $ TRANSB, DIAG 00350 * 00351 WRITE( NOUT, FMT = 9995 ) 00352 WRITE( NOUT, FMT = 9992 ) 00353 WRITE( NOUT, FMT = 9995 ) 00354 WRITE( NOUT, FMT = 9991 ) IA, JA, MA, NA, IMBA, INBA, 00355 $ MBA, NBA, RSRCA, CSRCA 00356 * 00357 WRITE( NOUT, FMT = 9995 ) 00358 WRITE( NOUT, FMT = 9990 ) 00359 WRITE( NOUT, FMT = 9995 ) 00360 WRITE( NOUT, FMT = 9991 ) IB, JB, MB, NB, IMBB, INBB, 00361 $ MBB, NBB, RSRCB, CSRCB 00362 * 00363 WRITE( NOUT, FMT = 9995 ) 00364 WRITE( NOUT, FMT = 9989 ) 00365 WRITE( NOUT, FMT = 9995 ) 00366 WRITE( NOUT, FMT = 9991 ) IC, JC, MC, NC, IMBC, INBC, 00367 $ MBC, NBC, RSRCC, CSRCC 00368 * 00369 WRITE( NOUT, FMT = 9995 ) 00370 WRITE( NOUT, FMT = 9980 ) 00371 * 00372 END IF 00373 * 00374 * Check the validity of the input test parameters 00375 * 00376 IF( .NOT.LSAME( SIDE, 'L' ).AND. 00377 $ .NOT.LSAME( SIDE, 'R' ) ) THEN 00378 IF( IAM.EQ.0 ) 00379 $ WRITE( NOUT, FMT = 9997 ) 'SIDE' 00380 GO TO 40 00381 END IF 00382 * 00383 IF( .NOT.LSAME( UPLO, 'U' ).AND. 00384 $ .NOT.LSAME( UPLO, 'L' ) ) THEN 00385 IF( IAM.EQ.0 ) 00386 $ WRITE( NOUT, FMT = 9997 ) 'UPLO' 00387 GO TO 40 00388 END IF 00389 * 00390 IF( .NOT.LSAME( TRANSA, 'N' ).AND. 00391 $ .NOT.LSAME( TRANSA, 'T' ).AND. 00392 $ .NOT.LSAME( TRANSA, 'C' ) ) THEN 00393 IF( IAM.EQ.0 ) 00394 $ WRITE( NOUT, FMT = 9997 ) 'TRANSA' 00395 GO TO 40 00396 END IF 00397 * 00398 IF( .NOT.LSAME( TRANSB, 'N' ).AND. 00399 $ .NOT.LSAME( TRANSB, 'T' ).AND. 00400 $ .NOT.LSAME( TRANSB, 'C' ) ) THEN 00401 IF( IAM.EQ.0 ) 00402 $ WRITE( NOUT, FMT = 9997 ) 'TRANSB' 00403 GO TO 40 00404 END IF 00405 * 00406 IF( .NOT.LSAME( DIAG , 'U' ).AND. 00407 $ .NOT.LSAME( DIAG , 'N' ) )THEN 00408 IF( IAM.EQ.0 ) 00409 $ WRITE( NOUT, FMT = 9997 ) 'DIAG' 00410 GO TO 40 00411 END IF 00412 * 00413 * Check and initialize the matrix descriptors 00414 * 00415 CALL PMDESCCHK( ICTXT, NOUT, 'A', DESCA, 00416 $ BLOCK_CYCLIC_2D_INB, MA, NA, IMBA, INBA, 00417 $ MBA, NBA, RSRCA, CSRCA, MPA, NQA, IPREA, 00418 $ IMIDA, IPOSTA, 0, 0, IERR( 1 ) ) 00419 * 00420 CALL PMDESCCHK( ICTXT, NOUT, 'B', DESCB, 00421 $ BLOCK_CYCLIC_2D_INB, MB, NB, IMBB, INBB, 00422 $ MBB, NBB, RSRCB, CSRCB, MPB, NQB, IPREB, 00423 $ IMIDB, IPOSTB, 0, 0, IERR( 2 ) ) 00424 * 00425 CALL PMDESCCHK( ICTXT, NOUT, 'C', DESCC, 00426 $ BLOCK_CYCLIC_2D_INB, MC, NC, IMBC, INBC, 00427 $ MBC, NBC, RSRCC, CSRCC, MPC, NQC, IPREC, 00428 $ IMIDC, IPOSTC, 0, 0, IERR( 3 ) ) 00429 * 00430 IF( IERR( 1 ).GT.0 .OR. IERR( 2 ).GT.0 .OR. 00431 $ IERR( 3 ).GT.0 ) THEN 00432 GO TO 40 00433 END IF 00434 * 00435 * Assign pointers into MEM for matrices corresponding to 00436 * the distributed matrices A, X and Y. 00437 * 00438 IPA = IPREA + 1 00439 IPB = IPA + DESCA( LLD_ )*NQA 00440 IPC = IPB + DESCB( LLD_ )*NQB 00441 * 00442 * Check if sufficient memory. 00443 * 00444 MEMREQD = IPC + DESCC( LLD_ )*NQC - 1 00445 IERR( 1 ) = 0 00446 IF( MEMREQD.GT.MEMSIZ ) THEN 00447 IF( IAM.EQ.0 ) 00448 $ WRITE( NOUT, FMT = 9987 ) MEMREQD*ZPLXSZ 00449 IERR( 1 ) = 1 00450 END IF 00451 * 00452 * Check all processes for an error 00453 * 00454 CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 ) 00455 * 00456 IF( IERR( 1 ).GT.0 ) THEN 00457 IF( IAM.EQ.0 ) 00458 $ WRITE( NOUT, FMT = 9988 ) 00459 GO TO 40 00460 END IF 00461 * 00462 * Loop over all PBLAS 3 routines 00463 * 00464 DO 30 L = 1, NSUBS 00465 * 00466 * Continue only if this subroutine has to be tested. 00467 * 00468 IF( .NOT.LTEST( L ) ) 00469 $ GO TO 30 00470 * 00471 * Define the size of the operands 00472 * 00473 IF( L.EQ.1 ) THEN 00474 * 00475 * PZGEMM 00476 * 00477 NROWC = M 00478 NCOLC = N 00479 IF( LSAME( TRANSA, 'N' ) ) THEN 00480 NROWA = M 00481 NCOLA = K 00482 ELSE 00483 NROWA = K 00484 NCOLA = M 00485 END IF 00486 IF( LSAME( TRANSB, 'N' ) ) THEN 00487 NROWB = K 00488 NCOLB = N 00489 ELSE 00490 NROWB = N 00491 NCOLB = K 00492 END IF 00493 ELSE IF( L.EQ.2 .OR. L.EQ.3 ) THEN 00494 * 00495 * PZSYMM, PZHEMM 00496 * 00497 NROWC = M 00498 NCOLC = N 00499 NROWB = M 00500 NCOLB = N 00501 IF( LSAME( SIDE, 'L' ) ) THEN 00502 NROWA = M 00503 NCOLA = M 00504 ELSE 00505 NROWA = N 00506 NCOLA = N 00507 END IF 00508 ELSE IF( L.EQ.4 .OR. L.EQ.5 ) THEN 00509 * 00510 * PZSYRK, PZHERK 00511 * 00512 NROWC = N 00513 NCOLC = N 00514 IF( LSAME( TRANSA, 'N' ) ) THEN 00515 NROWA = N 00516 NCOLA = K 00517 ELSE 00518 NROWA = K 00519 NCOLA = N 00520 END IF 00521 NROWB = 0 00522 NCOLB = 0 00523 ELSE IF( L.EQ.6 .OR. L.EQ.7 ) THEN 00524 * 00525 * PZSYR2K, PZHER2K 00526 * 00527 NROWC = N 00528 NCOLC = N 00529 IF( LSAME( TRANSA, 'N' ) ) THEN 00530 NROWA = N 00531 NCOLA = K 00532 NROWB = N 00533 NCOLB = K 00534 ELSE 00535 NROWA = K 00536 NCOLA = N 00537 NROWB = K 00538 NCOLB = N 00539 END IF 00540 ELSE IF( L.EQ.8 .OR. L.EQ.9 ) THEN 00541 * 00542 * PZTRMM, PZTRSM 00543 * 00544 NROWB = M 00545 NCOLB = N 00546 IF( LSAME( SIDE, 'L' ) ) THEN 00547 NROWA = M 00548 NCOLA = M 00549 ELSE 00550 NROWA = N 00551 NCOLA = N 00552 END IF 00553 NROWC = 0 00554 NCOLC = 0 00555 ELSE IF( L.EQ.10 .OR. L.EQ.11 ) THEN 00556 * 00557 * PZGEADD, PZTRADD 00558 * 00559 IF( LSAME( TRANSA, 'N' ) ) THEN 00560 NROWA = M 00561 NCOLA = N 00562 ELSE 00563 NROWA = N 00564 NCOLA = M 00565 END IF 00566 NROWC = M 00567 NCOLC = N 00568 NROWB = 0 00569 NCOLB = 0 00570 * 00571 END IF 00572 * 00573 * Check the validity of the operand sizes 00574 * 00575 CALL PMDIMCHK( ICTXT, NOUT, NROWA, NCOLA, 'A', IA, JA, 00576 $ DESCA, IERR( 1 ) ) 00577 CALL PMDIMCHK( ICTXT, NOUT, NROWB, NCOLB, 'B', IB, JB, 00578 $ DESCB, IERR( 2 ) ) 00579 CALL PMDIMCHK( ICTXT, NOUT, NROWC, NCOLC, 'C', IC, JC, 00580 $ DESCC, IERR( 3 ) ) 00581 * 00582 IF( IERR( 1 ).NE.0 .OR. IERR( 2 ).NE.0 .OR. 00583 $ IERR( 3 ).NE.0 ) THEN 00584 GO TO 30 00585 END IF 00586 * 00587 * Check special values of TRANSA for symmetric and 00588 * hermitian rank-k and rank-2k updates. 00589 * 00590 IF( L.EQ.4 .OR. L.EQ.6 ) THEN 00591 IF( .NOT.LSAME( TRANSA, 'N' ).AND. 00592 $ .NOT.LSAME( TRANSA, 'T' ) ) THEN 00593 IF( IAM.EQ.0 ) 00594 $ WRITE( NOUT, FMT = 9983 ) SNAMES( L ), 'TRANSA' 00595 GO TO 30 00596 END IF 00597 ELSE IF( L.EQ.5 .OR. L.EQ.7 ) THEN 00598 IF( .NOT.LSAME( TRANSA, 'N' ).AND. 00599 $ .NOT.LSAME( TRANSA, 'C' ) ) THEN 00600 IF( IAM.EQ.0 ) 00601 $ WRITE( NOUT, FMT = 9983 ) SNAMES( L ), 'TRANSA' 00602 GO TO 30 00603 END IF 00604 END IF 00605 * 00606 * Generate distributed matrices A, B and C 00607 * 00608 IF( L.EQ.2 ) THEN 00609 * 00610 * PZSYMM 00611 * 00612 AFORM = 'S' 00613 ADIAGDO = 'N' 00614 OFFDA = IA - JA 00615 CFORM = 'N' 00616 OFFDC = 0 00617 * 00618 ELSE IF( L.EQ.3 ) THEN 00619 * 00620 * PZHEMM 00621 * 00622 AFORM = 'H' 00623 ADIAGDO = 'N' 00624 OFFDA = IA - JA 00625 CFORM = 'N' 00626 OFFDC = 0 00627 * 00628 ELSE IF( L.EQ.4 .OR. L.EQ.6 ) THEN 00629 * 00630 * PZSYRK, PZSYR2K 00631 * 00632 AFORM = 'N' 00633 ADIAGDO = 'N' 00634 OFFDA = 0 00635 CFORM = 'S' 00636 OFFDC = IC - JC 00637 * 00638 ELSE IF( L.EQ.5 .OR. L.EQ.7 ) THEN 00639 * 00640 * PZHERK, PZHER2K 00641 * 00642 AFORM = 'N' 00643 ADIAGDO = 'N' 00644 OFFDA = 0 00645 CFORM = 'H' 00646 OFFDC = IC - JC 00647 * 00648 ELSE IF( ( L.EQ.9 ).AND.( LSAME( DIAG, 'N' ) ) ) THEN 00649 * 00650 * PZTRSM 00651 * 00652 AFORM = 'N' 00653 ADIAGDO = 'D' 00654 OFFDA = IA - JA 00655 CFORM = 'N' 00656 OFFDC = 0 00657 * 00658 ELSE 00659 * 00660 * Default values 00661 * 00662 AFORM = 'N' 00663 ADIAGDO = 'N' 00664 OFFDA = 0 00665 CFORM = 'N' 00666 OFFDC = 0 00667 * 00668 END IF 00669 * 00670 CALL PZLAGEN( .FALSE., AFORM, ADIAGDO, OFFDA, MA, NA, 00671 $ 1, 1, DESCA, IASEED, MEM( IPA ), 00672 $ DESCA( LLD_ ) ) 00673 IF( ( L.EQ.9 ).AND.( .NOT.( LSAME( DIAG, 'N' ) ) ).AND. 00674 $ ( MAX( NROWA, NCOLA ).GT.1 ) ) THEN 00675 SCALE = ONE / DCMPLX( DBLE( MAX( NROWA, NCOLA ) ) ) 00676 IF( LSAME( UPLO, 'L' ) ) THEN 00677 CALL PZLASCAL( 'Lower', NROWA-1, NCOLA-1, SCALE, 00678 $ MEM( IPA ), IA+1, JA, DESCA ) 00679 ELSE 00680 CALL PZLASCAL( 'Upper', NROWA-1, NCOLA-1, SCALE, 00681 $ MEM( IPA ), IA, JA+1, DESCA ) 00682 END IF 00683 * 00684 END IF 00685 * 00686 IF( BCHECK( L ) ) 00687 $ CALL PZLAGEN( .FALSE., 'None', 'No diag', 0, MB, NB, 00688 $ 1, 1, DESCB, IBSEED, MEM( IPB ), 00689 $ DESCB( LLD_ ) ) 00690 * 00691 IF( CCHECK( L ) ) 00692 $ CALL PZLAGEN( .FALSE., CFORM, 'No diag', OFFDC, MC, 00693 $ NC, 1, 1, DESCC, ICSEED, MEM( IPC ), 00694 $ DESCC( LLD_ ) ) 00695 * 00696 INFO = 0 00697 CALL PB_BOOT() 00698 CALL BLACS_BARRIER( ICTXT, 'All' ) 00699 * 00700 * Call the Level 3 PBLAS routine 00701 * 00702 IF( L.EQ.1 ) THEN 00703 * 00704 * Test PZGEMM 00705 * 00706 NOPS = PDOPBL3( SNAMES( L ), M, N, K ) 00707 * 00708 CALL PB_TIMER( 1 ) 00709 CALL PZGEMM( TRANSA, TRANSB, M, N, K, ALPHA, 00710 $ MEM( IPA ), IA, JA, DESCA, MEM( IPB ), 00711 $ IB, JB, DESCB, BETA, MEM( IPC ), IC, JC, 00712 $ DESCC ) 00713 CALL PB_TIMER( 1 ) 00714 * 00715 ELSE IF( L.EQ.2 ) THEN 00716 * 00717 * Test PZSYMM 00718 * 00719 IF( LSAME( SIDE, 'L' ) ) THEN 00720 NOPS = PDOPBL3( SNAMES( L ), M, N, 0 ) 00721 ELSE 00722 NOPS = PDOPBL3( SNAMES( L ), M, N, 1 ) 00723 END IF 00724 * 00725 CALL PB_TIMER( 1 ) 00726 CALL PZSYMM( SIDE, UPLO, M, N, ALPHA, MEM( IPA ), IA, 00727 $ JA, DESCA, MEM( IPB ), IB, JB, DESCB, 00728 $ BETA, MEM( IPC ), IC, JC, DESCC ) 00729 CALL PB_TIMER( 1 ) 00730 * 00731 ELSE IF( L.EQ.3 ) THEN 00732 * 00733 * Test PZHEMM 00734 * 00735 IF( LSAME( SIDE, 'L' ) ) THEN 00736 NOPS = PDOPBL3( SNAMES( L ), M, N, 0 ) 00737 ELSE 00738 NOPS = PDOPBL3( SNAMES( L ), M, N, 1 ) 00739 END IF 00740 * 00741 CALL PB_TIMER( 1 ) 00742 CALL PZHEMM( SIDE, UPLO, M, N, ALPHA, MEM( IPA ), IA, 00743 $ JA, DESCA, MEM( IPB ), IB, JB, DESCB, 00744 $ BETA, MEM( IPC ), IC, JC, DESCC ) 00745 CALL PB_TIMER( 1 ) 00746 * 00747 ELSE IF( L.EQ.4 ) THEN 00748 * 00749 * Test PZSYRK 00750 * 00751 NOPS = PDOPBL3( SNAMES( L ), N, N, K ) 00752 * 00753 CALL PB_TIMER( 1 ) 00754 CALL PZSYRK( UPLO, TRANSA, N, K, ALPHA, MEM( IPA ), 00755 $ IA, JA, DESCA, BETA, MEM( IPC ), IC, JC, 00756 $ DESCC ) 00757 CALL PB_TIMER( 1 ) 00758 * 00759 ELSE IF( L.EQ.5 ) THEN 00760 * 00761 * Test PZHERK 00762 * 00763 NOPS = PDOPBL3( SNAMES( L ), N, N, K ) 00764 * 00765 CALL PB_TIMER( 1 ) 00766 CALL PZHERK( UPLO, TRANSA, N, K, DBLE( ALPHA ), 00767 $ MEM( IPA ), IA, JA, DESCA, DBLE( BETA ), 00768 $ MEM( IPC ), IC, JC, DESCC ) 00769 CALL PB_TIMER( 1 ) 00770 * 00771 ELSE IF( L.EQ.6 ) THEN 00772 * 00773 * Test PZSYR2K 00774 * 00775 NOPS = PDOPBL3( SNAMES( L ), N, N, K ) 00776 * 00777 CALL PB_TIMER( 1 ) 00778 CALL PZSYR2K( UPLO, TRANSA, N, K, ALPHA, MEM( IPA ), 00779 $ IA, JA, DESCA, MEM( IPB ), IB, JB, 00780 $ DESCB, BETA, MEM( IPC ), IC, JC, 00781 $ DESCC ) 00782 CALL PB_TIMER( 1 ) 00783 * 00784 ELSE IF( L.EQ.7 ) THEN 00785 * 00786 * Test PZHER2K 00787 * 00788 NOPS = PDOPBL3( SNAMES( L ), N, N, K ) 00789 * 00790 CALL PB_TIMER( 1 ) 00791 CALL PZHER2K( UPLO, TRANSA, N, K, ALPHA, MEM( IPA ), 00792 $ IA, JA, DESCA, MEM( IPB ), IB, JB, 00793 $ DESCB, DBLE( BETA ), MEM( IPC ), IC, JC, 00794 $ DESCC ) 00795 CALL PB_TIMER( 1 ) 00796 * 00797 ELSE IF( L.EQ.8 ) THEN 00798 * 00799 * Test PZTRMM 00800 * 00801 IF( LSAME( SIDE, 'L' ) ) THEN 00802 NOPS = PDOPBL3( SNAMES( L ), M, N, 0 ) 00803 ELSE 00804 NOPS = PDOPBL3( SNAMES( L ), M, N, 1 ) 00805 END IF 00806 * 00807 CALL PB_TIMER( 1 ) 00808 CALL PZTRMM( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, 00809 $ MEM( IPA ), IA, JA, DESCA, MEM( IPB ), 00810 $ IB, JB, DESCB ) 00811 CALL PB_TIMER( 1 ) 00812 * 00813 ELSE IF( L.EQ.9 ) THEN 00814 * 00815 * Test PZTRSM 00816 * 00817 IF( LSAME( SIDE, 'L' ) ) THEN 00818 NOPS = PDOPBL3( SNAMES( L ), M, N, 0 ) 00819 ELSE 00820 NOPS = PDOPBL3( SNAMES( L ), M, N, 1 ) 00821 END IF 00822 * 00823 CALL PB_TIMER( 1 ) 00824 CALL PZTRSM( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, 00825 $ MEM( IPA ), IA, JA, DESCA, MEM( IPB ), 00826 $ IB, JB, DESCB ) 00827 CALL PB_TIMER( 1 ) 00828 * 00829 ELSE IF( L.EQ.10 ) THEN 00830 * 00831 * Test PZGEADD 00832 * 00833 NOPS = PDOPBL3( SNAMES( L ), M, N, M ) 00834 * 00835 CALL PB_TIMER( 1 ) 00836 CALL PZGEADD( TRANSA, M, N, ALPHA, MEM( IPA ), IA, JA, 00837 $ DESCA, BETA, MEM( IPC ), IC, JC, DESCC ) 00838 CALL PB_TIMER( 1 ) 00839 * 00840 ELSE IF( L.EQ.11 ) THEN 00841 * 00842 * Test PZTRADD 00843 * 00844 IF( LSAME( UPLO, 'U' ) ) THEN 00845 NOPS = PDOPBL3( SNAMES( L ), M, N, 0 ) 00846 ELSE 00847 NOPS = PDOPBL3( SNAMES( L ), M, N, 1 ) 00848 END IF 00849 * 00850 CALL PB_TIMER( 1 ) 00851 CALL PZTRADD( UPLO, TRANSA, M, N, ALPHA, MEM( IPA ), 00852 $ IA, JA, DESCA, BETA, MEM( IPC ), IC, JC, 00853 $ DESCC ) 00854 CALL PB_TIMER( 1 ) 00855 * 00856 END IF 00857 * 00858 * Check if the operation has been performed. 00859 * 00860 IF( INFO.NE.0 ) THEN 00861 IF( IAM.EQ.0 ) 00862 $ WRITE( NOUT, FMT = 9982 ) INFO 00863 GO TO 30 00864 END IF 00865 * 00866 CALL PB_COMBINE( ICTXT, 'All', '>', 'W', 1, 1, WTIME ) 00867 CALL PB_COMBINE( ICTXT, 'All', '>', 'C', 1, 1, CTIME ) 00868 * 00869 * Only node 0 prints timing test result 00870 * 00871 IF( IAM.EQ.0 ) THEN 00872 * 00873 * Print WALL time if machine supports it 00874 * 00875 IF( WTIME( 1 ).GT.0.0D+0 ) THEN 00876 WFLOPS = NOPS / ( WTIME( 1 ) * 1.0D+6 ) 00877 ELSE 00878 WFLOPS = 0.0D+0 00879 END IF 00880 * 00881 * Print CPU time if machine supports it 00882 * 00883 IF( CTIME( 1 ).GT.0.0D+0 ) THEN 00884 CFLOPS = NOPS / ( CTIME( 1 ) * 1.0D+6 ) 00885 ELSE 00886 CFLOPS = 0.0D+0 00887 END IF 00888 * 00889 WRITE( NOUT, FMT = 9981 ) SNAMES( L ), WTIME( 1 ), 00890 $ WFLOPS, CTIME( 1 ), CFLOPS 00891 * 00892 END IF 00893 * 00894 30 CONTINUE 00895 * 00896 40 IF( IAM.EQ.0 ) THEN 00897 WRITE( NOUT, FMT = 9995 ) 00898 WRITE( NOUT, FMT = * ) 00899 WRITE( NOUT, FMT = 9986 ) J 00900 END IF 00901 * 00902 50 CONTINUE 00903 * 00904 CALL BLACS_GRIDEXIT( ICTXT ) 00905 * 00906 60 CONTINUE 00907 * 00908 IF( IAM.EQ.0 ) THEN 00909 WRITE( NOUT, FMT = * ) 00910 WRITE( NOUT, FMT = 9985 ) 00911 WRITE( NOUT, FMT = * ) 00912 END IF 00913 * 00914 CALL BLACS_EXIT( 0 ) 00915 * 00916 9999 FORMAT( 'ILLEGAL ', A, ': ', A, ' = ', I10, 00917 $ ' should be at least 1' ) 00918 9998 FORMAT( 'ILLEGAL GRID: NPROW*NPCOL = ', I4, 00919 $ '. It can be at most', I4 ) 00920 9997 FORMAT( 'Bad ', A, ' parameters: going on to next test case.' ) 00921 9996 FORMAT( 2X, 'Test number ', I2 , ' started on a ', I4, ' x ', 00922 $ I4, ' process grid.' ) 00923 9995 FORMAT( 2X, ' ------------------------------------------------', 00924 $ '-------------------' ) 00925 9994 FORMAT( 2X, ' M N K SIDE UPLO TRANSA ', 00926 $ 'TRANSB DIAG' ) 00927 9993 FORMAT( 5X,I6,1X,I6,1X,I6,6X,A1,5X,A1,7X,A1,7X,A1,5X,A1 ) 00928 9992 FORMAT( 2X, ' IA JA MA NA IMBA INBA', 00929 $ ' MBA NBA RSRCA CSRCA' ) 00930 9991 FORMAT( 5X,I6,1X,I6,1X,I6,1X,I6,1X,I6,1X,I6,1X,I6,1X,I6, 00931 $ 1X,I5,1X,I5 ) 00932 9990 FORMAT( 2X, ' IB JB MB NB IMBB INBB', 00933 $ ' MBB NBB RSRCB CSRCB' ) 00934 9989 FORMAT( 2X, ' IC JC MC NC IMBC INBC', 00935 $ ' MBC NBC RSRCC CSRCC' ) 00936 9988 FORMAT( 'Not enough memory for this test: going on to', 00937 $ ' next test case.' ) 00938 9987 FORMAT( 'Not enough memory. Need: ', I12 ) 00939 9986 FORMAT( 2X, 'Test number ', I2, ' completed.' ) 00940 9985 FORMAT( 2X, 'End of Tests.' ) 00941 9984 FORMAT( 2X, 'Tests started.' ) 00942 9983 FORMAT( 5X, A, ' ***** ', A, ' has an incorrect value: ', 00943 $ ' BYPASS *****' ) 00944 9982 FORMAT( 2X, ' ***** Operation not supported, error code: ', 00945 $ I5, ' *****' ) 00946 9981 FORMAT( 2X, '| ', A, 2X, F13.3, 2X, F13.3, 2X, F13.3, 2X, F13.3 ) 00947 9980 FORMAT( 2X, ' WALL time (s) WALL Mflops ', 00948 $ ' CPU time (s) CPU Mflops' ) 00949 * 00950 STOP 00951 * 00952 * End of PZBLA3TIM 00953 * 00954 END 00955 SUBROUTINE PZBLA3TIMINFO( SUMMRY, NOUT, NMAT, DIAGVAL, SIDEVAL, 00956 $ TRNAVAL, TRNBVAL, UPLOVAL, MVAL, 00957 $ NVAL, KVAL, MAVAL, NAVAL, IMBAVAL, 00958 $ MBAVAL, INBAVAL, NBAVAL, RSCAVAL, 00959 $ CSCAVAL, IAVAL, JAVAL, MBVAL, NBVAL, 00960 $ IMBBVAL, MBBVAL, INBBVAL, NBBVAL, 00961 $ RSCBVAL, CSCBVAL, IBVAL, JBVAL, 00962 $ MCVAL, NCVAL, IMBCVAL, MBCVAL, 00963 $ INBCVAL, NBCVAL, RSCCVAL, CSCCVAL, 00964 $ ICVAL, JCVAL, LDVAL, NGRIDS, PVAL, 00965 $ LDPVAL, QVAL, LDQVAL, NBLOG, LTEST, 00966 $ IAM, NPROCS, ALPHA, BETA, WORK ) 00967 * 00968 * -- PBLAS test routine (version 2.0) -- 00969 * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 00970 * and University of California, Berkeley. 00971 * April 1, 1998 00972 * 00973 * .. Scalar Arguments .. 00974 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NBLOG, NGRIDS, 00975 $ NMAT, NOUT, NPROCS 00976 COMPLEX*16 ALPHA, BETA 00977 * .. 00978 * .. Array Arguments .. 00979 CHARACTER*( * ) SUMMRY 00980 CHARACTER*1 DIAGVAL( LDVAL ), SIDEVAL( LDVAL ), 00981 $ TRNAVAL( LDVAL ), TRNBVAL( LDVAL ), 00982 $ UPLOVAL( LDVAL ) 00983 LOGICAL LTEST( * ) 00984 INTEGER CSCAVAL( LDVAL ), CSCBVAL( LDVAL ), 00985 $ CSCCVAL( LDVAL ), IAVAL( LDVAL ), 00986 $ IBVAL( LDVAL ), ICVAL( LDVAL ), 00987 $ IMBAVAL( LDVAL ), IMBBVAL( LDVAL ), 00988 $ IMBCVAL( LDVAL ), INBAVAL( LDVAL ), 00989 $ INBBVAL( LDVAL ), INBCVAL( LDVAL ), 00990 $ JAVAL( LDVAL ), JBVAL( LDVAL ), JCVAL( LDVAL ), 00991 $ KVAL( LDVAL ), MAVAL( LDVAL ), MBAVAL( LDVAL ), 00992 $ MBBVAL( LDVAL ), MBCVAL( LDVAL ), 00993 $ MBVAL( LDVAL ), MCVAL( LDVAL ), MVAL( LDVAL ), 00994 $ NAVAL( LDVAL ), NBAVAL( LDVAL ), 00995 $ NBBVAL( LDVAL ), NBCVAL( LDVAL ), 00996 $ NBVAL( LDVAL ), NCVAL( LDVAL ), NVAL( LDVAL ), 00997 $ PVAL( LDPVAL ), QVAL( LDQVAL ), 00998 $ RSCAVAL( LDVAL ), RSCBVAL( LDVAL ), 00999 $ RSCCVAL( LDVAL ), WORK( * ) 01000 * .. 01001 * 01002 * Purpose 01003 * ======= 01004 * 01005 * PZBLA3TIMINFO get the needed startup information for timing various 01006 * Level 3 PBLAS routines, and transmits it to all processes. 01007 * 01008 * Notes 01009 * ===== 01010 * 01011 * For packing the information we assumed that the length in bytes of an 01012 * integer is equal to the length in bytes of a real single precision. 01013 * 01014 * Arguments 01015 * ========= 01016 * 01017 * SUMMRY (global output) CHARACTER*(*) 01018 * On exit, SUMMRY is the name of output (summary) file (if 01019 * any). SUMMRY is only defined for process 0. 01020 * 01021 * NOUT (global output) INTEGER 01022 * On exit, NOUT specifies the unit number for the output file. 01023 * When NOUT is 6, output to screen, when NOUT is 0, output to 01024 * stderr. NOUT is only defined for process 0. 01025 * 01026 * NMAT (global output) INTEGER 01027 * On exit, NMAT specifies the number of different test cases. 01028 * 01029 * DIAGVAL (global output) CHARACTER array 01030 * On entry, DIAGVAL is an array of dimension LDVAL. On exit, 01031 * this array contains the values of DIAG to run the code with. 01032 * 01033 * SIDEVAL (global output) CHARACTER array 01034 * On entry, SIDEVAL is an array of dimension LDVAL. On exit, 01035 * this array contains the values of SIDE to run the code with. 01036 * 01037 * TRNAVAL (global output) CHARACTER array 01038 * On entry, TRNAVAL is an array of dimension LDVAL. On exit, 01039 * this array contains the values of TRANSA to run the code 01040 * with. 01041 * 01042 * TRNBVAL (global output) CHARACTER array 01043 * On entry, TRNBVAL is an array of dimension LDVAL. On exit, 01044 * this array contains the values of TRANSB to run the code 01045 * with. 01046 * 01047 * UPLOVAL (global output) CHARACTER array 01048 * On entry, UPLOVAL is an array of dimension LDVAL. On exit, 01049 * this array contains the values of UPLO to run the code with. 01050 * 01051 * MVAL (global output) INTEGER array 01052 * On entry, MVAL is an array of dimension LDVAL. On exit, this 01053 * array contains the values of M to run the code with. 01054 * 01055 * NVAL (global output) INTEGER array 01056 * On entry, NVAL is an array of dimension LDVAL. On exit, this 01057 * array contains the values of N to run the code with. 01058 * 01059 * KVAL (global output) INTEGER array 01060 * On entry, KVAL is an array of dimension LDVAL. On exit, this 01061 * array contains the values of K to run the code with. 01062 * 01063 * MAVAL (global output) INTEGER array 01064 * On entry, MAVAL is an array of dimension LDVAL. On exit, this 01065 * array contains the values of DESCA( M_ ) to run the code 01066 * with. 01067 * 01068 * NAVAL (global output) INTEGER array 01069 * On entry, NAVAL is an array of dimension LDVAL. On exit, this 01070 * array contains the values of DESCA( N_ ) to run the code 01071 * with. 01072 * 01073 * IMBAVAL (global output) INTEGER array 01074 * On entry, IMBAVAL is an array of dimension LDVAL. On exit, 01075 * this array contains the values of DESCA( IMB_ ) to run the 01076 * code with. 01077 * 01078 * MBAVAL (global output) INTEGER array 01079 * On entry, MBAVAL is an array of dimension LDVAL. On exit, 01080 * this array contains the values of DESCA( MB_ ) to run the 01081 * code with. 01082 * 01083 * INBAVAL (global output) INTEGER array 01084 * On entry, INBAVAL is an array of dimension LDVAL. On exit, 01085 * this array contains the values of DESCA( INB_ ) to run the 01086 * code with. 01087 * 01088 * NBAVAL (global output) INTEGER array 01089 * On entry, NBAVAL is an array of dimension LDVAL. On exit, 01090 * this array contains the values of DESCA( NB_ ) to run the 01091 * code with. 01092 * 01093 * RSCAVAL (global output) INTEGER array 01094 * On entry, RSCAVAL is an array of dimension LDVAL. On exit, 01095 * this array contains the values of DESCA( RSRC_ ) to run the 01096 * code with. 01097 * 01098 * CSCAVAL (global output) INTEGER array 01099 * On entry, CSCAVAL is an array of dimension LDVAL. On exit, 01100 * this array contains the values of DESCA( CSRC_ ) to run the 01101 * code with. 01102 * 01103 * IAVAL (global output) INTEGER array 01104 * On entry, IAVAL is an array of dimension LDVAL. On exit, this 01105 * array contains the values of IA to run the code with. 01106 * 01107 * JAVAL (global output) INTEGER array 01108 * On entry, JAVAL is an array of dimension LDVAL. On exit, this 01109 * array contains the values of JA to run the code with. 01110 * 01111 * MBVAL (global output) INTEGER array 01112 * On entry, MBVAL is an array of dimension LDVAL. On exit, this 01113 * array contains the values of DESCB( M_ ) to run the code 01114 * with. 01115 * 01116 * NBVAL (global output) INTEGER array 01117 * On entry, NBVAL is an array of dimension LDVAL. On exit, this 01118 * array contains the values of DESCB( N_ ) to run the code 01119 * with. 01120 * 01121 * IMBBVAL (global output) INTEGER array 01122 * On entry, IMBBVAL is an array of dimension LDVAL. On exit, 01123 * this array contains the values of DESCB( IMB_ ) to run the 01124 * code with. 01125 * 01126 * MBBVAL (global output) INTEGER array 01127 * On entry, MBBVAL is an array of dimension LDVAL. On exit, 01128 * this array contains the values of DESCB( MB_ ) to run the 01129 * code with. 01130 * 01131 * INBBVAL (global output) INTEGER array 01132 * On entry, INBBVAL is an array of dimension LDVAL. On exit, 01133 * this array contains the values of DESCB( INB_ ) to run the 01134 * code with. 01135 * 01136 * NBBVAL (global output) INTEGER array 01137 * On entry, NBBVAL is an array of dimension LDVAL. On exit, 01138 * this array contains the values of DESCB( NB_ ) to run the 01139 * code with. 01140 * 01141 * RSCBVAL (global output) INTEGER array 01142 * On entry, RSCBVAL is an array of dimension LDVAL. On exit, 01143 * this array contains the values of DESCB( RSRC_ ) to run the 01144 * code with. 01145 * 01146 * CSCBVAL (global output) INTEGER array 01147 * On entry, CSCBVAL is an array of dimension LDVAL. On exit, 01148 * this array contains the values of DESCB( CSRC_ ) to run the 01149 * code with. 01150 * 01151 * IBVAL (global output) INTEGER array 01152 * On entry, IBVAL is an array of dimension LDVAL. On exit, this 01153 * array contains the values of IB to run the code with. 01154 * 01155 * JBVAL (global output) INTEGER array 01156 * On entry, JBVAL is an array of dimension LDVAL. On exit, this 01157 * array contains the values of JB to run the code with. 01158 * 01159 * MCVAL (global output) INTEGER array 01160 * On entry, MCVAL is an array of dimension LDVAL. On exit, this 01161 * array contains the values of DESCC( M_ ) to run the code 01162 * with. 01163 * 01164 * NCVAL (global output) INTEGER array 01165 * On entry, NCVAL is an array of dimension LDVAL. On exit, this 01166 * array contains the values of DESCC( N_ ) to run the code 01167 * with. 01168 * 01169 * IMBCVAL (global output) INTEGER array 01170 * On entry, IMBCVAL is an array of dimension LDVAL. On exit, 01171 * this array contains the values of DESCC( IMB_ ) to run the 01172 * code with. 01173 * 01174 * MBCVAL (global output) INTEGER array 01175 * On entry, MBCVAL is an array of dimension LDVAL. On exit, 01176 * this array contains the values of DESCC( MB_ ) to run the 01177 * code with. 01178 * 01179 * INBCVAL (global output) INTEGER array 01180 * On entry, INBCVAL is an array of dimension LDVAL. On exit, 01181 * this array contains the values of DESCC( INB_ ) to run the 01182 * code with. 01183 * 01184 * NBCVAL (global output) INTEGER array 01185 * On entry, NBCVAL is an array of dimension LDVAL. On exit, 01186 * this array contains the values of DESCC( NB_ ) to run the 01187 * code with. 01188 * 01189 * RSCCVAL (global output) INTEGER array 01190 * On entry, RSCCVAL is an array of dimension LDVAL. On exit, 01191 * this array contains the values of DESCC( RSRC_ ) to run the 01192 * code with. 01193 * 01194 * CSCCVAL (global output) INTEGER array 01195 * On entry, CSCCVAL is an array of dimension LDVAL. On exit, 01196 * this array contains the values of DESCC( CSRC_ ) to run the 01197 * code with. 01198 * 01199 * ICVAL (global output) INTEGER array 01200 * On entry, ICVAL is an array of dimension LDVAL. On exit, this 01201 * array contains the values of IC to run the code with. 01202 * 01203 * JCVAL (global output) INTEGER array 01204 * On entry, JCVAL is an array of dimension LDVAL. On exit, this 01205 * array contains the values of JC to run the code with. 01206 * 01207 * LDVAL (global input) INTEGER 01208 * On entry, LDVAL specifies the maximum number of different va- 01209 * lues that can be used for DIAG, SIDE, TRANSA, TRANSB, UPLO, 01210 * M, N, K, DESCA(:), IA, JA, DESCB(:), IB, JB, DESCC(:), IC, 01211 * JC. This is also the maximum number of test cases. 01212 * 01213 * NGRIDS (global output) INTEGER 01214 * On exit, NGRIDS specifies the number of different values that 01215 * can be used for P and Q. 01216 * 01217 * PVAL (global output) INTEGER array 01218 * On entry, PVAL is an array of dimension LDPVAL. On exit, this 01219 * array contains the values of P to run the code with. 01220 * 01221 * LDPVAL (global input) INTEGER 01222 * On entry, LDPVAL specifies the maximum number of different 01223 * values that can be used for P. 01224 * 01225 * QVAL (global output) INTEGER array 01226 * On entry, QVAL is an array of dimension LDQVAL. On exit, this 01227 * array contains the values of Q to run the code with. 01228 * 01229 * LDQVAL (global input) INTEGER 01230 * On entry, LDQVAL specifies the maximum number of different 01231 * values that can be used for Q. 01232 * 01233 * NBLOG (global output) INTEGER 01234 * On exit, NBLOG specifies the logical computational block size 01235 * to run the tests with. NBLOG must be at least one. 01236 * 01237 * LTEST (global output) LOGICAL array 01238 * On entry, LTEST is an array of dimension at least eleven. On 01239 * exit, if LTEST( i ) is .TRUE., the i-th Level 3 PBLAS routine 01240 * will be tested. See the input file for the ordering of the 01241 * routines. 01242 * 01243 * IAM (local input) INTEGER 01244 * On entry, IAM specifies the number of the process executing 01245 * this routine. 01246 * 01247 * NPROCS (global input) INTEGER 01248 * On entry, NPROCS specifies the total number of processes. 01249 * 01250 * ALPHA (global output) COMPLEX*16 01251 * On exit, ALPHA specifies the value of alpha to be used in all 01252 * the test cases. 01253 * 01254 * BETA (global output) COMPLEX*16 01255 * On exit, BETA specifies the value of beta to be used in all 01256 * the test cases. 01257 * 01258 * WORK (local workspace) INTEGER array 01259 * On entry, WORK is an array of dimension at least 01260 * MAX( 3, 2*NGRIDS+38*NMAT+NSUBS ) with NSUBS = 11. This array 01261 * is used to pack all output arrays in order to send info in 01262 * one message. 01263 * 01264 * -- Written on April 1, 1998 by 01265 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 01266 * 01267 * ===================================================================== 01268 * 01269 * .. Parameters .. 01270 INTEGER NIN, NSUBS 01271 PARAMETER ( NIN = 11, NSUBS = 11 ) 01272 * .. 01273 * .. Local Scalars .. 01274 LOGICAL LTESTT 01275 INTEGER I, ICTXT, J 01276 * .. 01277 * .. Local Arrays .. 01278 CHARACTER*7 SNAMET 01279 CHARACTER*79 USRINFO 01280 * .. 01281 * .. External Subroutines .. 01282 EXTERNAL BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT, 01283 $ BLACS_GRIDINIT, BLACS_SETUP, ICOPY, IGEBR2D, 01284 $ IGEBS2D, SGEBR2D, SGEBS2D, ZGEBR2D, ZGEBS2D 01285 * .. 01286 * .. Intrinsic Functions .. 01287 INTRINSIC CHAR, ICHAR, MAX, MIN 01288 * .. 01289 * .. Common Blocks .. 01290 CHARACTER*7 SNAMES( NSUBS ) 01291 COMMON /SNAMEC/SNAMES 01292 * .. 01293 * .. Executable Statements .. 01294 * 01295 * Process 0 reads the input data, broadcasts to other processes and 01296 * writes needed information to NOUT 01297 * 01298 IF( IAM.EQ.0 ) THEN 01299 * 01300 * Open file and skip data file header 01301 * 01302 OPEN( NIN, FILE='PZBLAS3TIM.dat', STATUS='OLD' ) 01303 READ( NIN, FMT = * ) SUMMRY 01304 SUMMRY = ' ' 01305 * 01306 * Read in user-supplied info about machine type, compiler, etc. 01307 * 01308 READ( NIN, FMT = 9999 ) USRINFO 01309 * 01310 * Read name and unit number for summary output file 01311 * 01312 READ( NIN, FMT = * ) SUMMRY 01313 READ( NIN, FMT = * ) NOUT 01314 IF( NOUT.NE.0 .AND. NOUT.NE.6 ) 01315 $ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' ) 01316 * 01317 * Read and check the parameter values for the tests. 01318 * 01319 * Get logical computational block size 01320 * 01321 READ( NIN, FMT = * ) NBLOG 01322 IF( NBLOG.LT.1 ) 01323 $ NBLOG = 32 01324 * 01325 * Get number of grids 01326 * 01327 READ( NIN, FMT = * ) NGRIDS 01328 IF( NGRIDS.LT.1 .OR. NGRIDS.GT.LDPVAL ) THEN 01329 WRITE( NOUT, FMT = 9998 ) 'Grids', LDPVAL 01330 GO TO 120 01331 ELSE IF( NGRIDS.GT.LDQVAL ) THEN 01332 WRITE( NOUT, FMT = 9998 ) 'Grids', LDQVAL 01333 GO TO 120 01334 END IF 01335 * 01336 * Get values of P and Q 01337 * 01338 READ( NIN, FMT = * ) ( PVAL( I ), I = 1, NGRIDS ) 01339 READ( NIN, FMT = * ) ( QVAL( I ), I = 1, NGRIDS ) 01340 * 01341 * Read ALPHA, BETA 01342 * 01343 READ( NIN, FMT = * ) ALPHA 01344 READ( NIN, FMT = * ) BETA 01345 * 01346 * Read number of tests. 01347 * 01348 READ( NIN, FMT = * ) NMAT 01349 IF( NMAT.LT.1 .OR. NMAT.GT.LDVAL ) THEN 01350 WRITE( NOUT, FMT = 9998 ) 'Tests', LDVAL 01351 GO TO 120 01352 ENDIF 01353 * 01354 * Read in input data into arrays. 01355 * 01356 READ( NIN, FMT = * ) ( DIAGVAL( I ), I = 1, NMAT ) 01357 READ( NIN, FMT = * ) ( SIDEVAL( I ), I = 1, NMAT ) 01358 READ( NIN, FMT = * ) ( TRNAVAL( I ), I = 1, NMAT ) 01359 READ( NIN, FMT = * ) ( TRNBVAL( I ), I = 1, NMAT ) 01360 READ( NIN, FMT = * ) ( UPLOVAL( I ), I = 1, NMAT ) 01361 READ( NIN, FMT = * ) ( MVAL ( I ), I = 1, NMAT ) 01362 READ( NIN, FMT = * ) ( NVAL ( I ), I = 1, NMAT ) 01363 READ( NIN, FMT = * ) ( KVAL ( I ), I = 1, NMAT ) 01364 READ( NIN, FMT = * ) ( MAVAL ( I ), I = 1, NMAT ) 01365 READ( NIN, FMT = * ) ( NAVAL ( I ), I = 1, NMAT ) 01366 READ( NIN, FMT = * ) ( IMBAVAL( I ), I = 1, NMAT ) 01367 READ( NIN, FMT = * ) ( INBAVAL( I ), I = 1, NMAT ) 01368 READ( NIN, FMT = * ) ( MBAVAL ( I ), I = 1, NMAT ) 01369 READ( NIN, FMT = * ) ( NBAVAL ( I ), I = 1, NMAT ) 01370 READ( NIN, FMT = * ) ( RSCAVAL( I ), I = 1, NMAT ) 01371 READ( NIN, FMT = * ) ( CSCAVAL( I ), I = 1, NMAT ) 01372 READ( NIN, FMT = * ) ( IAVAL ( I ), I = 1, NMAT ) 01373 READ( NIN, FMT = * ) ( JAVAL ( I ), I = 1, NMAT ) 01374 READ( NIN, FMT = * ) ( MBVAL ( I ), I = 1, NMAT ) 01375 READ( NIN, FMT = * ) ( NBVAL ( I ), I = 1, NMAT ) 01376 READ( NIN, FMT = * ) ( IMBBVAL( I ), I = 1, NMAT ) 01377 READ( NIN, FMT = * ) ( INBBVAL( I ), I = 1, NMAT ) 01378 READ( NIN, FMT = * ) ( MBBVAL ( I ), I = 1, NMAT ) 01379 READ( NIN, FMT = * ) ( NBBVAL ( I ), I = 1, NMAT ) 01380 READ( NIN, FMT = * ) ( RSCBVAL( I ), I = 1, NMAT ) 01381 READ( NIN, FMT = * ) ( CSCBVAL( I ), I = 1, NMAT ) 01382 READ( NIN, FMT = * ) ( IBVAL ( I ), I = 1, NMAT ) 01383 READ( NIN, FMT = * ) ( JBVAL ( I ), I = 1, NMAT ) 01384 READ( NIN, FMT = * ) ( MCVAL ( I ), I = 1, NMAT ) 01385 READ( NIN, FMT = * ) ( NCVAL ( I ), I = 1, NMAT ) 01386 READ( NIN, FMT = * ) ( IMBCVAL( I ), I = 1, NMAT ) 01387 READ( NIN, FMT = * ) ( INBCVAL( I ), I = 1, NMAT ) 01388 READ( NIN, FMT = * ) ( MBCVAL ( I ), I = 1, NMAT ) 01389 READ( NIN, FMT = * ) ( NBCVAL ( I ), I = 1, NMAT ) 01390 READ( NIN, FMT = * ) ( RSCCVAL( I ), I = 1, NMAT ) 01391 READ( NIN, FMT = * ) ( CSCCVAL( I ), I = 1, NMAT ) 01392 READ( NIN, FMT = * ) ( ICVAL ( I ), I = 1, NMAT ) 01393 READ( NIN, FMT = * ) ( JCVAL ( I ), I = 1, NMAT ) 01394 * 01395 * Read names of subroutines and flags which indicate 01396 * whether they are to be tested. 01397 * 01398 DO 10 I = 1, NSUBS 01399 LTEST( I ) = .FALSE. 01400 10 CONTINUE 01401 20 CONTINUE 01402 READ( NIN, FMT = 9996, END = 50 ) SNAMET, LTESTT 01403 DO 30 I = 1, NSUBS 01404 IF( SNAMET.EQ.SNAMES( I ) ) 01405 $ GO TO 40 01406 30 CONTINUE 01407 * 01408 WRITE( NOUT, FMT = 9995 )SNAMET 01409 GO TO 120 01410 * 01411 40 CONTINUE 01412 LTEST( I ) = LTESTT 01413 GO TO 20 01414 * 01415 50 CONTINUE 01416 * 01417 * Close input file 01418 * 01419 CLOSE ( NIN ) 01420 * 01421 * For pvm only: if virtual machine not set up, allocate it and 01422 * spawn the correct number of processes. 01423 * 01424 IF( NPROCS.LT.1 ) THEN 01425 NPROCS = 0 01426 DO 60 I = 1, NGRIDS 01427 NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) ) 01428 60 CONTINUE 01429 CALL BLACS_SETUP( IAM, NPROCS ) 01430 END IF 01431 * 01432 * Temporarily define blacs grid to include all processes so 01433 * information can be broadcast to all processes 01434 * 01435 CALL BLACS_GET( -1, 0, ICTXT ) 01436 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS ) 01437 * 01438 * Pack information arrays and broadcast 01439 * 01440 CALL ZGEBS2D( ICTXT, 'All', ' ', 1, 1, ALPHA, 1 ) 01441 CALL ZGEBS2D( ICTXT, 'All', ' ', 1, 1, BETA, 1 ) 01442 * 01443 WORK( 1 ) = NGRIDS 01444 WORK( 2 ) = NMAT 01445 WORK( 3 ) = NBLOG 01446 CALL IGEBS2D( ICTXT, 'All', ' ', 3, 1, WORK, 3 ) 01447 * 01448 I = 1 01449 DO 70 J = 1, NMAT 01450 WORK( I ) = ICHAR( DIAGVAL( J ) ) 01451 WORK( I+1 ) = ICHAR( SIDEVAL( J ) ) 01452 WORK( I+2 ) = ICHAR( TRNAVAL( J ) ) 01453 WORK( I+3 ) = ICHAR( TRNBVAL( J ) ) 01454 WORK( I+4 ) = ICHAR( UPLOVAL( J ) ) 01455 I = I + 5 01456 70 CONTINUE 01457 CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 ) 01458 I = I + NGRIDS 01459 CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 ) 01460 I = I + NGRIDS 01461 CALL ICOPY( NMAT, MVAL, 1, WORK( I ), 1 ) 01462 I = I + NMAT 01463 CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 ) 01464 I = I + NMAT 01465 CALL ICOPY( NMAT, KVAL, 1, WORK( I ), 1 ) 01466 I = I + NMAT 01467 CALL ICOPY( NMAT, MAVAL, 1, WORK( I ), 1 ) 01468 I = I + NMAT 01469 CALL ICOPY( NMAT, NAVAL, 1, WORK( I ), 1 ) 01470 I = I + NMAT 01471 CALL ICOPY( NMAT, IMBAVAL, 1, WORK( I ), 1 ) 01472 I = I + NMAT 01473 CALL ICOPY( NMAT, INBAVAL, 1, WORK( I ), 1 ) 01474 I = I + NMAT 01475 CALL ICOPY( NMAT, MBAVAL, 1, WORK( I ), 1 ) 01476 I = I + NMAT 01477 CALL ICOPY( NMAT, NBAVAL, 1, WORK( I ), 1 ) 01478 I = I + NMAT 01479 CALL ICOPY( NMAT, RSCAVAL, 1, WORK( I ), 1 ) 01480 I = I + NMAT 01481 CALL ICOPY( NMAT, CSCAVAL, 1, WORK( I ), 1 ) 01482 I = I + NMAT 01483 CALL ICOPY( NMAT, IAVAL, 1, WORK( I ), 1 ) 01484 I = I + NMAT 01485 CALL ICOPY( NMAT, JAVAL, 1, WORK( I ), 1 ) 01486 I = I + NMAT 01487 CALL ICOPY( NMAT, MBVAL, 1, WORK( I ), 1 ) 01488 I = I + NMAT 01489 CALL ICOPY( NMAT, NBVAL, 1, WORK( I ), 1 ) 01490 I = I + NMAT 01491 CALL ICOPY( NMAT, IMBBVAL, 1, WORK( I ), 1 ) 01492 I = I + NMAT 01493 CALL ICOPY( NMAT, INBBVAL, 1, WORK( I ), 1 ) 01494 I = I + NMAT 01495 CALL ICOPY( NMAT, MBBVAL, 1, WORK( I ), 1 ) 01496 I = I + NMAT 01497 CALL ICOPY( NMAT, NBBVAL, 1, WORK( I ), 1 ) 01498 I = I + NMAT 01499 CALL ICOPY( NMAT, RSCBVAL, 1, WORK( I ), 1 ) 01500 I = I + NMAT 01501 CALL ICOPY( NMAT, CSCBVAL, 1, WORK( I ), 1 ) 01502 I = I + NMAT 01503 CALL ICOPY( NMAT, IBVAL, 1, WORK( I ), 1 ) 01504 I = I + NMAT 01505 CALL ICOPY( NMAT, JBVAL, 1, WORK( I ), 1 ) 01506 I = I + NMAT 01507 CALL ICOPY( NMAT, MCVAL, 1, WORK( I ), 1 ) 01508 I = I + NMAT 01509 CALL ICOPY( NMAT, NCVAL, 1, WORK( I ), 1 ) 01510 I = I + NMAT 01511 CALL ICOPY( NMAT, IMBCVAL, 1, WORK( I ), 1 ) 01512 I = I + NMAT 01513 CALL ICOPY( NMAT, INBCVAL, 1, WORK( I ), 1 ) 01514 I = I + NMAT 01515 CALL ICOPY( NMAT, MBCVAL, 1, WORK( I ), 1 ) 01516 I = I + NMAT 01517 CALL ICOPY( NMAT, NBCVAL, 1, WORK( I ), 1 ) 01518 I = I + NMAT 01519 CALL ICOPY( NMAT, RSCCVAL, 1, WORK( I ), 1 ) 01520 I = I + NMAT 01521 CALL ICOPY( NMAT, CSCCVAL, 1, WORK( I ), 1 ) 01522 I = I + NMAT 01523 CALL ICOPY( NMAT, ICVAL, 1, WORK( I ), 1 ) 01524 I = I + NMAT 01525 CALL ICOPY( NMAT, JCVAL, 1, WORK( I ), 1 ) 01526 I = I + NMAT 01527 * 01528 DO 80 J = 1, NSUBS 01529 IF( LTEST( J ) ) THEN 01530 WORK( I ) = 1 01531 ELSE 01532 WORK( I ) = 0 01533 END IF 01534 I = I + 1 01535 80 CONTINUE 01536 I = I - 1 01537 CALL IGEBS2D( ICTXT, 'All', ' ', I, 1, WORK, I ) 01538 * 01539 * regurgitate input 01540 * 01541 WRITE( NOUT, FMT = 9999 ) 01542 $ 'Level 3 PBLAS timing program.' 01543 WRITE( NOUT, FMT = 9999 ) USRINFO 01544 WRITE( NOUT, FMT = * ) 01545 WRITE( NOUT, FMT = 9999 ) 01546 $ 'Tests of the complex double precision '// 01547 $ 'Level 3 PBLAS' 01548 WRITE( NOUT, FMT = * ) 01549 WRITE( NOUT, FMT = 9992 ) NMAT 01550 WRITE( NOUT, FMT = 9986 ) NBLOG 01551 WRITE( NOUT, FMT = 9991 ) NGRIDS 01552 WRITE( NOUT, FMT = 9989 ) 01553 $ 'P', ( PVAL(I), I = 1, MIN(NGRIDS, 5) ) 01554 IF( NGRIDS.GT.5 ) 01555 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 6, 01556 $ MIN( 10, NGRIDS ) ) 01557 IF( NGRIDS.GT.10 ) 01558 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 11, 01559 $ MIN( 15, NGRIDS ) ) 01560 IF( NGRIDS.GT.15 ) 01561 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 16, NGRIDS ) 01562 WRITE( NOUT, FMT = 9989 ) 01563 $ 'Q', ( QVAL(I), I = 1, MIN(NGRIDS, 5) ) 01564 IF( NGRIDS.GT.5 ) 01565 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 6, 01566 $ MIN( 10, NGRIDS ) ) 01567 IF( NGRIDS.GT.10 ) 01568 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 11, 01569 $ MIN( 15, NGRIDS ) ) 01570 IF( NGRIDS.GT.15 ) 01571 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 16, NGRIDS ) 01572 WRITE( NOUT, FMT = 9994 ) ALPHA 01573 WRITE( NOUT, FMT = 9993 ) BETA 01574 IF( LTEST( 1 ) ) THEN 01575 WRITE( NOUT, FMT = 9988 ) SNAMES( 1 ), ' ... Yes' 01576 ELSE 01577 WRITE( NOUT, FMT = 9988 ) SNAMES( 1 ), ' ... No ' 01578 END IF 01579 DO 90 I = 2, NSUBS 01580 IF( LTEST( I ) ) THEN 01581 WRITE( NOUT, FMT = 9987 ) SNAMES( I ), ' ... Yes' 01582 ELSE 01583 WRITE( NOUT, FMT = 9987 ) SNAMES( I ), ' ... No ' 01584 END IF 01585 90 CONTINUE 01586 WRITE( NOUT, FMT = * ) 01587 * 01588 ELSE 01589 * 01590 * If in pvm, must participate setting up virtual machine 01591 * 01592 IF( NPROCS.LT.1 ) 01593 $ CALL BLACS_SETUP( IAM, NPROCS ) 01594 * 01595 * Temporarily define blacs grid to include all processes so 01596 * information can be broadcast to all processes 01597 * 01598 CALL BLACS_GET( -1, 0, ICTXT ) 01599 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS ) 01600 * 01601 CALL ZGEBR2D( ICTXT, 'All', ' ', 1, 1, ALPHA, 1, 0, 0 ) 01602 CALL ZGEBR2D( ICTXT, 'All', ' ', 1, 1, BETA, 1, 0, 0 ) 01603 * 01604 CALL IGEBR2D( ICTXT, 'All', ' ', 3, 1, WORK, 3, 0, 0 ) 01605 NGRIDS = WORK( 1 ) 01606 NMAT = WORK( 2 ) 01607 NBLOG = WORK( 3 ) 01608 * 01609 I = 2*NGRIDS + 38*NMAT + NSUBS 01610 CALL IGEBR2D( ICTXT, 'All', ' ', I, 1, WORK, I, 0, 0 ) 01611 * 01612 I = 1 01613 DO 100 J = 1, NMAT 01614 DIAGVAL( J ) = CHAR( WORK( I ) ) 01615 SIDEVAL( J ) = CHAR( WORK( I+1 ) ) 01616 TRNAVAL( J ) = CHAR( WORK( I+2 ) ) 01617 TRNBVAL( J ) = CHAR( WORK( I+3 ) ) 01618 UPLOVAL( J ) = CHAR( WORK( I+4 ) ) 01619 I = I + 5 01620 100 CONTINUE 01621 CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 ) 01622 I = I + NGRIDS 01623 CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 ) 01624 I = I + NGRIDS 01625 CALL ICOPY( NMAT, WORK( I ), 1, MVAL, 1 ) 01626 I = I + NMAT 01627 CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 ) 01628 I = I + NMAT 01629 CALL ICOPY( NMAT, WORK( I ), 1, KVAL, 1 ) 01630 I = I + NMAT 01631 CALL ICOPY( NMAT, WORK( I ), 1, MAVAL, 1 ) 01632 I = I + NMAT 01633 CALL ICOPY( NMAT, WORK( I ), 1, NAVAL, 1 ) 01634 I = I + NMAT 01635 CALL ICOPY( NMAT, WORK( I ), 1, IMBAVAL, 1 ) 01636 I = I + NMAT 01637 CALL ICOPY( NMAT, WORK( I ), 1, INBAVAL, 1 ) 01638 I = I + NMAT 01639 CALL ICOPY( NMAT, WORK( I ), 1, MBAVAL, 1 ) 01640 I = I + NMAT 01641 CALL ICOPY( NMAT, WORK( I ), 1, NBAVAL, 1 ) 01642 I = I + NMAT 01643 CALL ICOPY( NMAT, WORK( I ), 1, RSCAVAL, 1 ) 01644 I = I + NMAT 01645 CALL ICOPY( NMAT, WORK( I ), 1, CSCAVAL, 1 ) 01646 I = I + NMAT 01647 CALL ICOPY( NMAT, WORK( I ), 1, IAVAL, 1 ) 01648 I = I + NMAT 01649 CALL ICOPY( NMAT, WORK( I ), 1, JAVAL, 1 ) 01650 I = I + NMAT 01651 CALL ICOPY( NMAT, WORK( I ), 1, MBVAL, 1 ) 01652 I = I + NMAT 01653 CALL ICOPY( NMAT, WORK( I ), 1, NBVAL, 1 ) 01654 I = I + NMAT 01655 CALL ICOPY( NMAT, WORK( I ), 1, IMBBVAL, 1 ) 01656 I = I + NMAT 01657 CALL ICOPY( NMAT, WORK( I ), 1, INBBVAL, 1 ) 01658 I = I + NMAT 01659 CALL ICOPY( NMAT, WORK( I ), 1, MBBVAL, 1 ) 01660 I = I + NMAT 01661 CALL ICOPY( NMAT, WORK( I ), 1, NBBVAL, 1 ) 01662 I = I + NMAT 01663 CALL ICOPY( NMAT, WORK( I ), 1, RSCBVAL, 1 ) 01664 I = I + NMAT 01665 CALL ICOPY( NMAT, WORK( I ), 1, CSCBVAL, 1 ) 01666 I = I + NMAT 01667 CALL ICOPY( NMAT, WORK( I ), 1, IBVAL, 1 ) 01668 I = I + NMAT 01669 CALL ICOPY( NMAT, WORK( I ), 1, JBVAL, 1 ) 01670 I = I + NMAT 01671 CALL ICOPY( NMAT, WORK( I ), 1, MCVAL, 1 ) 01672 I = I + NMAT 01673 CALL ICOPY( NMAT, WORK( I ), 1, NCVAL, 1 ) 01674 I = I + NMAT 01675 CALL ICOPY( NMAT, WORK( I ), 1, IMBCVAL, 1 ) 01676 I = I + NMAT 01677 CALL ICOPY( NMAT, WORK( I ), 1, INBCVAL, 1 ) 01678 I = I + NMAT 01679 CALL ICOPY( NMAT, WORK( I ), 1, MBCVAL, 1 ) 01680 I = I + NMAT 01681 CALL ICOPY( NMAT, WORK( I ), 1, NBCVAL, 1 ) 01682 I = I + NMAT 01683 CALL ICOPY( NMAT, WORK( I ), 1, RSCCVAL, 1 ) 01684 I = I + NMAT 01685 CALL ICOPY( NMAT, WORK( I ), 1, CSCCVAL, 1 ) 01686 I = I + NMAT 01687 CALL ICOPY( NMAT, WORK( I ), 1, ICVAL, 1 ) 01688 I = I + NMAT 01689 CALL ICOPY( NMAT, WORK( I ), 1, JCVAL, 1 ) 01690 I = I + NMAT 01691 * 01692 DO 110 J = 1, NSUBS 01693 IF( WORK( I ).EQ.1 ) THEN 01694 LTEST( J ) = .TRUE. 01695 ELSE 01696 LTEST( J ) = .FALSE. 01697 END IF 01698 I = I + 1 01699 110 CONTINUE 01700 * 01701 END IF 01702 * 01703 CALL BLACS_GRIDEXIT( ICTXT ) 01704 * 01705 RETURN 01706 * 01707 120 WRITE( NOUT, FMT = 9997 ) 01708 CLOSE( NIN ) 01709 IF( NOUT.NE.6 .AND. NOUT.NE.0 ) 01710 $ CLOSE( NOUT ) 01711 CALL BLACS_ABORT( ICTXT, 1 ) 01712 * 01713 STOP 01714 * 01715 9999 FORMAT( A ) 01716 9998 FORMAT( ' Number of values of ',5A, ' is less than 1 or greater ', 01717 $ 'than ', I2 ) 01718 9997 FORMAT( ' Illegal input in file ',40A,'. Aborting run.' ) 01719 9996 FORMAT( A7, L2 ) 01720 9995 FORMAT( ' Subprogram name ', A7, ' not recognized', 01721 $ /' ******* TESTS ABANDONED *******' ) 01722 9994 FORMAT( 2X, 'Alpha : (', G16.6, 01723 $ ',', G16.6, ')' ) 01724 9993 FORMAT( 2X, 'Beta : (', G16.6, 01725 $ ',', G16.6, ')' ) 01726 9992 FORMAT( 2X, 'Number of Tests : ', I6 ) 01727 9991 FORMAT( 2X, 'Number of process grids : ', I6 ) 01728 9990 FORMAT( 2X, ' : ', 5I6 ) 01729 9989 FORMAT( 2X, A1, ' : ', 5I6 ) 01730 9988 FORMAT( 2X, 'Routines to be tested : ', A, A8 ) 01731 9987 FORMAT( 2X, ' ', A, A8 ) 01732 9986 FORMAT( 2X, 'Logical block size : ', I6 ) 01733 * 01734 * End of PZBLA3TIMINFO 01735 * 01736 END
