|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
00001 SUBROUTINE PDSEPRTST(DESCA, UPLO, N, MATTYPE, SUBTESTS, THRESH, 00002 $ ORDER, ABSTOL, ISEED, A, COPYA, Z, LDA, WIN, 00003 $ WNEW, IFAIL, ICLUSTR, GAP, IPREPAD, IPOSTPAD, 00004 $ WORK, LWORK, 00005 $ IWORK, LIWORK, HETERO, NOUT, INFO ) 00006 * 00007 * -- ScaLAPACK routine (@(MODE)version *TBA*) -- 00008 * University of California, Berkeley and 00009 * University of Tennessee, Knoxville. 00010 * October 21, 2006 00011 * 00012 IMPLICIT NONE 00013 * 00014 * .. Scalar Arguments .. 00015 CHARACTER HETERO, SUBTESTS, UPLO 00016 INTEGER INFO, IPOSTPAD, IPREPAD, LDA, LIWORK, LWORK, 00017 $ MATTYPE, N, NOUT, ORDER 00018 DOUBLE PRECISION ABSTOL, THRESH 00019 * .. 00020 * .. Array Arguments .. 00021 INTEGER DESCA( * ), ICLUSTR( * ), IFAIL( * ), 00022 $ ISEED( 4 ), IWORK( * ) 00023 DOUBLE PRECISION A( LDA, * ), COPYA( LDA, * ), GAP( * ), 00024 $ WIN( * ), WNEW( * ), WORK( * ), Z( LDA, * ) 00025 * .. 00026 * 00027 * Purpose 00028 * ======= 00029 * 00030 * PDSEPRTST builds a random matrix and runs PDSYEVR to 00031 * compute the eigenvalues and eigenvectors. Then it performs two tests 00032 * to determine if the result is good enough. The two tests are: 00033 * |AQ -QL| / (abstol + ulp * norm(A) ) 00034 * and 00035 * |QT * Q - I| / ulp * norm(A) 00036 * 00037 * The random matrix built depends upon the following parameters: 00038 * N, NB, ISEED, ORDER 00039 * 00040 * Arguments 00041 * ========= 00042 * 00043 * NP = the number of rows local to a given process. 00044 * NQ = the number of columns local to a given process. 00045 * 00046 * DESCA (global and local input) INTEGER array of dimension DLEN_ 00047 * The array descriptor for the distributed matrices 00048 * 00049 * UPLO (global input) CHARACTER*1 00050 * Specifies whether the upper or lower triangular part of the 00051 * matrix A is stored: 00052 * = 'U': Upper triangular 00053 * = 'L': Lower triangular 00054 * 00055 * N (global input) INTEGER 00056 * Size of the matrix to be tested. (global size) 00057 * 00058 * MATTYPE (global input) INTEGER 00059 * Matrix type 00060 * Currently, the list of possible types is: 00061 * 00062 * (1) The zero matrix. 00063 * (2) The identity matrix. 00064 * 00065 * (3) A diagonal matrix with evenly spaced entries 00066 * 1, ..., ULP and random signs. 00067 * (ULP = (first number larger than 1) - 1 ) 00068 * (4) A diagonal matrix with geometrically spaced entries 00069 * 1, ..., ULP and random signs. 00070 * (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 00071 * and random signs. 00072 * 00073 * (6) Same as (4), but multiplied by SQRT( overflow threshold ) 00074 * (7) Same as (4), but multiplied by SQRT( underflow threshold ) 00075 * 00076 * (8) A matrix of the form U' D U, where U is orthogonal and 00077 * D has evenly spaced entries 1, ..., ULP with random signs 00078 * on the diagonal. 00079 * 00080 * (9) A matrix of the form U' D U, where U is orthogonal and 00081 * D has geometrically spaced entries 1, ..., ULP with random 00082 * signs on the diagonal. 00083 * 00084 * (10) A matrix of the form U' D U, where U is orthogonal and 00085 * D has "clustered" entries 1, ULP,..., ULP with random 00086 * signs on the diagonal. 00087 * 00088 * (11) Same as (8), but multiplied by SQRT( overflow threshold ) 00089 * (12) Same as (8), but multiplied by SQRT( underflow threshold ) 00090 * 00091 * (13) A matrix with random entries chosen from (-1,1). 00092 * (14) Same as (13), but multiplied by SQRT( overflow threshold ) 00093 * (15) Same as (13), but multiplied by SQRT( underflow threshold ) 00094 * (16) Same as (8), but diagonal elements are all positive. 00095 * (17) Same as (9), but diagonal elements are all positive. 00096 * (18) Same as (10), but diagonal elements are all positive. 00097 * (19) Same as (16), but multiplied by SQRT( overflow threshold ) 00098 * (20) Same as (16), but multiplied by SQRT( underflow threshold ) 00099 * (21) A tridiagonal matrix that is a direct sum of smaller diagonally 00100 * dominant submatrices. Each unreduced submatrix has geometrically 00101 * spaced diagonal entries 1, ..., ULP. 00102 * (22) A matrix of the form U' D U, where U is orthogonal and 00103 * D has ceil(lgN) "clusters" at 0,1,2,...,ceil(lgN)-1. The 00104 * size of the cluster at the value I is 2^I. 00105 * 00106 * SUBTESTS (global input) CHARACTER*1 00107 * 'Y' - Perform subset tests 00108 * 'N' - Do not perform subset tests 00109 * 00110 * THRESH (global input) DOUBLE PRECISION 00111 * A test will count as "failed" if the "error", computed as 00112 * described below, exceeds THRESH. Note that the error 00113 * is scaled to be O(1), so THRESH should be a reasonably 00114 * small multiple of 1, e.g., 10 or 100. In particular, 00115 * it should not depend on the precision (single vs. double) 00116 * or the size of the matrix. It must be at least zero. 00117 * 00118 * ORDER (global input) INTEGER 00119 * Number of reflectors used in test matrix creation. 00120 * If ORDER is large, it will 00121 * take more time to create the test matrices but they will 00122 * be closer to random. 00123 * ORDER .lt. N not implemented 00124 * 00125 * ABSTOL (global input) DOUBLE PRECISION 00126 * For the purposes of this test, ABSTOL=0.0 is fine. 00127 * THis test does not test for high relative accuracy. 00128 * 00129 * ISEED (global input/output) INTEGER array, dimension (4) 00130 * On entry, the seed of the random number generator; the array 00131 * elements must be between 0 and 4095, and ISEED(4) must be 00132 * odd. 00133 * On exit, the seed is updated. 00134 * 00135 * A (local workspace) DOUBLE PRECISION array, dim (N*N) 00136 * global dimension (N, N), local dimension (LDA, NQ) 00137 * The test matrix, which is then overwritten. 00138 * A is distributed in a block cyclic manner over both rows 00139 * and columns. The actual location of a particular element 00140 * in A is controlled by the values of NPROW, NPCOL, and NB. 00141 * 00142 * COPYA (local workspace) DOUBLE PRECISION array, dim (N, N) 00143 * COPYA is used to hold an identical copy of the array A 00144 * identical in both form and content to A 00145 * 00146 * Z (local workspace) DOUBLE PRECISION array, dim (N*N) 00147 * Z is distributed in the same manner as A 00148 * Z is used as workspace by the test routines 00149 * PDSEPCHK and PDSEPQTQ 00150 * 00151 * W (local workspace) DOUBLE PRECISION array, dimension (N) 00152 * On normal exit, the first M entries 00153 * contain the selected eigenvalues in ascending order. 00154 * 00155 * IFAIL (global workspace) INTEGER array, dimension (N) 00156 * Not used, only for backward compatibility 00157 * 00158 * WORK (local workspace) DOUBLE PRECISION array, dimension (LWORK) 00159 * 00160 * LWORK (local input) INTEGER 00161 * The length of the array WORK. LWORK >= SIZETST as 00162 * returned by PDLASIZESEPR 00163 * 00164 * IWORK (local workspace) INTEGER array, dimension (LIWORK) 00165 * 00166 * LIWORK (local input) INTEGER 00167 * The length of the array IWORK. LIWORK >= ISIZETST as 00168 * returned by PDLASIZESEPR 00169 * 00170 * HETERO (input) INTEGER 00171 * 00172 * NOUT (local input) INTEGER 00173 * The unit number for output file. Only used on node 0. 00174 * NOUT = 6, output to screen, 00175 * NOUT = 0, output to stderr. 00176 * NOUT = 13, output to file, divide thresh by 10.0 00177 * NOUT = 14, output to file, divide thresh by 20.0 00178 * (This hack allows us to test more stringently internally 00179 * so that when errors on found on other computers they will 00180 * be serious enough to warrant our attention.) 00181 * 00182 * INFO (global output) INTEGER 00183 * -3 This process is not involved 00184 * 0 Test succeeded (passed |AQ -QL| and |QT*Q - I| tests) 00185 * 1 At least one test failed 00186 * 2 Residual test were not performed, thresh <= 0.0 00187 * 3 Test was skipped because of inadequate memory space 00188 * 00189 * .. Parameters .. 00190 INTEGER CTXT_, MB_, NB_, RSRC_, CSRC_, LLD_ 00191 PARAMETER ( CTXT_ = 2, MB_ = 5, NB_ = 6, 00192 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) 00193 DOUBLE PRECISION HALF, ONE, TEN, ZERO 00194 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, 00195 $ TEN = 10.0D0, HALF = 0.5D0 ) 00196 DOUBLE PRECISION PADVAL 00197 PARAMETER ( PADVAL = 19.25D0 ) 00198 INTEGER MAXTYP 00199 PARAMETER ( MAXTYP = 22 ) 00200 * .. 00201 * 00202 * .. Local Scalars .. 00203 LOGICAL WKNOWN 00204 CHARACTER JOBZ, RANGE 00205 CHARACTER*14 PASSED 00206 INTEGER CONTEXT, I, IAM, IHETERO, IINFO, IL, IMODE, IN, 00207 $ INDD, INDWORK, ISIZESUBTST, ISIZEEVR, 00208 $ ISIZETST, ITYPE, IU, J, LLWORK, LEVRSIZE, 00209 $ MAXSIZE, MYCOL, MYROW, NB, NGEN, NLOC, 00210 $ NNODES, NP, NPCOL, NPROW, NQ, RES, SIZECHK, 00211 $ SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZEQTQ, 00212 $ SIZESUBTST, SIZEEVR, SIZETMS, 00213 $ SIZETST, VALSIZE, VECSIZE 00214 DOUBLE PRECISION ANINV, ANORM, COND, MAXQTQNRM, MAXTSTNRM, OVFL, 00215 $ QTQNRM, RTOVFL, RTUNFL, TEMP1, TSTNRM, ULP, 00216 $ ULPINV, UNFL, VL, VU 00217 * .. 00218 * .. Local Arrays .. 00219 INTEGER ISEEDIN( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ), 00220 $ KTYPE( MAXTYP ) 00221 DOUBLE PRECISION CTIME( 10 ), WTIME( 10 ) 00222 * .. 00223 * .. External Functions .. 00224 LOGICAL LSAME 00225 INTEGER NUMROC 00226 DOUBLE PRECISION DLARAN, PDLAMCH 00227 EXTERNAL DLARAN, LSAME, NUMROC, PDLAMCH 00228 * .. 00229 * .. External Subroutines .. 00230 EXTERNAL BLACS_GRIDINFO, BLACS_PINFO, DLABAD, DLASRT, 00231 $ DLATMS, IGAMX2D, IGEBR2D, IGEBS2D, PDCHEKPAD, 00232 $ PDELSET, PDFILLPAD, PDLASET, PDLASIZESEPR, 00233 $ PDLASIZESYEVR, PDLATMS, PDMATGEN, PDSEPRSUBTST, 00234 $ SLCOMBINE 00235 * .. 00236 * .. Intrinsic Functions .. 00237 INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT 00238 * .. 00239 * .. Data statements .. 00240 DATA KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8, 00241 $ 8, 8, 9, 9, 9, 9, 9, 10, 11 / 00242 DATA KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 00243 $ 2, 3, 1, 1, 1, 2, 3, 1, 1 / 00244 DATA KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 00245 $ 0, 0, 4, 3, 1, 4, 4, 3, 0 / 00246 * .. 00247 * .. Executable Statements .. 00248 * 00249 INFO = 0 00250 PASSED = 'PASSED EVR' 00251 CONTEXT = DESCA( CTXT_ ) 00252 NB = DESCA( NB_ ) 00253 * 00254 CALL BLACS_PINFO( IAM, NNODES ) 00255 CALL BLACS_GRIDINFO( CONTEXT, NPROW, NPCOL, MYROW, MYCOL ) 00256 * 00257 * Distribute HETERO across processes 00258 * 00259 IF( IAM.EQ.0 ) THEN 00260 IF( LSAME( HETERO, 'Y' ) ) THEN 00261 IHETERO = 2 00262 ELSE 00263 IHETERO = 1 00264 END IF 00265 CALL IGEBS2D( CONTEXT, 'All', ' ', 1, 1, IHETERO, 1 ) 00266 ELSE 00267 CALL IGEBR2D( CONTEXT, 'All', ' ', 1, 1, IHETERO, 1, 0, 0 ) 00268 END IF 00269 IF( IHETERO.EQ.2 ) THEN 00270 HETERO = 'Y' 00271 ELSE 00272 HETERO = 'N' 00273 END IF 00274 * 00275 * Make sure that there is enough memory 00276 * 00277 CALL PDLASIZESEPR( DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, 00278 $ SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, 00279 $ SIZECHK, SIZEEVR, ISIZEEVR, 00280 $ SIZESUBTST, 00281 $ ISIZESUBTST, SIZETST, ISIZETST ) 00282 IF( LWORK.LT.SIZETST ) THEN 00283 INFO = 3 00284 END IF 00285 * 00286 CALL IGAMX2D( CONTEXT, 'a', ' ', 1, 1, INFO, 1, 1, 1, -1, -1, 0 ) 00287 * 00288 IF( INFO.EQ.0 ) THEN 00289 * 00290 INDD = 1 00291 INDWORK = INDD + N 00292 LLWORK = LWORK - INDWORK + 1 00293 * 00294 ULP = PDLAMCH( CONTEXT, 'P' ) 00295 ULPINV = ONE / ULP 00296 UNFL = PDLAMCH( CONTEXT, 'Safe min' ) 00297 OVFL = ONE / UNFL 00298 CALL DLABAD( UNFL, OVFL ) 00299 RTUNFL = SQRT( UNFL ) 00300 RTOVFL = SQRT( OVFL ) 00301 ANINV = ONE / DBLE( MAX( 1, N ) ) 00302 * 00303 * This ensures that everyone starts out with the same seed. 00304 * 00305 IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN 00306 CALL IGEBS2D( CONTEXT, 'a', ' ', 4, 1, ISEED, 4 ) 00307 ELSE 00308 CALL IGEBR2D( CONTEXT, 'a', ' ', 4, 1, ISEED, 4, 0, 0 ) 00309 END IF 00310 ISEEDIN( 1 ) = ISEED( 1 ) 00311 ISEEDIN( 2 ) = ISEED( 2 ) 00312 ISEEDIN( 3 ) = ISEED( 3 ) 00313 ISEEDIN( 4 ) = ISEED( 4 ) 00314 * 00315 * Compute the matrix A 00316 * 00317 * Control parameters: 00318 * 00319 * KMAGN KMODE KTYPE 00320 * =1 O(1) clustered 1 zero 00321 * =2 large clustered 2 identity 00322 * =3 small exponential (none) 00323 * =4 arithmetic diagonal, (w/ eigenvalues) 00324 * =5 random log symmetric, w/ eigenvalues 00325 * =6 random (none) 00326 * =7 random diagonal 00327 * =8 random symmetric 00328 * =9 positive definite 00329 * =10 block diagonal with tridiagonal blocks 00330 * =11 Geometrically sized clusters. 00331 * 00332 ITYPE = KTYPE( MATTYPE ) 00333 IMODE = KMODE( MATTYPE ) 00334 * 00335 * Compute norm 00336 * 00337 GO TO ( 10, 20, 30 )KMAGN( MATTYPE ) 00338 * 00339 10 CONTINUE 00340 ANORM = ONE 00341 GO TO 40 00342 * 00343 20 CONTINUE 00344 ANORM = ( RTOVFL*ULP )*ANINV 00345 GO TO 40 00346 * 00347 30 CONTINUE 00348 ANORM = RTUNFL*N*ULPINV 00349 GO TO 40 00350 * 00351 40 CONTINUE 00352 IF( MATTYPE.LE.15 ) THEN 00353 COND = ULPINV 00354 ELSE 00355 COND = ULPINV*ANINV / TEN 00356 END IF 00357 * 00358 * Special Matrices 00359 * 00360 IF( ITYPE.EQ.1 ) THEN 00361 * 00362 * Zero Matrix 00363 * 00364 DO 50 I = 1, N 00365 WORK( INDD+I-1 ) = ZERO 00366 50 CONTINUE 00367 CALL PDLASET( 'All', N, N, ZERO, ZERO, COPYA, 1, 1, DESCA ) 00368 WKNOWN = .TRUE. 00369 * 00370 ELSE IF( ITYPE.EQ.2 ) THEN 00371 * 00372 * Identity Matrix 00373 * 00374 DO 60 I = 1, N 00375 WORK( INDD+I-1 ) = ONE 00376 60 CONTINUE 00377 CALL PDLASET( 'All', N, N, ZERO, ONE, COPYA, 1, 1, DESCA ) 00378 WKNOWN = .TRUE. 00379 * 00380 ELSE IF( ITYPE.EQ.4 ) THEN 00381 * 00382 * Diagonal Matrix, [Eigen]values Specified 00383 * 00384 CALL PDFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ), 00385 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+1.0D0 ) 00386 * 00387 CALL PDLATMS( N, N, 'S', ISEED, 'S', WORK( INDD ), IMODE, 00388 $ COND, ANORM, 0, 0, 'N', COPYA, 1, 1, DESCA, 00389 $ ORDER, WORK( INDWORK+IPREPAD ), SIZETMS, 00390 $ IINFO ) 00391 WKNOWN = .TRUE. 00392 * 00393 CALL PDCHEKPAD( DESCA( CTXT_ ), 'PDLATMS1-WORK', SIZETMS, 1, 00394 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD, 00395 $ PADVAL+1.0D0 ) 00396 * 00397 ELSE IF( ITYPE.EQ.5 ) THEN 00398 * 00399 * symmetric, eigenvalues specified 00400 * 00401 CALL PDFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ), 00402 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+2.0D0 ) 00403 * 00404 CALL PDLATMS( N, N, 'S', ISEED, 'S', WORK( INDD ), IMODE, 00405 $ COND, ANORM, N, N, 'N', COPYA, 1, 1, DESCA, 00406 $ ORDER, WORK( INDWORK+IPREPAD ), SIZETMS, 00407 $ IINFO ) 00408 * 00409 CALL PDCHEKPAD( DESCA( CTXT_ ), 'PDLATMS2-WORK', SIZETMS, 1, 00410 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD, 00411 $ PADVAL+2.0D0 ) 00412 * 00413 WKNOWN = .TRUE. 00414 * 00415 ELSE IF( ITYPE.EQ.8 ) THEN 00416 * 00417 * symmetric, random eigenvalues 00418 * 00419 NP = NUMROC( N, DESCA( MB_ ), MYROW, 0, NPROW ) 00420 NQ = NUMROC( N, DESCA( NB_ ), MYCOL, 0, NPCOL ) 00421 CALL PDMATGEN( DESCA( CTXT_ ), 'S', 'N', N, N, DESCA( MB_ ), 00422 $ DESCA( NB_ ), COPYA, DESCA( LLD_ ), 00423 $ DESCA( RSRC_ ), DESCA( CSRC_ ), ISEED( 1 ), 00424 $ 0, NP, 0, NQ, MYROW, MYCOL, NPROW, NPCOL ) 00425 INFO = 0 00426 WKNOWN = .FALSE. 00427 * 00428 ELSE IF( ITYPE.EQ.9 ) THEN 00429 * 00430 * Positive definite, eigenvalues specified. 00431 * 00432 CALL PDFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ), 00433 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+3.0D0 ) 00434 * 00435 CALL PDLATMS( N, N, 'S', ISEED, 'S', WORK( INDD ), IMODE, 00436 $ COND, ANORM, N, N, 'N', COPYA, 1, 1, DESCA, 00437 $ ORDER, WORK( INDWORK+IPREPAD ), SIZETMS, 00438 $ IINFO ) 00439 * 00440 WKNOWN = .TRUE. 00441 * 00442 CALL PDCHEKPAD( DESCA( CTXT_ ), 'PDLATMS3-WORK', SIZETMS, 1, 00443 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD, 00444 $ PADVAL+3.0D0 ) 00445 * 00446 ELSE IF( ITYPE.EQ.10 ) THEN 00447 * 00448 * Block diagonal matrix with each block being a positive 00449 * definite tridiagonal submatrix. 00450 * 00451 CALL PDLASET( 'All', N, N, ZERO, ZERO, COPYA, 1, 1, DESCA ) 00452 NP = NUMROC( N, DESCA( MB_ ), 0, 0, NPROW ) 00453 NQ = NUMROC( N, DESCA( NB_ ), 0, 0, NPCOL ) 00454 NLOC = MIN( NP, NQ ) 00455 NGEN = 0 00456 70 CONTINUE 00457 * 00458 IF( NGEN.LT.N ) THEN 00459 IN = MIN( 1+INT( DLARAN( ISEED )*DBLE( NLOC ) ), N-NGEN ) 00460 * 00461 CALL DLATMS( IN, IN, 'S', ISEED, 'P', WORK( INDD ), 00462 $ IMODE, COND, ANORM, 1, 1, 'N', A, LDA, 00463 $ WORK( INDWORK ), IINFO ) 00464 * 00465 DO 80 I = 2, IN 00466 TEMP1 = ABS( A( I-1, I ) ) / 00467 $ SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) ) 00468 IF( TEMP1.GT.HALF ) THEN 00469 A( I-1, I ) = HALF*SQRT( ABS( A( I-1, I-1 )*A( I, 00470 $ I ) ) ) 00471 A( I, I-1 ) = A( I-1, I ) 00472 END IF 00473 80 CONTINUE 00474 CALL PDELSET( COPYA, NGEN+1, NGEN+1, DESCA, A( 1, 1 ) ) 00475 DO 90 I = 2, IN 00476 CALL PDELSET( COPYA, NGEN+I, NGEN+I, DESCA, 00477 $ A( I, I ) ) 00478 CALL PDELSET( COPYA, NGEN+I-1, NGEN+I, DESCA, 00479 $ A( I-1, I ) ) 00480 CALL PDELSET( COPYA, NGEN+I, NGEN+I-1, DESCA, 00481 $ A( I, I-1 ) ) 00482 90 CONTINUE 00483 NGEN = NGEN + IN 00484 GO TO 70 00485 END IF 00486 WKNOWN = .FALSE. 00487 * 00488 ELSE IF( ITYPE.EQ.11 ) THEN 00489 * 00490 * Geometrically sized clusters. Eigenvalues: 0,1,1,2,2,2,2,... 00491 * 00492 NGEN = 0 00493 J = 1 00494 TEMP1 = ZERO 00495 100 CONTINUE 00496 IF( NGEN.LT.N ) THEN 00497 IN = MIN( J, N-NGEN ) 00498 DO 110 I = 0, IN - 1 00499 WORK( INDD+NGEN+I ) = TEMP1 00500 110 CONTINUE 00501 TEMP1 = TEMP1 + ONE 00502 J = 2*J 00503 NGEN = NGEN + IN 00504 GO TO 100 00505 END IF 00506 * 00507 CALL PDFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ), 00508 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+4.0D0 ) 00509 * 00510 CALL PDLATMS( N, N, 'S', ISEED, 'S', WORK( INDD ), IMODE, 00511 $ COND, ANORM, 0, 0, 'N', COPYA, 1, 1, DESCA, 00512 $ ORDER, WORK( INDWORK+IPREPAD ), SIZETMS, 00513 $ IINFO ) 00514 * 00515 CALL PDCHEKPAD( DESCA( CTXT_ ), 'PDLATMS4-WORK', SIZETMS, 1, 00516 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD, 00517 $ PADVAL+4.0D0 ) 00518 * 00519 ELSE 00520 IINFO = 1 00521 END IF 00522 * 00523 IF( WKNOWN ) 00524 $ CALL DLASRT( 'I', N, WORK( INDD ), IINFO ) 00525 * 00526 CALL PDLASIZESYEVR( WKNOWN, 'A', N, DESCA, VL, VU, IL, IU, 00527 $ ISEED, WORK( INDD ), MAXSIZE, VECSIZE, 00528 $ VALSIZE ) 00529 LEVRSIZE = MIN( MAXSIZE, LLWORK ) 00530 * 00531 CALL PDSEPRSUBTST( WKNOWN, 'v', 'a', UPLO, N, VL, VU, IL, IU, 00532 $ THRESH, ABSTOL, A, COPYA, Z, 1, 1, DESCA, 00533 $ WORK( INDD ), WIN, IFAIL, ICLUSTR, GAP, 00534 $ IPREPAD, IPOSTPAD, WORK( INDWORK ), LLWORK, 00535 $ LEVRSIZE, IWORK, ISIZEEVR, RES, TSTNRM, 00536 $ QTQNRM, NOUT ) 00537 * 00538 MAXTSTNRM = TSTNRM 00539 MAXQTQNRM = QTQNRM 00540 * 00541 IF( THRESH.LE.ZERO ) THEN 00542 PASSED = 'SKIPPED ' 00543 INFO = 2 00544 ELSE IF( RES.NE.0 ) THEN 00545 PASSED = 'FAILED ' 00546 INFO = 1 00547 END IF 00548 END IF 00549 * 00550 IF( THRESH.GT.ZERO .AND. LSAME( SUBTESTS, 'Y' ) ) THEN 00551 * 00552 * Subtest 1: JOBZ = 'N', RANGE = 'A', minimum memory 00553 * 00554 IF( INFO.EQ.0 ) THEN 00555 * 00556 JOBZ = 'N' 00557 RANGE = 'A' 00558 CALL PDLASIZESYEVR( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU, 00559 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE, 00560 $ VECSIZE, VALSIZE ) 00561 * 00562 LEVRSIZE = VALSIZE 00563 * 00564 CALL PDSEPRSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL, 00565 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1, 00566 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL, 00567 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD, 00568 $ WORK( INDWORK ), LLWORK, LEVRSIZE, 00569 $ IWORK, ISIZEEVR, RES, TSTNRM, QTQNRM, 00570 $ NOUT ) 00571 * 00572 IF( RES.NE.0 ) THEN 00573 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM ) 00574 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM ) 00575 PASSED = 'FAILED stest 1' 00576 INFO = 1 00577 END IF 00578 END IF 00579 * 00580 * Subtest 2: JOBZ = 'N', RANGE = 'I', minimum memory 00581 * 00582 IF( INFO.EQ.0 ) THEN 00583 * 00584 IL = -1 00585 IU = -1 00586 JOBZ = 'N' 00587 RANGE = 'I' 00588 * 00589 * Use PDLASIZESYEVR to choose IL and IU. 00590 * 00591 CALL PDLASIZESYEVR( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU, 00592 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE, 00593 $ VECSIZE, VALSIZE ) 00594 * 00595 LEVRSIZE = VALSIZE 00596 * 00597 CALL PDSEPRSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL, 00598 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1, 00599 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL, 00600 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD, 00601 $ WORK( INDWORK ), LLWORK, LEVRSIZE, 00602 $ IWORK, ISIZEEVR, RES, TSTNRM, QTQNRM, 00603 $ NOUT ) 00604 * 00605 IF( RES.NE.0 ) THEN 00606 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM ) 00607 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM ) 00608 PASSED = 'FAILED stest 2' 00609 INFO = 1 00610 END IF 00611 END IF 00612 * 00613 * Subtest 3: JOBZ = 'V', RANGE = 'I', minimum memory 00614 * 00615 IF( INFO.EQ.0 ) THEN 00616 IL = -1 00617 IU = -1 00618 JOBZ = 'V' 00619 RANGE = 'I' 00620 * 00621 * We use PDLASIZESYEVR to choose IL and IU for us. 00622 * 00623 CALL PDLASIZESYEVR( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU, 00624 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE, 00625 $ VECSIZE, VALSIZE ) 00626 * 00627 LEVRSIZE = VECSIZE 00628 * 00629 CALL PDSEPRSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL, 00630 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1, 00631 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL, 00632 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD, 00633 $ WORK( INDWORK ), LLWORK, LEVRSIZE, 00634 $ IWORK, ISIZEEVR, RES, TSTNRM, QTQNRM, 00635 $ NOUT ) 00636 * 00637 IF( RES.NE.0 ) THEN 00638 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM ) 00639 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM ) 00640 PASSED = 'FAILED stest 3' 00641 INFO = 1 00642 END IF 00643 END IF 00644 * 00645 * Subtest 4: JOBZ = 'N', RANGE = 'V', minimum memory 00646 * 00647 IF( INFO.EQ.0 ) THEN 00648 VL = ONE 00649 VU = -ONE 00650 JOBZ = 'N' 00651 RANGE = 'V' 00652 * 00653 * We use PDLASIZESYEVR to choose IL and IU for us. 00654 * 00655 CALL PDLASIZESYEVR( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU, 00656 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE, 00657 $ VECSIZE, VALSIZE ) 00658 * 00659 LEVRSIZE = VALSIZE 00660 * 00661 CALL PDSEPRSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL, 00662 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1, 00663 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL, 00664 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD, 00665 $ WORK( INDWORK ), LLWORK, LEVRSIZE, 00666 $ IWORK, ISIZEEVR, RES, TSTNRM, QTQNRM, 00667 $ NOUT ) 00668 * 00669 IF( RES.NE.0 ) THEN 00670 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM ) 00671 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM ) 00672 PASSED = 'FAILED stest 4' 00673 INFO = 1 00674 END IF 00675 END IF 00676 * 00677 * Subtest 5: JOBZ = 'V', RANGE = 'V', minimum memory 00678 * 00679 IF( INFO.EQ.0 ) THEN 00680 VL = ONE 00681 VU = -ONE 00682 JOBZ = 'V' 00683 RANGE = 'V' 00684 * 00685 * We use PDLASIZESYEVR to choose VL and VU for us. 00686 * 00687 CALL PDLASIZESYEVR( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU, 00688 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE, 00689 $ VECSIZE, VALSIZE ) 00690 * 00691 LEVRSIZE = VECSIZE 00692 * 00693 CALL PDSEPRSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL, 00694 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1, 00695 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL, 00696 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD, 00697 $ WORK( INDWORK ), LLWORK, LEVRSIZE, 00698 $ IWORK, ISIZEEVR, RES, TSTNRM, QTQNRM, 00699 $ NOUT ) 00700 * 00701 IF( RES.NE.0 ) THEN 00702 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM ) 00703 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM ) 00704 PASSED = 'FAILED stest 5' 00705 INFO = 1 00706 END IF 00707 END IF 00708 END IF 00709 * 00710 CALL IGAMX2D( CONTEXT, 'All', ' ', 1, 1, INFO, 1, -1, -1, -1, -1, 00711 $ -1 ) 00712 IF( INFO.EQ.1 ) THEN 00713 IF( IAM.EQ.0 .AND. .FALSE. ) THEN 00714 WRITE( NOUT, FMT = 9994 )'C ' 00715 WRITE( NOUT, FMT = 9993 )ISEEDIN( 1 ) 00716 WRITE( NOUT, FMT = 9992 )ISEEDIN( 2 ) 00717 WRITE( NOUT, FMT = 9991 )ISEEDIN( 3 ) 00718 WRITE( NOUT, FMT = 9990 )ISEEDIN( 4 ) 00719 IF( LSAME( UPLO, 'L' ) ) THEN 00720 WRITE( NOUT, FMT = 9994 )' UPLO= ''L'' ' 00721 ELSE 00722 WRITE( NOUT, FMT = 9994 )' UPLO= ''U'' ' 00723 END IF 00724 IF( LSAME( SUBTESTS, 'Y' ) ) THEN 00725 WRITE( NOUT, FMT = 9994 )' SUBTESTS= ''Y'' ' 00726 ELSE 00727 WRITE( NOUT, FMT = 9994 )' SUBTESTS= ''N'' ' 00728 END IF 00729 WRITE( NOUT, FMT = 9989 )N 00730 WRITE( NOUT, FMT = 9988 )NPROW 00731 WRITE( NOUT, FMT = 9987 )NPCOL 00732 WRITE( NOUT, FMT = 9986 )NB 00733 WRITE( NOUT, FMT = 9985 )MATTYPE 00734 WRITE( NOUT, FMT = 9982 )ABSTOL 00735 WRITE( NOUT, FMT = 9981 )THRESH 00736 WRITE( NOUT, FMT = 9994 )'C ' 00737 END IF 00738 END IF 00739 * 00740 CALL SLCOMBINE( CONTEXT, 'All', '>', 'W', 6, 1, WTIME ) 00741 CALL SLCOMBINE( CONTEXT, 'All', '>', 'C', 6, 1, CTIME ) 00742 IF( IAM.EQ.0 ) THEN 00743 IF( INFO.EQ.0 .OR. INFO.EQ.1 ) THEN 00744 IF( WTIME( 1 ).GE.0.0 ) THEN 00745 WRITE( NOUT, FMT = 9999 )N, NB, NPROW, NPCOL, MATTYPE, 00746 $ SUBTESTS, WTIME( 1 ), CTIME( 1 ), MAXTSTNRM, 00747 $ MAXQTQNRM, PASSED 00748 ELSE 00749 WRITE( NOUT, FMT = 9998 )N, NB, NPROW, NPCOL, MATTYPE, 00750 $ SUBTESTS, CTIME( 1 ), MAXTSTNRM, MAXQTQNRM, PASSED 00751 END IF 00752 ELSE IF( INFO.EQ.2 ) THEN 00753 IF( WTIME( 1 ).GE.0.0 ) THEN 00754 WRITE( NOUT, FMT = 9997 )N, NB, NPROW, NPCOL, MATTYPE, 00755 $ SUBTESTS, WTIME( 1 ), CTIME( 1 ) 00756 ELSE 00757 WRITE( NOUT, FMT = 9996 )N, NB, NPROW, NPCOL, MATTYPE, 00758 $ SUBTESTS, CTIME( 1 ) 00759 END IF 00760 ELSE IF( INFO.EQ.3 ) THEN 00761 WRITE( NOUT, FMT = 9995 )N, NB, NPROW, NPCOL, MATTYPE, 00762 $ SUBTESTS 00763 END IF 00764 C WRITE(*,*)'************************************************' 00765 END IF 00766 * 00767 00768 RETURN 00769 9999 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, 00770 $ F8.2, 1X, F8.2, 1X, G9.2, 1X, G9.2, 1X, A14 ) 00771 9998 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, 8X, 00772 $ 1X, F8.2, 1X, G9.2, 1X, G9.2, A14 ) 00773 9997 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, F8.2, 00774 $ 1X, F8.2, 21X, 'Bypassed' ) 00775 9996 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, 8X, 00776 $ 1X, F8.2, 21X, 'Bypassed' ) 00777 9995 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 32X, 00778 $ 'Bad MEMORY parameters' ) 00779 9994 FORMAT( A ) 00780 9993 FORMAT( ' ISEED( 1 ) =', I8 ) 00781 9992 FORMAT( ' ISEED( 2 ) =', I8 ) 00782 9991 FORMAT( ' ISEED( 3 ) =', I8 ) 00783 9990 FORMAT( ' ISEED( 4 ) =', I8 ) 00784 9989 FORMAT( ' N=', I8 ) 00785 9988 FORMAT( ' NPROW=', I8 ) 00786 9987 FORMAT( ' NPCOL=', I8 ) 00787 9986 FORMAT( ' NB=', I8 ) 00788 9985 FORMAT( ' MATTYPE=', I8 ) 00789 C 9984 FORMAT( ' IBTYPE=', I8 ) 00790 C 9983 FORMAT( ' SUBTESTS=', A1 ) 00791 9982 FORMAT( ' ABSTOL=', D16.6 ) 00792 9981 FORMAT( ' THRESH=', D16.6 ) 00793 C 9980 FORMAT( ' Increase TOTMEM in PDSEPRDRIVER' ) 00794 * 00795 * End of PDSEPRTST 00796 * 00797 END 00798 00799 00800 00801
