|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
00001 SUBROUTINE PZLLTINFO( SUMMRY, NOUT, UPLO, NMAT, NVAL, LDNVAL, NNB, 00002 $ NBVAL, LDNBVAL, NNR, NRVAL, LDNRVAL, NNBR, 00003 $ NBRVAL, LDNBRVAL, NGRIDS, PVAL, LDPVAL, 00004 $ QVAL, LDQVAL, THRESH, EST, WORK, IAM, 00005 $ NPROCS ) 00006 * 00007 * -- ScaLAPACK routine (version 1.7) -- 00008 * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 00009 * and University of California, Berkeley. 00010 * May 1, 1997 00011 * 00012 * .. Scalar Arguments .. 00013 LOGICAL EST 00014 CHARACTER UPLO 00015 CHARACTER*(*) SUMMRY 00016 INTEGER IAM, LDNBRVAL, LDNBVAL, LDNRVAL, LDNVAL, 00017 $ LDPVAL, LDQVAL, NGRIDS, NMAT, NNB, NNBR, 00018 $ NPROCS, NNR, NOUT 00019 REAL THRESH 00020 * .. 00021 * .. Array Arguments .. 00022 INTEGER NBRVAL( LDNBRVAL ), NBVAL( LDNBVAL ), 00023 $ NRVAL( LDNRVAL ), NVAL( LDNVAL ), 00024 $ PVAL( LDPVAL ), QVAL(LDQVAL), WORK( * ) 00025 * .. 00026 * 00027 * Purpose 00028 * ======= 00029 * 00030 * PZLLTINFO get needed startup information for LLt factorization 00031 * and transmits it to all processes. 00032 * 00033 * Arguments 00034 * ========= 00035 * 00036 * SUMMRY (global output) CHARACTER*(*) 00037 * Name of output (summary) file (if any). Only defined for 00038 * process 0. 00039 * 00040 * NOUT (global output) INTEGER 00041 * The unit number for output file. NOUT = 6, ouput to screen, 00042 * NOUT = 0, output to stderr. Only defined for process 0. 00043 * 00044 * UPLO (global output) CHARACTER 00045 * Specifies whether the upper or lower triangular part of the 00046 * symmetric matrix A is stored. 00047 * = 'U': Upper triangular 00048 * = 'L': Lower triangular 00049 * 00050 * NMAT (global output) INTEGER 00051 * The number of different values that can be used for N. 00052 * 00053 * NVAL (global output) INTEGER array, dimension (LDNVAL) 00054 * The values of N (number of columns in matrix) to run the 00055 * code with. 00056 * 00057 * LDNVAL (global input) INTEGER 00058 * The maximum number of different values that can be used for 00059 * N, LDNVAL > = NMAT. 00060 * 00061 * NNB (global output) INTEGER 00062 * The number of different values that can be used for NB. 00063 * 00064 * NBVAL (global output) INTEGER array, dimension (LDNBVAL) 00065 * The values of NB (blocksize) to run the code with. 00066 * 00067 * LDNBVAL (global input) INTEGER 00068 * The maximum number of different values that can be used for 00069 * NB, LDNBVAL >= NNB. 00070 * 00071 * NNR (global output) INTEGER 00072 * The number of different values that can be used for NRHS. 00073 * 00074 * NRVAL (global output) INTEGER array, dimension(LDNRVAL) 00075 * The values of NRHS (# of Right Hand Sides) to run the code 00076 * with. 00077 * 00078 * LDNRVAL (global input) INTEGER 00079 * The maximum number of different values that can be used for 00080 * NRHS, LDNRVAL >= NNR. 00081 * 00082 * NNBR (global output) INTEGER 00083 * The number of different values that can be used for NBRHS. 00084 * 00085 * NBRVAL (global output) INTEGER array, dimension (LDNBRVAL) 00086 * The values of NBRHS (RHS blocksize) to run the code with. 00087 * 00088 * LDNBRVAL (global input) INTEGER 00089 * The maximum number of different values that can be used for 00090 * NBRHS, LDNBRVAL >= NBRVAL. 00091 * 00092 * NGRIDS (global output) INTEGER 00093 * The number of different values that can be used for P & Q. 00094 * 00095 * PVAL (global output) INTEGER array, dimension (LDPVAL) 00096 * The values of P (number of process rows) to run the code 00097 * with. 00098 * 00099 * LDPVAL (global input) INTEGER 00100 * The maximum number of different values that can be used for 00101 * P, LDPVAL >= NGRIDS. 00102 * 00103 * QVAL (global output) INTEGER array, dimension (LDQVAL) 00104 * The values of Q (number of process columns) to run the code 00105 * with. 00106 * 00107 * LDQVAL (global input) INTEGER 00108 * The maximum number of different values that can be used for 00109 * Q, LDQVAL >= NGRIDS. 00110 * 00111 * THRESH (global output) REAL 00112 * Indicates what error checks shall be run and printed out: 00113 * = 0 : Perform no error checking 00114 * > 0 : report all residuals greater than THRESH, perform 00115 * factor check only if solve check fails 00116 * 00117 * EST (global output) LOGICAL 00118 * Flag indicating if condition estimation and iterative 00119 * refinement routines are to be exercised. 00120 * 00121 * WORK (local workspace) INTEGER array of dimension >= 00122 * MAX( 7, LDNVAL+LDNBVAL+LDNRVAL+LDNBRVAL+LDPVAL+LDQVAL) 00123 * Used to pack input arrays in order to send info in one 00124 * message. 00125 * 00126 * IAM (local input) INTEGER 00127 * My process number. 00128 * 00129 * NPROCS (global input) INTEGER 00130 * The total number of processes. 00131 * 00132 * ====================================================================== 00133 * 00134 * Note: For packing the information we assumed that the length in bytes 00135 * ===== of an integer is equal to the length in bytes of a real single 00136 * precision. 00137 * 00138 * ====================================================================== 00139 * 00140 * .. Parameters .. 00141 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, 00142 $ LLD_, MB_, M_, NB_, N_, RSRC_ 00143 PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, 00144 $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, 00145 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) 00146 INTEGER NIN 00147 PARAMETER ( NIN = 11 ) 00148 * .. 00149 * .. Local Scalars .. 00150 INTEGER I, ICTXT 00151 CHARACTER*79 USRINFO 00152 DOUBLE PRECISION EPS 00153 * .. 00154 * .. External Subroutines .. 00155 EXTERNAL BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT, 00156 $ BLACS_GRIDINIT, BLACS_SETUP, ICOPY, IGEBR2D, 00157 $ IGEBS2D, SGEBR2D, SGEBS2D 00158 * .. 00159 * .. External Functions .. 00160 LOGICAL LSAME 00161 DOUBLE PRECISION PDLAMCH 00162 EXTERNAL LSAME, PDLAMCH 00163 * .. 00164 * .. Intrinsic Functions .. 00165 INTRINSIC MAX, MIN 00166 * .. 00167 * .. Executable Statements .. 00168 * 00169 * Process 0 reads the input data, broadcasts to other processes and 00170 * writes needed information to NOUT 00171 * 00172 IF( IAM.EQ.0 ) THEN 00173 * 00174 * Open file and skip data file header 00175 * 00176 OPEN( NIN, FILE = 'LLT.dat', STATUS = 'OLD' ) 00177 READ( NIN, FMT = * ) SUMMRY 00178 SUMMRY = ' ' 00179 * 00180 * Read in user-supplied info about machine type, compiler, etc. 00181 * 00182 READ( NIN, FMT = 9999 ) USRINFO 00183 * 00184 * Read name and unit number for summary output file 00185 * 00186 READ( NIN, FMT = * ) SUMMRY 00187 READ( NIN, FMT = * ) NOUT 00188 IF( NOUT.NE.0 .AND. NOUT.NE.6 ) 00189 $ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' ) 00190 * 00191 * Read and check the parameter values for the tests. 00192 * 00193 * Get UPLO 00194 * 00195 READ( NIN, FMT = * ) UPLO 00196 * 00197 * Get number of matrices and their dimensions 00198 * 00199 READ( NIN, FMT = * ) NMAT 00200 IF( NMAT.LT.1 .OR. NMAT.GT.LDNVAL ) THEN 00201 WRITE( NOUT, FMT = 9994 ) 'N', LDNVAL 00202 GO TO 20 00203 END IF 00204 READ( NIN, FMT = * ) ( NVAL( I ), I = 1, NMAT ) 00205 * 00206 * Get values of NB 00207 * 00208 READ( NIN, FMT = * ) NNB 00209 IF( NNB.LT.1 .OR. NNB.GT.LDNBVAL ) THEN 00210 WRITE( NOUT, FMT = 9994 ) 'NB', LDNBVAL 00211 GO TO 20 00212 END IF 00213 READ( NIN, FMT = * ) ( NBVAL( I ), I = 1, NNB ) 00214 * 00215 * Get values of NRHS 00216 * 00217 READ( NIN, FMT = * ) NNR 00218 IF( NNR.LT.1 .OR. NNR.GT.LDNRVAL ) THEN 00219 WRITE( NOUT, FMT = 9994 ) 'NRHS', LDNRVAL 00220 GO TO 20 00221 END IF 00222 READ( NIN, FMT = * ) ( NRVAL( I ), I = 1, NNR ) 00223 * 00224 * Get values of NBRHS 00225 * 00226 READ( NIN, FMT = * ) NNBR 00227 IF( NNBR.LT.1 .OR. NNBR.GT.LDNBRVAL ) THEN 00228 WRITE( NOUT, FMT = 9994 ) 'NBRHS', LDNBRVAL 00229 GO TO 20 00230 END IF 00231 READ( NIN, FMT = * ) ( NBRVAL( I ), I = 1, NNBR ) 00232 * 00233 * Get number of grids 00234 * 00235 READ( NIN, FMT = * ) NGRIDS 00236 IF( NGRIDS.LT.1 .OR. NGRIDS.GT.LDPVAL ) THEN 00237 WRITE( NOUT, FMT = 9994 ) 'Grids', LDPVAL 00238 GO TO 20 00239 ELSE IF( NGRIDS.GT.LDQVAL ) THEN 00240 WRITE( NOUT, FMT = 9994 ) 'Grids', LDQVAL 00241 GO TO 20 00242 END IF 00243 * 00244 * Get values of P and Q 00245 * 00246 READ( NIN, FMT = * ) ( PVAL( I ), I = 1, NGRIDS ) 00247 READ( NIN, FMT = * ) ( QVAL( I ), I = 1, NGRIDS ) 00248 * 00249 * Get level of checking 00250 * 00251 READ( NIN, FMT = * ) THRESH 00252 * 00253 * Read the flag that indicates whether to test the condition 00254 * estimation and iterative refinement routines. 00255 * 00256 READ( NIN, FMT = * ) EST 00257 * 00258 * Close input file 00259 * 00260 CLOSE( NIN ) 00261 * 00262 * For pvm only: if virtual machine not set up, allocate it and 00263 * spawn the correct number of processes. 00264 * 00265 IF( NPROCS.LT.1 ) THEN 00266 NPROCS = 0 00267 DO 10 I = 1, NGRIDS 00268 NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) ) 00269 10 CONTINUE 00270 CALL BLACS_SETUP( IAM, NPROCS ) 00271 END IF 00272 * 00273 * Temporarily define blacs grid to include all processes so 00274 * information can be broadcast to all processes. 00275 * 00276 CALL BLACS_GET( -1, 0, ICTXT ) 00277 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS ) 00278 * 00279 * Compute machine epsilon 00280 * 00281 EPS = PDLAMCH( ICTXT, 'eps' ) 00282 * 00283 * Pack information arrays and broadcast 00284 * 00285 CALL SGEBS2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1 ) 00286 WORK( 1 ) = NMAT 00287 WORK( 2 ) = NNB 00288 WORK( 3 ) = NNR 00289 WORK( 4 ) = NNBR 00290 WORK( 5 ) = NGRIDS 00291 IF( LSAME( UPLO, 'L' ) ) THEN 00292 WORK( 6 ) = 1 00293 ELSE 00294 WORK( 6 ) = 2 00295 END IF 00296 IF( EST ) THEN 00297 WORK( 7 ) = 1 00298 ELSE 00299 WORK( 7 ) = 0 00300 END IF 00301 CALL IGEBS2D( ICTXT, 'All', ' ', 7, 1, WORK, 7 ) 00302 * 00303 I = 1 00304 CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 ) 00305 I = I + NMAT 00306 CALL ICOPY( NNB, NBVAL, 1, WORK( I ), 1 ) 00307 I = I + NNB 00308 CALL ICOPY( NNR, NRVAL, 1, WORK( I ), 1 ) 00309 I = I + NNR 00310 CALL ICOPY( NNBR, NBRVAL, 1, WORK( I ), 1 ) 00311 I = I + NNBR 00312 CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 ) 00313 I = I + NGRIDS 00314 CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 ) 00315 I = I + NGRIDS - 1 00316 CALL IGEBS2D( ICTXT, 'All', ' ', I, 1, WORK, I ) 00317 * 00318 * regurgitate input 00319 * 00320 WRITE( NOUT, FMT = 9999 ) 00321 $ 'SCALAPACK Ax=b by LLt factorization.' 00322 WRITE( NOUT, FMT = 9999 ) USRINFO 00323 WRITE( NOUT, FMT = * ) 00324 WRITE( NOUT, FMT = 9999 ) 00325 $ 'Tests of the parallel '// 00326 $ 'complex single precision LLt factorization '// 00327 $ 'and solve.' 00328 WRITE( NOUT, FMT = 9999 ) 00329 $ 'The following scaled residual '// 00330 $ 'checks will be computed:' 00331 WRITE( NOUT, FMT = 9999 ) 00332 $ ' Solve residual = ||Ax - b|| / '// 00333 $ '(||x|| * ||A|| * eps * N)' 00334 IF( LSAME( UPLO, 'L' ) ) THEN 00335 WRITE( NOUT, FMT = 9999 ) 00336 $ ' Factorization residual = ||A - LL''|| /'// 00337 $ ' (||A|| * eps * N)' 00338 ELSE 00339 WRITE( NOUT, FMT = 9999 ) 00340 $ ' Factorization residual = ||A - U''U|| /'// 00341 $ ' (||A|| * eps * N)' 00342 END IF 00343 WRITE( NOUT, FMT = 9999 ) 00344 $ 'The matrix A is randomly '// 00345 $ 'generated for each test.' 00346 WRITE( NOUT, FMT = * ) 00347 WRITE( NOUT, FMT = 9999 ) 00348 $ 'An explanation of the input/output '// 00349 $ 'parameters follows:' 00350 WRITE( NOUT, FMT = 9999 ) 00351 $ 'TIME : Indicates whether WALL or '// 00352 $ 'CPU time was used.' 00353 * 00354 WRITE( NOUT, FMT = 9999 ) 00355 $ 'UPLO : Whether data is stored in ''Upper'// 00356 $ ''' or ''Lower'' portion of array A.' 00357 WRITE( NOUT, FMT = 9999 ) 00358 $ 'N : The number of rows and columns '// 00359 $ 'in the matrix A.' 00360 WRITE( NOUT, FMT = 9999 ) 00361 $ 'NB : The size of the square blocks the'// 00362 $ ' matrix A is split into.' 00363 WRITE( NOUT, FMT = 9999 ) 00364 $ 'NRHS : The total number of RHS to solve'// 00365 $ ' for.' 00366 WRITE( NOUT, FMT = 9999 ) 00367 $ 'NBRHS : The number of RHS to be put on '// 00368 $ 'a column of processes before going' 00369 WRITE( NOUT, FMT = 9999 ) 00370 $ ' on to the next column of processes.' 00371 WRITE( NOUT, FMT = 9999 ) 00372 $ 'P : The number of process rows.' 00373 WRITE( NOUT, FMT = 9999 ) 00374 $ 'Q : The number of process columns.' 00375 WRITE( NOUT, FMT = 9999 ) 00376 $ 'THRESH : If a residual value is less than'// 00377 $ ' THRESH, CHECK is flagged as PASSED' 00378 WRITE( NOUT, FMT = 9999 ) 00379 $ 'LLt time: Time in seconds to factor the'// 00380 $ ' matrix' 00381 WRITE( NOUT, FMT = 9999 ) 00382 $ 'Sol Time: Time in seconds to solve the'// 00383 $ ' system.' 00384 WRITE( NOUT, FMT = 9999 ) 00385 $ 'MFLOPS : Rate of execution for factor '// 00386 $ 'and solve.' 00387 WRITE( NOUT, FMT = * ) 00388 WRITE( NOUT, FMT = 9999 ) 00389 $ 'The following parameter values will be used:' 00390 WRITE( NOUT, FMT = 9999 ) 00391 $ ' UPLO : '//UPLO 00392 WRITE( NOUT, FMT = 9996 ) 00393 $ 'N ', ( NVAL(I), I = 1, MIN(NMAT, 10) ) 00394 IF( NMAT.GT.10 ) 00395 $ WRITE( NOUT, FMT = 9997 ) ( NVAL(I), I = 11, NMAT ) 00396 WRITE( NOUT, FMT = 9996 ) 00397 $ 'NB ', ( NBVAL(I), I = 1, MIN(NNB, 10) ) 00398 IF( NNB.GT.10 ) 00399 $ WRITE( NOUT, FMT = 9997 ) ( NBVAL(I), I = 11, NNB ) 00400 WRITE( NOUT, FMT = 9996 ) 00401 $ 'NRHS ', ( NRVAL(I), I = 1, MIN(NNR, 10) ) 00402 IF( NNR.GT.10 ) 00403 $ WRITE( NOUT, FMT = 9997 ) ( NRVAL(I), I = 11, NNR ) 00404 WRITE( NOUT, FMT = 9996 ) 00405 $ 'NBRHS', ( NBRVAL(I), I = 1, MIN(NNBR, 10) ) 00406 IF( NNBR.GT.10 ) 00407 $ WRITE( NOUT, FMT = 9997 ) ( NBRVAL(I), I = 11, NNBR ) 00408 WRITE( NOUT, FMT = 9996 ) 00409 $ 'P ', ( PVAL(I), I = 1, MIN(NGRIDS, 10) ) 00410 IF( NGRIDS.GT.10 ) 00411 $ WRITE( NOUT, FMT = 9997) ( PVAL(I), I = 11, NGRIDS ) 00412 WRITE( NOUT, FMT = 9996 ) 00413 $ 'Q ', ( QVAL(I), I = 1, MIN(NGRIDS, 10) ) 00414 IF( NGRIDS.GT.10 ) 00415 $ WRITE( NOUT, FMT = 9997 ) ( QVAL(I), I = 11, NGRIDS ) 00416 WRITE( NOUT, FMT = * ) 00417 WRITE( NOUT, FMT = 9995 ) EPS 00418 WRITE( NOUT, FMT = 9998 ) THRESH 00419 * 00420 ELSE 00421 * 00422 * If in pvm, must participate setting up virtual machine 00423 * 00424 IF( NPROCS.LT.1 ) 00425 $ CALL BLACS_SETUP( IAM, NPROCS ) 00426 * 00427 * Temporarily define blacs grid to include all processes so 00428 * all processes have needed startup information 00429 * 00430 CALL BLACS_GET( -1, 0, ICTXT ) 00431 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS ) 00432 * 00433 * Compute machine epsilon 00434 * 00435 EPS = PDLAMCH( ICTXT, 'eps' ) 00436 * 00437 CALL SGEBR2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1, 0, 0 ) 00438 CALL IGEBR2D( ICTXT, 'All', ' ', 7, 1, WORK, 7, 0, 0 ) 00439 NMAT = WORK( 1 ) 00440 NNB = WORK( 2 ) 00441 NNR = WORK( 3 ) 00442 NNBR = WORK( 4 ) 00443 NGRIDS = WORK( 5 ) 00444 IF( WORK( 6 ).EQ.1 ) THEN 00445 UPLO = 'L' 00446 ELSE 00447 UPLO = 'U' 00448 END IF 00449 IF( WORK( 7 ).EQ.1 ) THEN 00450 EST = .TRUE. 00451 ELSE 00452 EST = .FALSE. 00453 END IF 00454 * 00455 I = NMAT + NNB + NNR + NNBR + 2*NGRIDS 00456 CALL IGEBR2D( ICTXT, 'All', ' ', 1, I, WORK, 1, 0, 0 ) 00457 I = 1 00458 CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 ) 00459 I = I + NMAT 00460 CALL ICOPY( NNB, WORK( I ), 1, NBVAL, 1 ) 00461 I = I + NNB 00462 CALL ICOPY( NNR, WORK( I ), 1, NRVAL, 1 ) 00463 I = I + NNR 00464 CALL ICOPY( NNBR, WORK( I ), 1, NBRVAL, 1 ) 00465 I = I + NNBR 00466 CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 ) 00467 I = I + NGRIDS 00468 CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 ) 00469 * 00470 END IF 00471 * 00472 CALL BLACS_GRIDEXIT( ICTXT ) 00473 * 00474 RETURN 00475 * 00476 20 WRITE( NOUT, FMT = 9993 ) 00477 CLOSE( NIN ) 00478 IF( NOUT.NE.6 .AND. NOUT.NE.0 ) 00479 $ CLOSE( NOUT ) 00480 CALL BLACS_ABORT( ICTXT, 1 ) 00481 STOP 00482 * 00483 9999 FORMAT( A ) 00484 9998 FORMAT( 'Routines pass computational tests if scaled residual ', 00485 $ 'is less than ', G12.5 ) 00486 9997 FORMAT( ' ', 10I6 ) 00487 9996 FORMAT( 2X, A5, ': ', 10I6 ) 00488 9995 FORMAT( 'Relative machine precision (eps) is taken to be ', 00489 $ E18.6 ) 00490 9994 FORMAT( ' Number of values of ',5A, ' is less than 1 or greater ', 00491 $ 'than ', I2 ) 00492 9993 FORMAT( ' Illegal input in file ',40A,'. Aborting run.' ) 00493 * 00494 * End of PZLLTINFO 00495 * 00496 END
