|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
00001 SUBROUTINE PDHRDINFO( SUMMRY, NOUT, NMAT, NVAL, NVLO, NVHI, 00002 $ LDNVAL, NNB, NBVAL, LDNBVAL, NGRIDS, PVAL, 00003 $ LDPVAL, QVAL, LDQVAL, THRESH, WORK, IAM, 00004 $ NPROCS ) 00005 * 00006 * -- ScaLAPACK routine (version 1.7) -- 00007 * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 00008 * and University of California, Berkeley. 00009 * May 1, 1997 00010 * 00011 * .. Scalar Arguments .. 00012 INTEGER IAM, LDNBVAL, LDNVAL, LDPVAL, LDQVAL, 00013 $ NGRIDS, NMAT, NNB, NOUT, NPROCS 00014 REAL THRESH 00015 * .. 00016 * .. Array Arguments .. 00017 CHARACTER*( * ) SUMMRY 00018 INTEGER NBVAL( LDNBVAL ), NVAL( LDNVAL ), 00019 $ NVHI( LDNVAL ), NVLO( LDNVAL ), 00020 $ PVAL( LDPVAL ), QVAL( LDQVAL ), WORK( * ) 00021 * .. 00022 * 00023 * Purpose 00024 * ======= 00025 * 00026 * PDHRDINFO get the needed startup information for the Hessenberg 00027 * reduction tests and transmits it to all processes. 00028 * 00029 * Arguments 00030 * ========= 00031 * 00032 * SUMMRY (global output) CHARACTER*(*) 00033 * Name of output (summary) file (if any). Only defined for 00034 * process 0. 00035 * 00036 * NOUT (global output) INTEGER 00037 * The unit number for output file. NOUT = 6, output to screen, 00038 * NOUT = 0, output to stderr. Only defined for process 0. 00039 * 00040 * NMAT (global output) INTEGER 00041 * The number of different values that can be used for 00042 * N, IHI & ILO. 00043 * 00044 * NVAL (global output) INTEGER array, dimension (LDNVAL) 00045 * The values of N (number of rows & columns in matrix). 00046 * 00047 * NVLO (global output) INTEGER array, dimension (LDNVAL) 00048 * The values of ILO. 00049 * 00050 * NVHI (global output) INTEGER array, dimension (LDNVAL) 00051 * The values of IHI. 00052 * 00053 * LDNVAL (global input) INTEGER 00054 * The maximum number of different values that can be used for 00055 * N, ILO and IHI. LDNVAL >= NMAT. 00056 * 00057 * NNB (global output) INTEGER 00058 * The number of different values that can be used for NB. 00059 * 00060 * NBVAL (global output) INTEGER array, dimension (LDNBVAL) 00061 * The values of NB (blocksize) to run the code with. 00062 * 00063 * LDNBVAL (global input) INTEGER 00064 * The maximum number of different values that can be used for 00065 * NB, LDNBVAL >= NNB. 00066 * 00067 * NGRIDS (global output) INTEGER 00068 * The number of different values that can be used for P & Q. 00069 * 00070 * PVAL (global output) INTEGER array, dimension (LDPVAL) 00071 * The values of P (number of process rows) to run the code 00072 * with. 00073 * 00074 * LDPVAL (global input) INTEGER 00075 * The maximum number of different values that can be used for 00076 * P, LDPVAL >= NGRIDS. 00077 * 00078 * QVAL (global output) INTEGER array, dimension (LDQVAL) 00079 * The values of Q (number of process columns) to run the code 00080 * with. 00081 * 00082 * LDQVAL (global input) INTEGER 00083 * The maximum number of different values that can be used for 00084 * Q, LDQVAL >= NGRIDS. 00085 * 00086 * THRESH (global output) REAL 00087 * Indicates what error checks shall be run and printed out: 00088 * = 0 : Perform no error checking 00089 * > 0 : report all residuals greater than THRESH. 00090 * 00091 * WORK (local workspace) INTEGER array, dimension >= 00092 * 3*LDNVAL+LDNBVAL+2*LDPVAL. Used to pack all input arrays 00093 * in order to send info in one message. 00094 * 00095 * IAM (local input) INTEGER 00096 * My process number. 00097 * 00098 * NPROCS (global input) INTEGER 00099 * The total number of processes. 00100 * 00101 * Note 00102 * ==== 00103 * 00104 * For packing the information we assumed that the length in bytes of an 00105 * integer is equal to the length in bytes of a real single precision. 00106 * 00107 * ===================================================================== 00108 * 00109 * .. Parameters .. 00110 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, 00111 $ LLD_, MB_, M_, NB_, N_, RSRC_ 00112 PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, 00113 $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, 00114 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) 00115 INTEGER NIN 00116 PARAMETER ( NIN = 11 ) 00117 * .. 00118 * .. Local Scalars .. 00119 CHARACTER*79 USRINFO 00120 INTEGER I, ICTXT 00121 DOUBLE PRECISION EPS 00122 * .. 00123 * .. External Subroutines .. 00124 EXTERNAL BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT, 00125 $ BLACS_GRIDINIT, BLACS_SETUP, ICOPY, IGEBR2D, 00126 $ IGEBS2D, SGEBR2D, SGEBS2D 00127 * .. 00128 * .. External Functions .. 00129 DOUBLE PRECISION PDLAMCH 00130 EXTERNAL PDLAMCH 00131 * .. 00132 * .. Intrinsic Functions .. 00133 INTRINSIC MAX, MIN 00134 * .. 00135 * .. Executable Statements .. 00136 * 00137 * Process 0 reads the input data, broadcasts to other processes and 00138 * writes needed information to NOUT 00139 * 00140 IF( IAM.EQ.0 ) THEN 00141 * 00142 * Open file and skip data file header 00143 * 00144 OPEN( UNIT = NIN, FILE = 'HRD.dat', STATUS = 'OLD' ) 00145 READ( NIN, FMT = * )SUMMRY 00146 SUMMRY = ' ' 00147 * 00148 * Read in user-supplied info about machine type, compiler, etc. 00149 * 00150 READ( NIN, FMT = * ) USRINFO 00151 * 00152 * Read name and unit number for summary output file 00153 * 00154 READ( NIN, FMT = * ) SUMMRY 00155 READ( NIN, FMT = * ) NOUT 00156 IF( NOUT.NE.0 .AND. NOUT.NE.6 ) 00157 $ OPEN( UNIT = NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' ) 00158 * 00159 * Read and check the parameter values for the tests. 00160 * 00161 * Get number of matrices 00162 * 00163 READ( NIN, FMT = * ) NMAT 00164 IF( NMAT.LT.1. .OR. NMAT.GT.LDNVAL ) THEN 00165 WRITE( NOUT, FMT = 9997 ) 'N', LDNVAL 00166 GO TO 20 00167 END IF 00168 * 00169 * Get values of N, ILO, IHI 00170 * 00171 READ( NIN, FMT = * ) ( NVAL( I ), I = 1, NMAT ) 00172 READ( NIN, FMT = * ) ( NVLO( I ), I = 1, NMAT ) 00173 READ( NIN, FMT = * ) ( NVHI( I ), I = 1, NMAT ) 00174 * 00175 * Get values of NB 00176 * 00177 READ( NIN, FMT = * ) NNB 00178 IF( NNB.LT.1 .OR. NNB.GT.LDNBVAL ) THEN 00179 WRITE( NOUT, FMT = 9997 ) 'NB', LDNBVAL 00180 GO TO 20 00181 END IF 00182 READ( NIN, FMT = * ) ( NBVAL( I ), I = 1, NNB ) 00183 * 00184 * Get number of grids 00185 * 00186 READ( NIN, FMT = * ) NGRIDS 00187 IF( NGRIDS.LT.1 .OR. NGRIDS.GT.LDPVAL ) THEN 00188 WRITE( NOUT, FMT = 9997 ) 'Grids', LDPVAL 00189 GO TO 20 00190 ELSE IF( NGRIDS.GT.LDQVAL ) THEN 00191 WRITE( NOUT, FMT = 9997 ) 'Grids', LDQVAL 00192 GO TO 20 00193 END IF 00194 * 00195 * Get values of P and Q 00196 * 00197 READ( NIN, FMT = * ) ( PVAL( I ), I = 1, NGRIDS ) 00198 READ( NIN, FMT = * ) ( QVAL( I ), I = 1, NGRIDS ) 00199 * 00200 * Get level of checking 00201 * 00202 READ( NIN, FMT = * ) THRESH 00203 * 00204 * Close input file 00205 * 00206 CLOSE( NIN ) 00207 * 00208 * For pvm only: if virtual machine not set up, allocate it and 00209 * spawn the correct number of processes. 00210 * 00211 IF( NPROCS.LT.1 ) THEN 00212 NPROCS = 0 00213 DO 10 I = 1, NGRIDS 00214 NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) ) 00215 10 CONTINUE 00216 CALL BLACS_SETUP( IAM, NPROCS ) 00217 END IF 00218 * 00219 * Temporarily define blacs grid to include all processes so 00220 * information can be broadcast to all processes 00221 * 00222 CALL BLACS_GET( -1, 0, ICTXT ) 00223 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS ) 00224 * 00225 * Compute machine epsilon 00226 * 00227 EPS = PDLAMCH( ICTXT, 'eps' ) 00228 * 00229 * Pack information arrays and broadcast 00230 * 00231 CALL SGEBS2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1 ) 00232 * 00233 WORK( 1 ) = NMAT 00234 WORK( 2 ) = NNB 00235 WORK( 3 ) = NGRIDS 00236 CALL IGEBS2D( ICTXT, 'All', ' ', 1, 3, WORK, 1 ) 00237 * 00238 I = 1 00239 CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 ) 00240 I = I + NMAT 00241 CALL ICOPY( NMAT, NVLO, 1, WORK( I ), 1 ) 00242 I = I + NMAT 00243 CALL ICOPY( NMAT, NVHI, 1, WORK( I ), 1 ) 00244 I = I + NMAT 00245 CALL ICOPY( NNB, NBVAL, 1, WORK( I ), 1 ) 00246 I = I + NNB 00247 CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 ) 00248 I = I + NGRIDS 00249 CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 ) 00250 I = I + NGRIDS -1 00251 CALL IGEBS2D( ICTXT, 'All', ' ', 1, I, WORK, 1 ) 00252 * 00253 * regurgitate input 00254 * 00255 WRITE( NOUT, FMT = 9999 ) 00256 $ 'ScaLAPACK Reduction routine to Hessenberg form.' 00257 WRITE( NOUT, FMT = 9999 ) USRINFO 00258 WRITE( NOUT, FMT = * ) 00259 WRITE( NOUT, FMT = 9999 ) 00260 $ 'Tests of the parallel '// 00261 $ 'real double precision Hessenberg ' 00262 WRITE( NOUT, FMT = 9999 ) 'reduction routines.' 00263 WRITE( NOUT, FMT = 9999 ) 00264 $ 'The following scaled residual '// 00265 $ 'checks will be computed:' 00266 WRITE( NOUT, FMT = 9999 ) 00267 $ ' ||A - Q H Q''|| / (||A|| * eps * N)' 00268 WRITE( NOUT, FMT = 9999 ) 00269 $ 'The matrix A is randomly '// 00270 $ 'generated for each test.' 00271 WRITE( NOUT, FMT = * ) 00272 WRITE( NOUT, FMT = 9999 ) 00273 $ 'An explanation of the input/output '// 00274 $ 'parameters follows:' 00275 WRITE( NOUT, FMT = 9999 ) 00276 $ 'TIME : Indicates whether WALL or '// 00277 $ 'CPU time was used.' 00278 WRITE( NOUT, FMT = 9999 ) 00279 $ 'N : The number of rows and columns '// 00280 $ 'of the matrix A.' 00281 WRITE( NOUT, FMT = 9999 ) 00282 $ 'NB : The size of the square blocks'// 00283 $ ' the matrix A is split into.' 00284 WRITE( NOUT, FMT = 9999 ) 00285 $ ' on to the next column of processes.' 00286 WRITE( NOUT, FMT = 9999 ) 00287 $ 'P : The number of process rows.' 00288 WRITE( NOUT, FMT = 9999 ) 00289 $ 'Q : The number of process columns.' 00290 WRITE( NOUT, FMT = 9999 ) 00291 $ 'HRD time : Time in seconds to compute HRD ' 00292 WRITE( NOUT, FMT = 9999 ) 00293 $ 'MFLOPS : Rate of execution for HRD ' // 00294 $ 'reduction.' 00295 WRITE( NOUT, FMT = * ) 00296 WRITE( NOUT, FMT = 9999 ) 00297 $ 'The following parameter values will be used:' 00298 WRITE( NOUT, FMT = 9995 ) 00299 $ 'N ', ( NVAL( I ), I = 1, MIN( NMAT, 10 ) ) 00300 IF( NMAT.GT.10 ) 00301 $ WRITE( NOUT, FMT = 9994 ) ( NVAL( I ), I = 11, NMAT ) 00302 WRITE( NOUT, FMT = 9995 ) 00303 $ 'ILO ', ( NVLO( I ), I = 1, MIN( NMAT, 10 ) ) 00304 IF( NMAT.GT.10 ) 00305 $ WRITE( NOUT, FMT = 9994 ) ( NVLO( I ), I = 11, NMAT ) 00306 WRITE( NOUT, FMT = 9995 ) 00307 $ 'IHI ', ( NVHI( I ), I = 1, MIN( NMAT, 10 ) ) 00308 IF( NMAT.GT.10 ) 00309 $ WRITE( NOUT, FMT = 9994 ) ( NVHI( I ), I = 11, NMAT ) 00310 WRITE( NOUT, FMT = 9995 ) 00311 $ 'NB ', ( NBVAL( I ), I = 1, MIN( NNB, 10 ) ) 00312 IF( NNB.GT.10 ) 00313 $ WRITE( NOUT, FMT = 9994 ) ( NBVAL( I ), I = 11, NNB ) 00314 WRITE( NOUT, FMT = 9995 ) 00315 $ 'P ', ( PVAL( I ), I = 1, MIN( NGRIDS, 10 ) ) 00316 IF( NGRIDS.GT.10 ) 00317 $ WRITE( NOUT, FMT = 9994 ) ( PVAL( I ), I = 11, NGRIDS ) 00318 WRITE( NOUT, FMT = 9995 ) 00319 $ 'Q ', ( QVAL( I ), I = 1, MIN( NGRIDS, 10 ) ) 00320 IF( NGRIDS.GT.10 ) 00321 $ WRITE( NOUT, FMT = 9994 ) ( QVAL( I ), I = 11, NGRIDS ) 00322 WRITE( NOUT, FMT = * ) 00323 WRITE( NOUT, FMT = 9996 ) EPS 00324 WRITE( NOUT, FMT = 9993 ) THRESH 00325 * 00326 ELSE 00327 * 00328 * If in pvm, must participate setting up virtual machine 00329 * 00330 IF( NPROCS.LT.1 ) 00331 $ CALL BLACS_SETUP( IAM, NPROCS ) 00332 * 00333 * Temporarily define blacs grid to include all processes so 00334 * all processes have needed startup information 00335 * 00336 CALL BLACS_GET( -1, 0, ICTXT ) 00337 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS ) 00338 * 00339 * Compute machine epsilon 00340 * 00341 EPS = PDLAMCH( ICTXT, 'eps' ) 00342 * 00343 CALL SGEBR2D( ICTXT, 'All', ' ', 1, 1, THRESH, 1, 0, 0 ) 00344 CALL IGEBR2D( ICTXT, 'All', ' ', 1, 3, WORK, 1, 0, 0 ) 00345 NMAT = WORK( 1 ) 00346 NNB = WORK( 2 ) 00347 NGRIDS = WORK( 3 ) 00348 * 00349 I = 3*NMAT + NNB + 2*NGRIDS 00350 CALL IGEBR2D( ICTXT, 'All', ' ', 1, I, WORK, 1, 0, 0 ) 00351 * 00352 I = 1 00353 CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 ) 00354 I = I + NMAT 00355 CALL ICOPY( NMAT, WORK( I ), 1, NVLO, 1 ) 00356 I = I + NMAT 00357 CALL ICOPY( NMAT, WORK( I ), 1, NVHI, 1 ) 00358 I = I + NMAT 00359 CALL ICOPY( NNB, WORK( I ), 1, NBVAL, 1 ) 00360 I = I + NNB 00361 CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 ) 00362 I = I + NGRIDS 00363 CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 ) 00364 * 00365 END IF 00366 * 00367 CALL BLACS_GRIDEXIT( ICTXT ) 00368 * 00369 RETURN 00370 * 00371 20 CONTINUE 00372 WRITE( NOUT, FMT = 9998 ) 00373 CLOSE( NIN ) 00374 IF( NOUT.NE.6 .AND. NOUT.NE.0 ) 00375 $ CLOSE( NOUT ) 00376 CALL BLACS_ABORT( ICTXT, 1 ) 00377 * 00378 STOP 00379 * 00380 9999 FORMAT( A ) 00381 9998 FORMAT( ' ILLEGAL INPUT IN FILE ', 40A, '. ABORTING RUN.' ) 00382 9997 FORMAT( ' NUMBER OF VALUES OF ', 5A, 00383 $ ' IS LESS THAN 1 OR GREATER ', 'THAN ', I2 ) 00384 9996 FORMAT( 'Relative machine precision (eps) is taken to be ', 00385 $ E18.6 ) 00386 9995 FORMAT( 2X, A5, ': ', 10I6 ) 00387 9994 FORMAT( ' ', 10I6 ) 00388 9993 FORMAT( 'Routines pass computational tests if scaled residual is', 00389 $ ' less than ', G14.7 ) 00390 * 00391 * End of PDHRDINFO 00392 * 00393 END
