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