OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pzseptst.f
Go to the documentation of this file.
1*
2*
3 SUBROUTINE pzseptst( DESCA, UPLO, N, MATTYPE, SUBTESTS, THRESH,
4 $ ORDER, ABSTOL, ISEED, A, COPYA, Z, LDA, WIN,
5 $ WNEW, IFAIL, ICLUSTR, GAP, IPREPAD, IPOSTPAD,
6 $ WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK,
7 $ NOUT, INFO )
8*
9* -- ScaLAPACK routine (version 1.7) --
10* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
11* and University of California, Berkeley.
12* March 15, 2002
13*
14* .. Scalar Arguments ..
15 CHARACTER SUBTESTS, UPLO
16 INTEGER INFO, IPOSTPAD, IPREPAD, LDA, LIWORK, LRWORK,
17 $ LWORK, MATTYPE, N, NOUT, ORDER
18 DOUBLE PRECISION ABSTOL, THRESH
19* ..
20* .. Array Arguments ..
21 INTEGER DESCA( * ), ICLUSTR( * ), IFAIL( * ),
22 $ iseed( 4 ), iwork( * )
23 DOUBLE PRECISION GAP( * ), RWORK( * ), WIN( * ), WNEW( * )
24 COMPLEX*16 A( LDA, * ), COPYA( LDA, * ), WORK( * ),
25 $ z( lda, * )
26* ..
27*
28* Purpose
29* =======
30*
31* PZSEPTST builds a random matrix, runs PZHEEVX() to
32* compute the eigenvalues
33* and eigenvectors and then performs two tests to
34* determine if the result
35* is good enough. The two tests are:
36* |AQ -QL| / (abstol + ulp * norm(A) )
37* and
38* |QT * Q - I| / ulp * norm(A)
39*
40* The random matrix built depends upon the following parameters:
41* N, NB, ISEED, ORDER
42*
43* Arguments
44* =========
45*
46* NP = the number of rows local to a given process.
47* NQ = the number of columns local to a given process.
48*
49* DESCA (global and local input) INTEGER array of dimension DLEN_
50* The array descriptor for the distributed matrices
51*
52* UPLO (global input) CHARACTER*1
53* Specifies whether the upper or lower triangular part of the
54* Hermitian matrix A is stored:
55* = 'U': Upper triangular
56* = 'L': Lower triangular
57*
58* N (global input) INTEGER
59* Size of the matrix to be tested. (global size)
60*
61* MATTYPE (global input) INTEGER
62* Matrix type
63* Currently, the list of possible types is:
64*
65* (1) The zero matrix.
66* (2) The identity matrix.
67*
68* (3) A diagonal matrix with evenly spaced entries
69* 1, ..., ULP and random signs.
70* (ULP = (first number larger than 1) - 1 )
71* (4) A diagonal matrix with geometrically spaced entries
72* 1, ..., ULP and random signs.
73* (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
74* and random signs.
75*
76* (6) Same as (4), but multiplied by SQRT( overflow threshold )
77* (7) Same as (4), but multiplied by SQRT( underflow threshold )
78*
79* (8) A matrix of the form U' D U, where U is orthogonal and
80* D has evenly spaced entries 1, ..., ULP with random signs
81* on the diagonal.
82*
83* (9) A matrix of the form U' D U, where U is orthogonal and
84* D has geometrically spaced entries 1, ..., ULP with random
85* signs on the diagonal.
86*
87* (10) A matrix of the form U' D U, where U is orthogonal and
88* D has "clustered" entries 1, ULP,..., ULP with random
89* signs on the diagonal.
90*
91* (11) Same as (8), but multiplied by SQRT( overflow threshold )
92* (12) Same as (8), but multiplied by SQRT( underflow threshold )
93*
94* (13) Hermitian matrix with random entries chosen from (-1,1).
95* (14) Same as (13), but multiplied by SQRT( overflow threshold )
96* (15) Same as (13), but multiplied by SQRT( underflow threshold )
97* (16) Same as (8), but diagonal elements are all positive.
98* (17) Same as (9), but diagonal elements are all positive.
99* (18) Same as (10), but diagonal elements are all positive.
100* (19) Same as (16), but multiplied by SQRT( overflow threshold )
101* (20) Same as (16), but multiplied by SQRT( underflow threshold )
102* (21) A tridiagonal matrix that is a direct sum of smaller diagonally
103* dominant submatrices. Each unreduced submatrix has geometrically
104* spaced diagonal entries 1, ..., ULP.
105* (22) A matrix of the form U' D U, where U is orthogonal and
106* D has ceil(lgN) "clusters" at 0,1,2,...,ceil(lgN)-1. The
107* size of the cluster at the value I is 2^I.
108*
109* SUBTESTS (global input) CHARACTER*1
110* 'Y' - Perform subset tests
111* 'N' - Do not perform subset tests
112*
113* THRESH (global input) DOUBLE PRECISION
114* A test will count as "failed" if the "error", computed as
115* described below, exceeds THRESH. Note that the error
116* is scaled to be O(1), so THRESH should be a reasonably
117* small multiple of 1, e.g., 10 or 100. In particular,
118* it should not depend on the precision (single vs. double)
119* or the size of the matrix. It must be at least zero.
120*
121* ORDER (global input) INTEGER
122* Number of reflectors used in test matrix creation.
123* If ORDER is large, it will
124* take more time to create the test matrices but they will
125* be closer to random.
126* ORDER .lt. N not implemented
127*
128* ABSTOL (global input) DOUBLE PRECISION
129* The absolute tolerance for the eigenvalues. An
130* eigenvalue is considered to be located if it has
131* been determined to lie in an interval whose width
132* is "abstol" or less. If "abstol" is less than or equal
133* to zero, then ulp*|T| will be used, where |T| is
134* the 1-norm of the matrix. If eigenvectors are
135* desired later by inverse iteration ("PZSTEIN"),
136* "abstol" MUST NOT be bigger than ulp*|T|.
137*
138* For the purposes of this test, ABSTOL=0.0 is fine.
139* THis test does not test for high relative accuracy.
140*
141* ISEED (global input/output) INTEGER array, dimension (4)
142* On entry, the seed of the random number generator; the array
143* elements must be between 0 and 4095, and ISEED(4) must be
144* odd.
145* On exit, the seed is updated.
146*
147* A (local workspace) COMPLEX*16 array, dim (N*N)
148* global dimension (N, N), local dimension (LDA, NQ)
149* A is distributed in a block cyclic manner over both rows
150* and columns. The actual location of a particular element
151* in A is controlled by the values of NPROW, NPCOL, and NB.
152* The test matrix, which is then modified by PZHEEVX
153*
154* COPYA (local workspace) COMPLEX*16 array, dim (N, N)
155* COPYA is used to hold an identical copy of the array A
156* identical in both form and content to A
157*
158* Z (local workspace) COMPLEX*16 array, dim (N*N)
159* Z is distributed in the same manner as A
160* Z is used as workspace by the test routines
161* PZSEPCHK and PZSEPQTQ
162*
163* W (local workspace) DOUBLE PRECISION array, dimension (N)
164* On normal exit from PZHEEVX, the first M entries
165* contain the selected eigenvalues in ascending order.
166*
167* IFAIL (global workspace) INTEGER array, dimension (N)
168*
169* WORK (local workspace) COMPLEX*16 array, dimension (LWORK)
170*
171* LWORK (local input) INTEGER
172* The length of the array WORK. LWORK >= SIZETST as
173* returned by PZLASIZESEP
174*
175* RWORK (local workspace) COMPLEX*16 array, dimension (LWORK)
176*
177* LRWORK (local input) INTEGER
178* The length of the array WORK. LRWORK >= RSIZETST as
179* returned by PZLASIZESEP
180*
181* IWORK (local workspace) INTEGER array, dimension (LIWORK)
182*
183* LIWORK (local input) INTEGER
184* The length of the array IWORK. LIWORK >= ISIZETST as
185* returned by PZLASIZESEP
186*
187* NOUT (local input) INTEGER
188* The unit number for output file. Only used on node 0.
189* NOUT = 6, output to screen,
190* NOUT = 0, output to stderr.
191* NOUT = 13, output to file, divide thresh by 10.0
192* NOUT = 14, output to file, divide thresh by 20.0
193* (This hack allows us to test more stringently internally
194* so that when errors on found on other computers they will
195* be serious enough to warrant our attention.)
196*
197* INFO (global output) INTEGER
198* -3 This process is not involved
199* 0 Test succeeded (passed |AQ -QL| and |QT*Q - I| tests)
200* 1 At least one test failed
201* 2 Residual test were not performed, thresh <= 0.0
202* 3 Test was skipped because of inadequate memory space
203*
204* .. Parameters ..
205 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
206 $ MB_, NB_, RSRC_, CSRC_, LLD_
207 PARAMETER ( BLOCK_CYCLIC_2D = 1, dlen_ = 9, dtype_ = 1,
208 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
209 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
210 DOUBLE PRECISION ZERO, ONE, TEN, HALF
211 parameter( zero = 0.0d+0, one = 1.0d+0, ten = 10.0d+0,
212 $ half = 0.5d+0 )
213 COMPLEX*16 PADVAL
214 parameter( padval = ( 19.25d+0, 1.1d+1 ) )
215 COMPLEX*16 ZZERO
216 PARAMETER ( ZZERO = ( 0.0d+0, 0.0d+0 ) )
217 COMPLEX*16 ZONE
218 parameter( zone = ( 1.0d+0, 0.0d+0 ) )
219 INTEGER MAXTYP
220 parameter( maxtyp = 22 )
221* ..
222*
223* .. Local Scalars ..
224 LOGICAL WKNOWN
225 CHARACTER JOBZ, RANGE
226 CHARACTER*14 PASSED
227 INTEGER CONTEXT, I, IAM, IINFO, IL, IMODE, IN, INDD,
228 $ indrwork, indwork, isizeheevx, isizesubtst,
229 $ isizetst, itype, iu, j, lheevxsize, llrwork,
230 $ llwork, maxsize, mycol, myrow, nb, ngen, nloc,
231 $ nnodes, np, npcol, nprow, nq, res, rsizechk,
232 $ rsizeheevx, rsizeqtq, rsizesubtst, rsizetst,
233 $ sizeheevx, sizemqrleft, sizemqrright, sizeqrf,
234 $ sizesubtst, sizetms, sizetst, valsize, vecsize,
235 $ sizeheevd, rsizeheevd, isizeheevd, nq0, np0,
236 $ lheevdsize
237 DOUBLE PRECISION ANINV, ANORM, COND, MAXQTQNRM, MAXTSTNRM, OVFL,
238 $ QTQNRM, RTOVFL, RTUNFL, TEMP1, TSTNRM, ULP,
239 $ ULPINV, UNFL, VL, VU
240* ..
241* .. Local Arrays ..
242 INTEGER ISEEDIN( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
243 $ KTYPE( MAXTYP )
244 DOUBLE PRECISION CTIME( 10 ), WTIME( 10 )
245* ..
246* .. External Functions ..
247 LOGICAL LSAME
248 INTEGER NUMROC
249 DOUBLE PRECISION DLARAN, PDLAMCH
250 EXTERNAL LSAME, NUMROC, DLARAN, PDLAMCH
251* ..
252* .. External Subroutines ..
253 EXTERNAL blacs_gridinfo, blacs_pinfo, dlabad, dlasrt,
254 $ igamx2d, igebr2d, igebs2d, pzchekpad, pzelset,
255 $ pzfillpad, pzlaset, pzlasizeheevx, pzlasizesep,
256 $ pzlatms, pzmatgen, pzsepsubtst, slcombine,
257 $ zlatms
258* ..
259* .. Intrinsic Functions ..
260 INTRINSIC abs, dble, int, max, min, sqrt
261* ..
262* .. Data statements ..
263 DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
264 $ 8, 8, 9, 9, 9, 9, 9, 10, 11 /
265 DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
266 $ 2, 3, 1, 1, 1, 2, 3, 1, 1 /
267 DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
268 $ 0, 0, 4, 3, 1, 4, 4, 3, 0 /
269* ..
270* .. Executable Statements ..
271* This is just to keep ftnchek happy
272 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
273 $ rsrc_.LT.0 )RETURN
274*
275 info = 0
276 passed = 'PASSED EVX'
277 context = desca( ctxt_ )
278 nb = desca( nb_ )
279*
280 CALL blacs_pinfo( iam, nnodes )
281 CALL blacs_gridinfo( context, nprow, npcol, myrow, mycol )
282*
283*
284* Make sure that we have enough memory
285*
286*
287 CALL pzlasizesep( desca, iprepad, ipostpad, sizemqrleft,
288 $ sizemqrright, sizeqrf, sizetms, rsizeqtq,
289 $ rsizechk, sizeheevx, rsizeheevx, isizeheevx,
290 $ sizeheevd, rsizeheevd, isizeheevd,
291 $ sizesubtst, rsizesubtst, isizesubtst, sizetst,
292 $ rsizetst, isizetst )
293*
294 IF( lrwork.LT.rsizetst ) THEN
295 info = 3
296 END IF
297*
298 CALL igamx2d( context, 'a', ' ', 1, 1, info, 1, 1, 1, -1, -1, 0 )
299*
300 IF( info.EQ.0 ) THEN
301*
302 indd = 1
303 indrwork = indd + n
304 indwork = 1
305 llwork = lwork - indwork + 1
306 llrwork = lrwork - indrwork + 1
307*
308 ulp = pdlamch( context, 'P' )
309 ulpinv = one / ulp
310 unfl = pdlamch( context, 'Safe min' )
311 ovfl = one / unfl
312 CALL dlabad( unfl, ovfl )
313 rtunfl = sqrt( unfl )
314 rtovfl = sqrt( ovfl )
315 aninv = one / dble( max( 1, n ) )
316*
317* This ensures that everyone starts out with the same seed.
318*
319 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
320 CALL igebs2d( context, 'a', ' ', 4, 1, iseed, 4 )
321 ELSE
322 CALL igebr2d( context, 'a', ' ', 4, 1, iseed, 4, 0, 0 )
323 END IF
324 iseedin( 1 ) = iseed( 1 )
325 iseedin( 2 ) = iseed( 2 )
326 iseedin( 3 ) = iseed( 3 )
327 iseedin( 4 ) = iseed( 4 )
328*
329* Compute the matrix A
330*
331* Control parameters:
332*
333* KMAGN KMODE KTYPE
334* =1 O(1) clustered 1 zero
335* =2 large clustered 2 identity
336* =3 small exponential (none)
337* =4 arithmetic diagonal, (w/ eigenvalues)
338* =5 random log Hermitian, w/ eigenvalues
339* =6 random (none)
340* =7 random diagonal
341* =8 random Hermitian
342* =9 positive definite
343* =10 block diagonal with tridiagonal blocks
344* =11 Geometrically sized clusters.
345*
346 itype = ktype( mattype )
347 imode = kmode( mattype )
348*
349* Compute norm
350*
351 GO TO ( 10, 20, 30 )kmagn( mattype )
352*
353 10 CONTINUE
354 anorm = one
355 GO TO 40
356*
357 20 CONTINUE
358 anorm = ( rtovfl*ulp )*aninv
359 GO TO 40
360*
361 30 CONTINUE
362 anorm = rtunfl*n*ulpinv
363 GO TO 40
364*
365 40 CONTINUE
366 IF( mattype.LE.15 ) THEN
367 cond = ulpinv
368 ELSE
369 cond = ulpinv*aninv / ten
370 END IF
371*
372* Special Matrices
373*
374* Zero
375*
376*
377 IF( itype.EQ.1 ) THEN
378*
379* Zero Matrix
380*
381 DO 50 i = 1, n
382 rwork( indd+i-1 ) = zero
383 50 CONTINUE
384 CALL pzlaset( 'All', n, n, zzero, zzero, copya, 1, 1,
385 $ desca )
386 wknown = .true.
387*
388 ELSE IF( itype.EQ.2 ) THEN
389*
390* Identity Matrix
391*
392 DO 60 i = 1, n
393 rwork( indd+i-1 ) = one
394 60 CONTINUE
395 CALL pzlaset( 'All', n, n, zzero, zone, copya, 1, 1, desca )
396 wknown = .true.
397*
398 ELSE IF( itype.EQ.4 ) THEN
399*
400* Diagonal Matrix, [Eigen]values Specified
401*
402 CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
403 $ sizetms, iprepad, ipostpad, padval+1.0d+0 )
404*
405 CALL pzlatms( n, n, 'S', iseed, 'S', rwork( indd ), imode,
406 $ cond, anorm, 0, 0, 'N', copya, 1, 1, desca,
407 $ order, work( indwork+iprepad ), sizetms,
408 $ iinfo )
409 wknown = .true.
410*
411 CALL pzchekpad( desca( ctxt_ ), 'PZLATMS1-WORK', sizetms, 1,
412 $ work( indwork ), sizetms, iprepad, ipostpad,
413 $ padval+1.0d+0 )
414*
415 ELSE IF( itype.EQ.5 ) THEN
416*
417* Hermitian, eigenvalues specified
418*
419 CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
420 $ sizetms, iprepad, ipostpad, padval+2.0d+0 )
421*
422 CALL pzlatms( n, n, 'S', iseed, 'S', rwork( indd ), imode,
423 $ cond, anorm, n, n, 'N', copya, 1, 1, desca,
424 $ order, work( indwork+iprepad ), sizetms,
425 $ iinfo )
426*
427 CALL pzchekpad( desca( ctxt_ ), 'PZLATMS2-WORK', sizetms, 1,
428 $ work( indwork ), sizetms, iprepad, ipostpad,
429 $ padval+2.0d+0 )
430*
431 wknown = .true.
432*
433 ELSE IF( itype.EQ.8 ) THEN
434*
435* Hermitian, random eigenvalues
436*
437 np = numroc( n, desca( mb_ ), myrow, 0, nprow )
438 nq = numroc( n, desca( nb_ ), mycol, 0, npcol )
439 CALL pzmatgen( desca( ctxt_ ), 'H', 'N', n, n, desca( mb_ ),
440 $ desca( nb_ ), copya, desca( lld_ ),
441 $ desca( rsrc_ ), desca( csrc_ ), iseed( 1 ),
442 $ 0, np, 0, nq, myrow, mycol, nprow, npcol )
443 info = 0
444 wknown = .false.
445*
446 ELSE IF( itype.EQ.9 ) THEN
447*
448* Positive definite, eigenvalues specified.
449*
450*
451 CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
452 $ sizetms, iprepad, ipostpad, padval+3.0d+0 )
453*
454 CALL pzlatms( n, n, 'S', iseed, 'S', rwork( indd ), imode,
455 $ cond, anorm, n, n, 'n', COPYA, 1, 1, DESCA,
456 $ ORDER, WORK( INDWORK+IPREPAD ), SIZETMS,
457 $ IINFO )
458*
459 WKNOWN = .TRUE.
460*
461 CALL PZCHEKPAD( DESCA( CTXT_ ), 'pzlatms3-work', SIZETMS, 1,
462 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
463 $ PADVAL+3.0D+0 )
464*
465.EQ. ELSE IF( ITYPE10 ) THEN
466*
467* Block diagonal matrix with each block being a positive
468* definite tridiagonal submatrix.
469*
470 CALL PZLASET( 'all', N, N, ZZERO, ZZERO, COPYA, 1, 1,
471 $ DESCA )
472 NP = NUMROC( N, DESCA( MB_ ), 0, 0, NPROW )
473 NQ = NUMROC( N, DESCA( NB_ ), 0, 0, NPCOL )
474 NLOC = MIN( NP, NQ )
475 NGEN = 0
476 70 CONTINUE
477*
478.LT. IF( NGENN ) THEN
479 IN = MIN( 1+INT( DLARAN( ISEED )*DBLE( NLOC ) ), N-NGEN )
480*
481 CALL ZLATMS( IN, IN, 's', ISEED, 'p', RWORK( INDD ),
482 $ IMODE, COND, ANORM, 1, 1, 'n', A, LDA,
483 $ WORK( INDWORK ), IINFO )
484*
485 DO 80 I = 2, IN
486 TEMP1 = ABS( A( I-1, I ) ) /
487 $ SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) )
488.GT. IF( TEMP1HALF ) THEN
489 A( I-1, I ) = HALF*SQRT( ABS( A( I-1, I-1 )*A( I,
490 $ I ) ) )
491 A( I, I-1 ) = A( I-1, I )
492 END IF
493 80 CONTINUE
494 CALL PZELSET( COPYA, NGEN+1, NGEN+1, DESCA, A( 1, 1 ) )
495 DO 90 I = 2, IN
496 CALL PZELSET( COPYA, NGEN+I, NGEN+I, DESCA,
497 $ A( I, I ) )
498 CALL PZELSET( COPYA, NGEN+I-1, NGEN+I, DESCA,
499 $ A( I-1, I ) )
500 CALL PZELSET( COPYA, NGEN+I, NGEN+I-1, DESCA,
501 $ A( I, I-1 ) )
502 90 CONTINUE
503 NGEN = NGEN + IN
504 GO TO 70
505 END IF
506 WKNOWN = .FALSE.
507*
508.EQ. ELSE IF( ITYPE11 ) THEN
509*
510* Geometrically sized clusters. Eigenvalues: 0,1,1,2,2,2,2, ...
511*
512 NGEN = 0
513 J = 1
514 TEMP1 = ZERO
515 100 CONTINUE
516.LT. IF( NGENN ) THEN
517 IN = MIN( J, N-NGEN )
518 DO 110 I = 0, IN - 1
519 RWORK( INDD+NGEN+I ) = TEMP1
520 110 CONTINUE
521 TEMP1 = TEMP1 + ONE
522 J = 2*J
523 NGEN = NGEN + IN
524 GO TO 100
525 END IF
526*
527*
528 CALL PZFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ),
529 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+4.0D+0 )
530*
531 CALL PZLATMS( N, N, 's', ISEED, 's', RWORK( INDD ), IMODE,
532 $ COND, ANORM, 0, 0, 'n', COPYA, 1, 1, DESCA,
533 $ ORDER, WORK( INDWORK+IPREPAD ), SIZETMS,
534 $ IINFO )
535*
536 CALL PZCHEKPAD( DESCA( CTXT_ ), 'pzlatms4-work', SIZETMS, 1,
537 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
538 $ PADVAL+4.0D+0 )
539*
540*
541* WKNOWN ... NOT SET, GUESS A DEFAULT
542*
543 WKNOWN = .TRUE.
544 ELSE
545 IINFO = 1
546 END IF
547*
548 IF( WKNOWN )
549 $ CALL DLASRT( 'i', N, RWORK( INDD ), IINFO )
550*
551*
552* These values aren't actually used, but they make ftncheck happy.
553*
554 IL = -1
555 IU = -2
556 VL = ONE
557 VU = -ONE
558*
559 CALL PZLASIZEHEEVX( WKNOWN, 'a', N, DESCA, VL, VU, IL, IU,
560 $ ISEED, RWORK( INDD ), MAXSIZE, VECSIZE,
561 $ VALSIZE )
562*
563 LHEEVXSIZE = MIN( MAXSIZE, LLRWORK )
564*
565 CALL PZSEPSUBTST( WKNOWN, 'v', 'a', UPLO, N, VL, VU, IL, IU,
566 $ THRESH, ABSTOL, A, COPYA, Z, 1, 1, DESCA,
567 $ RWORK( INDD ), WIN, IFAIL, ICLUSTR, GAP,
568 $ IPREPAD, IPOSTPAD, WORK( INDWORK ), LLWORK,
569 $ RWORK( INDRWORK ), LLRWORK, LHEEVXSIZE,
570 $ IWORK, ISIZEHEEVX, RES, TSTNRM, QTQNRM,
571 $ NOUT )
572*
573*
574*
575 MAXTSTNRM = TSTNRM
576 MAXQTQNRM = QTQNRM
577*
578 res =0
579.LE. IF( THRESHZERO ) THEN
580 PASSED = 'skipped '
581 INFO = 2
582.NE. ELSE IF( RES0 ) THEN
583 PASSED = 'failed '
584 INFO = 1
585 END IF
586 END IF
587*
588.GT..AND. IF( THRESHZERO LSAME( SUBTESTS, 'y' ) ) THEN
589*
590* Subtest 1: JOBZ = 'V', RANGE = 'A', minimum memory
591*
592.EQ. IF( INFO0 ) THEN
593*
594 JOBZ = 'v'
595 RANGE = 'a'
596 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
597 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
598 $ VECSIZE, VALSIZE )
599*
600 LHEEVXSIZE = VECSIZE
601*
602 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
603 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
604 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
605 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
606 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
607 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
608 $ TSTNRM, QTQNRM, NOUT )
609*
610.NE. IF( RES0 ) THEN
611 PASSED = 'failed stest 1'
612 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
613 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
614 INFO = 1
615 END IF
616 END IF
617*
618* Subtest 2: JOBZ = 'V', RANGE = 'A', random memory
619*
620.EQ. IF( INFO0 ) THEN
621 JOBZ = 'v'
622 RANGE = 'a'
623 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
624 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
625 $ VECSIZE, VALSIZE )
626*
627 LHEEVXSIZE = VECSIZE + INT( DLARAN( ISEED )*
628 $ DBLE( MAXSIZE-VECSIZE ) )
629*
630 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
631 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
632 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
633 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
634 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
635 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
636 $ TSTNRM, QTQNRM, NOUT )
637*
638.NE. IF( RES0 ) THEN
639 PASSED = 'failed stest 2'
640 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
641 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
642 INFO = 1
643 END IF
644 END IF
645*
646* Subtest 3: JOBZ = 'N', RANGE = 'A', minimum memory
647*
648.EQ. IF( INFO0 ) THEN
649*
650 JOBZ = 'n'
651 RANGE = 'a'
652 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
653 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
654 $ VECSIZE, VALSIZE )
655*
656 LHEEVXSIZE = VALSIZE
657 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
658 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
659 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
660 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
661 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
662 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
663 $ TSTNRM, QTQNRM, NOUT )
664*
665.NE. IF( RES0 ) THEN
666 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
667 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
668 PASSED = 'failed stest 3'
669 INFO = 1
670 END IF
671 END IF
672*
673* Subtest 4: JOBZ = 'N', RANGE = 'I', minimum memory
674*
675.EQ. IF( INFO0 ) THEN
676*
677 IL = -1
678 IU = -1
679 JOBZ = 'n'
680 RANGE = 'i'
681*
682* We use PZLASIZEHEEVX to choose IL and IU for us.
683*
684 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
685 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
686 $ VECSIZE, VALSIZE )
687*
688 LHEEVXSIZE = VALSIZE
689*
690 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
691 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
692 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
693 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
694 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
695 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
696 $ TSTNRM, QTQNRM, NOUT )
697*
698.NE. IF( RES0 ) THEN
699 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
700 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
701 PASSED = 'failed stest 4'
702 INFO = 1
703 END IF
704 END IF
705*
706* Subtest 5: JOBZ = 'V', RANGE = 'I', maximum memory
707*
708.EQ. IF( INFO0 ) THEN
709*
710 IL = -1
711 IU = -1
712 JOBZ = 'v'
713 RANGE = 'i'
714*
715* We use PZLASIZEHEEVX to choose IL and IU for us.
716*
717 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
718 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
719 $ VECSIZE, VALSIZE )
720*
721 LHEEVXSIZE = MAXSIZE
722*
723 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
724 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
725 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
726 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
727 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
728 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
729 $ TSTNRM, QTQNRM, NOUT )
730*
731.NE. IF( RES0 ) THEN
732 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
733 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
734 PASSED = 'failed stest 5'
735 INFO = 1
736 END IF
737 END IF
738*
739* Subtest 6: JOBZ = 'V', RANGE = 'I', minimum memory
740*
741.EQ. IF( INFO0 ) THEN
742 IL = -1
743 IU = -1
744 JOBZ = 'v'
745 RANGE = 'i'
746*
747* We use PZLASIZEHEEVX to choose IL and IU for us.
748*
749 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
750 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
751 $ VECSIZE, VALSIZE )
752*
753 LHEEVXSIZE = VECSIZE
754*
755 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
756 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
757 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
758 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
759 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
760 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
761 $ TSTNRM, QTQNRM, NOUT )
762*
763.NE. IF( RES0 ) THEN
764 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
765 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
766 PASSED = 'failed stest 6'
767 INFO = 1
768 END IF
769 END IF
770*
771* Subtest 7: JOBZ = 'V', RANGE = 'I', random memory
772*
773.EQ. IF( INFO0 ) THEN
774 IL = -1
775 IU = -1
776 JOBZ = 'v'
777 RANGE = 'i'
778*
779* We use PZLASIZEHEEVX to choose IL and IU for us.
780*
781 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
782 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
783 $ VECSIZE, VALSIZE )
784 LHEEVXSIZE = VECSIZE + INT( DLARAN( ISEED )*
785 $ DBLE( MAXSIZE-VECSIZE ) )
786*
787 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
788 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
789 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
790 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
791 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
792 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
793 $ TSTNRM, QTQNRM, NOUT )
794*
795.NE. IF( RES0 ) THEN
796 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
797 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
798 PASSED = 'failed stest 7'
799 INFO = 1
800 END IF
801 END IF
802*
803* Subtest 8: JOBZ = 'N', RANGE = 'V', minimum memory
804*
805.EQ. IF( INFO0 ) THEN
806 VL = ONE
807 VU = -ONE
808 JOBZ = 'n'
809 RANGE = 'v'
810*
811* We use PZLASIZEHEEVX to choose VL and VU for us.
812*
813 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
814 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
815 $ VECSIZE, VALSIZE )
816*
817 LHEEVXSIZE = VALSIZE
818*
819 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
820 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
821 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
822 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
823 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
824 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
825 $ TSTNRM, QTQNRM, NOUT )
826*
827.NE. IF( RES0 ) THEN
828 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
829 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
830 PASSED = 'failed stest 8'
831 INFO = 1
832 END IF
833 END IF
834*
835* Subtest 9: JOBZ = 'V', RANGE = 'V', maximum memory
836*
837.EQ. IF( INFO0 ) THEN
838 VL = ONE
839 VU = -ONE
840 JOBZ = 'v'
841 RANGE = 'v'
842*
843* We use PZLASIZEHEEVX to choose VL and VU for us.
844*
845 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
846 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
847 $ VECSIZE, VALSIZE )
848*
849 LHEEVXSIZE = MAXSIZE
850*
851 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
852 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
853 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
854 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
855 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
856 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
857 $ TSTNRM, QTQNRM, NOUT )
858*
859.NE. IF( RES0 ) THEN
860 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
861 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
862 PASSED = 'failed stest 9'
863 INFO = 1
864 END IF
865 END IF
866*
867* Subtest 10: JOBZ = 'V', RANGE = 'V',
868* minimum memory required for eigenvectors
869*
870.EQ. IF( INFO0 ) THEN
871 VL = ONE
872 VU = -ONE
873 JOBZ = 'v'
874 RANGE = 'v'
875*
876* We use PZLASIZEHEEVX to choose VL and VU for us.
877*
878 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
879 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
880 $ VECSIZE, VALSIZE )
881*
882 LHEEVXSIZE = VECSIZE
883*
884 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
885 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
886 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
887 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
888 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
889 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
890 $ TSTNRM, QTQNRM, NOUT )
891*
892.NE. IF( RES0 ) THEN
893 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
894 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
895 PASSED = 'failed stest10'
896 INFO = 1
897 END IF
898 END IF
899*
900* Subtest 11: JOBZ = 'V', RANGE = 'V',
901* random memory (enough for all eigenvectors
902* but not enough to guarantee orthogonality
903*
904.EQ. IF( INFO0 ) THEN
905 VL = ONE
906 VU = -ONE
907 JOBZ = 'v'
908 RANGE = 'v'
909*
910* We use PZLASIZEHEEVX to choose VL and VU for us.
911*
912 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
913 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
914 $ VECSIZE, VALSIZE )
915*
916*
917 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
918 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
919 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
920 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
921 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
922 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
923 $ TSTNRM, QTQNRM, NOUT )
924*
925.NE. IF( RES0 ) THEN
926 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
927 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
928 PASSED = 'failed stest11'
929 INFO = 1
930 END IF
931 END IF
932*
933* Subtest 12: JOBZ = 'V', RANGE = 'V',
934* miniimum memory required for eigenvalues only
935*
936.EQ. IF( INFO0 ) THEN
937 VL = ONE
938 VU = -ONE
939 JOBZ = 'v'
940 RANGE = 'v'
941*
942* We use PZLASIZEHEEVX to choose VL and VU for us.
943*
944 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
945 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
946 $ VECSIZE, VALSIZE )
947*
948 LHEEVXSIZE = VALSIZE
949*
950 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
951 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
952 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
953 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
954 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
955 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
956 $ TSTNRM, QTQNRM, NOUT )
957*
958.NE. IF( RES0 ) THEN
959 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
960 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
961 PASSED = 'failed stest12'
962 INFO = 1
963 END IF
964 END IF
965*
966* Subtest 13: JOBZ = 'V', RANGE = 'V',
967* random memory (more than minimum required
968* for eigenvalues, less than required for vectors)
969*
970.EQ. IF( INFO0 ) THEN
971 VL = ONE
972 VU = -ONE
973 JOBZ = 'v'
974 RANGE = 'v'
975*
976* We use PZLASIZEHEEVX to choose VL and VU for us.
977*
978 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
979 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
980 $ VECSIZE, VALSIZE )
981*
982*
983 CALL PZSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
984 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
985 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
986 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
987 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
988 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
989 $ TSTNRM, QTQNRM, NOUT )
990*
991.NE. IF( RES0 ) THEN
992 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
993 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
994 PASSED = 'failed stest13'
995 INFO = 1
996 END IF
997 END IF
998 END IF
999*
1000*
1001*
1002 CALL IGAMX2D( CONTEXT, 'all', ' ', 1, 1, INFO, 1, -1, -1, -1, -1,
1003 $ -1 )
1004*
1005.EQ. IF( INFO1 ) THEN
1006.EQ. IF( IAM0 ) THEN
1007 WRITE( NOUT, FMT = 9994 )'c '
1008 WRITE( NOUT, FMT = 9993 )ISEEDIN( 1 )
1009 WRITE( NOUT, FMT = 9992 )ISEEDIN( 2 )
1010 WRITE( NOUT, FMT = 9991 )ISEEDIN( 3 )
1011 WRITE( NOUT, FMT = 9990 )ISEEDIN( 4 )
1012 IF( LSAME( UPLO, 'l' ) ) THEN
1013 WRITE( NOUT, FMT = 9994 )' uplo= ''l'' '
1014 ELSE
1015 WRITE( NOUT, FMT = 9994 )' uplo= ''u'' '
1016 END IF
1017 IF( LSAME( SUBTESTS, 'y' ) ) THEN
1018 WRITE( NOUT, FMT = 9994 )' subtests= ''y'' '
1019 ELSE
1020 WRITE( NOUT, FMT = 9994 )' subtests= ''n'' '
1021 END IF
1022 WRITE( NOUT, FMT = 9989 )N
1023 WRITE( NOUT, FMT = 9988 )NPROW
1024 WRITE( NOUT, FMT = 9987 )NPCOL
1025 WRITE( NOUT, FMT = 9986 )NB
1026 WRITE( NOUT, FMT = 9985 )MATTYPE
1027 WRITE( NOUT, FMT = 9982 )ABSTOL
1028 WRITE( NOUT, FMT = 9981 )THRESH
1029 WRITE( NOUT, FMT = 9994 )'c '
1030 END IF
1031 END IF
1032*
1033 CALL SLCOMBINE( CONTEXT, 'all', '>', 'w', 6, 1, WTIME )
1034 CALL SLCOMBINE( CONTEXT, 'all', '>', 'c', 6, 1, CTIME )
1035.EQ. IF( IAM0 ) THEN
1036.EQ..OR..EQ. IF( INFO0 INFO1 ) THEN
1037.GE. IF( WTIME( 1 )0.0 ) THEN
1038 WRITE( NOUT, FMT = 9999 )N, NB, NPROW, NPCOL, MATTYPE,
1039 $ SUBTESTS, WTIME( 1 ), CTIME( 1 ), MAXTSTNRM,
1040 $ MAXQTQNRM, PASSED
1041 ELSE
1042 WRITE( NOUT, FMT = 9998 )N, NB, NPROW, NPCOL, MATTYPE,
1043 $ SUBTESTS, CTIME( 1 ), MAXTSTNRM, MAXQTQNRM, PASSED
1044 END IF
1045.EQ. ELSE IF( INFO2 ) THEN
1046.GE. IF( WTIME( 1 )0.0 ) THEN
1047 WRITE( NOUT, FMT = 9997 )N, NB, NPROW, NPCOL, MATTYPE,
1048 $ SUBTESTS, WTIME( 1 ), CTIME( 1 )
1049 ELSE
1050 WRITE( NOUT, FMT = 9996 )N, NB, NPROW, NPCOL, MATTYPE,
1051 $ SUBTESTS, CTIME( 1 )
1052 END IF
1053.EQ. ELSE IF( INFO3 ) THEN
1054 WRITE( NOUT, FMT = 9995 )N, NB, NPROW, NPCOL, MATTYPE,
1055 $ SUBTESTS
1056 END IF
1057 END IF
1058*
1059* Now that PZHEEVX been tested, we check PZHEEVD
1060*
1061 PASSED = 'passed eevd'
1062*
1063* PZHEEVD test1:
1064*
1065.EQ. IF( INFO0 ) THEN
1066*
1067 NP0 = NUMROC( N, NB, 0, 0, NPROW )
1068 NQ0 = NUMROC( MAX( N, 1 ), NB, 0, 0, NPCOL )
1069 LHEEVDSIZE = 1 + 9*N + 3*NP0*NQ0
1070 ISIZEHEEVD = MAX( 1, 2+7*N+8*NPCOL )
1071*
1072 CALL PZSDPSUBTST( WKNOWN, UPLO, N, THRESH, ABSTOL, A, COPYA, Z,
1073 $ 1, 1, DESCA, WIN, WNEW, IPREPAD, IPOSTPAD,
1074 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
1075 $ LHEEVDSIZE, IWORK, ISIZEHEEVD, RES, TSTNRM,
1076 $ QTQNRM, NOUT )
1077*
1078 MAXTSTNRM = TSTNRM
1079 MAXQTQNRM = QTQNRM
1080*
1081.NE. IF( RES0 ) THEN
1082 PASSED = 'failed eevd'
1083 INFO = 1
1084 END IF
1085 END IF
1086*
1087*
1088*
1089 CALL IGAMX2D( CONTEXT, 'all', ' ', 1, 1, INFO, 1, -1, -1, -1, -1,
1090 $ -1 )
1091*
1092.EQ. IF( INFO1 ) THEN
1093.EQ. IF( IAM0 ) THEN
1094 WRITE( NOUT, FMT = 9994 )'c '
1095 WRITE( NOUT, FMT = 9993 )ISEEDIN( 1 )
1096 WRITE( NOUT, FMT = 9992 )ISEEDIN( 2 )
1097 WRITE( NOUT, FMT = 9991 )ISEEDIN( 3 )
1098 WRITE( NOUT, FMT = 9990 )ISEEDIN( 4 )
1099 IF( LSAME( UPLO, 'l' ) ) THEN
1100 WRITE( NOUT, FMT = 9994 )' uplo= ''l'' '
1101 ELSE
1102 WRITE( NOUT, FMT = 9994 )' uplo= ''u'' '
1103 END IF
1104 IF( LSAME( SUBTESTS, 'y' ) ) THEN
1105 WRITE( NOUT, FMT = 9994 )' subtests= ''y'' '
1106 ELSE
1107 WRITE( NOUT, FMT = 9994 )' subtests= ''n'' '
1108 END IF
1109 WRITE( NOUT, FMT = 9989 )N
1110 WRITE( NOUT, FMT = 9988 )NPROW
1111 WRITE( NOUT, FMT = 9987 )NPCOL
1112 WRITE( NOUT, FMT = 9986 )NB
1113 WRITE( NOUT, FMT = 9985 )MATTYPE
1114 WRITE( NOUT, FMT = 9982 )ABSTOL
1115 WRITE( NOUT, FMT = 9981 )THRESH
1116 WRITE( NOUT, FMT = 9994 )'c '
1117 END IF
1118 END IF
1119*
1120 CALL SLCOMBINE( CONTEXT, 'all', '>', 'w', 6, 1, WTIME )
1121 CALL SLCOMBINE( CONTEXT, 'all', '>', 'c', 6, 1, CTIME )
1122.EQ. IF( IAM0 ) THEN
1123.EQ..OR..EQ. IF( INFO0 INFO1 ) THEN
1124.GE. IF( WTIME( 1 )0.0 ) THEN
1125 WRITE( NOUT, FMT = 9999 )N, NB, NPROW, NPCOL, MATTYPE,
1126 $ SUBTESTS, WTIME( 1 ), CTIME( 1 ), MAXTSTNRM,
1127 $ MAXQTQNRM, PASSED
1128 ELSE
1129 WRITE( NOUT, FMT = 9998 )N, NB, NPROW, NPCOL, MATTYPE,
1130 $ SUBTESTS, CTIME( 1 ), MAXTSTNRM, MAXQTQNRM, PASSED
1131 END IF
1132.EQ. ELSE IF( INFO2 ) THEN
1133.GE. IF( WTIME( 1 )0.0 ) THEN
1134 WRITE( NOUT, FMT = 9997 )N, NB, NPROW, NPCOL, MATTYPE,
1135 $ SUBTESTS, WTIME( 1 ), CTIME( 1 )
1136 ELSE
1137 WRITE( NOUT, FMT = 9996 )N, NB, NPROW, NPCOL, MATTYPE,
1138 $ SUBTESTS, CTIME( 1 )
1139 END IF
1140.EQ. ELSE IF( INFO3 ) THEN
1141 WRITE( NOUT, FMT = 9995 )N, NB, NPROW, NPCOL, MATTYPE,
1142 $ SUBTESTS
1143 END IF
1144 END IF
1145 120 CONTINUE
1146*
1147 RETURN
1148 9999 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, F8.2,
1149 $ 1X, F8.2, 1X, G9.2, 1X, G9.2, 1X, A14 )
1150 9998 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, 8X,
1151 $ 1X, F8.2, 1X, G9.2, 1X, G9.2, A14 )
1152 9997 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, F8.2,
1153 $ 1X, F8.2, 21X, 'bypassed' )
1154 9996 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 1X, 8X,
1155 $ 1X, F8.2, 21X, 'bypassed' )
1156 9995 FORMAT( 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 3X, A1, 32X,
1157 $ 'bad memory parameters' )
1158 9994 FORMAT( A )
1159 9993 FORMAT( ' iseed( 1 ) =', I8 )
1160 9992 FORMAT( ' iseed( 2 ) =', I8 )
1161 9991 FORMAT( ' iseed( 3 ) =', I8 )
1162 9990 FORMAT( ' iseed( 4 ) =', I8 )
1163 9989 FORMAT( ' n=', I8 )
1164 9988 FORMAT( ' nprow=', I8 )
1165 9987 FORMAT( ' npcol=', I8 )
1166 9986 FORMAT( ' nb=', I8 )
1167 9985 FORMAT( ' mattype=', I8 )
1168 9984 FORMAT( ' ibtype=', I8 )
1169 9983 FORMAT( ' subtests=', A1 )
1170 9982 FORMAT( ' abstol=', D16.6 )
1171 9981 FORMAT( ' thresh=', D16.6 )
1172 9980 FORMAT( ' increase totmem in pzsepdriver' )
1173*
1174* End of PZSEPTST
1175*
1176 END
pzmatgen
subroutine pzmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
Definition pzmatgen.f:4
stest
subroutine stest(len, scomp, strue, ssize, sfac)
Definition cblat1.f:609
dlabad
subroutine dlabad(small, large)
DLABAD
Definition dlabad.f:74
dlasrt
subroutine dlasrt(id, n, d, info)
DLASRT sorts numbers in increasing or decreasing order.
Definition dlasrt.f:88
zlatms
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS
Definition zlatms.f:332
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
blacs_gridinfo
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
Definition mpi.f:754
pzlaset
subroutine pzlaset(uplo, m, n, alpha, beta, a, ia, ja, desca)
Definition pzblastst.f:7509
pzchekpad
subroutine pzchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
Definition pzchekpad.f:3
pzelset
subroutine pzelset(a, ia, ja, desca, alpha)
Definition pzelset.f:2
pzfillpad
subroutine pzfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
Definition pzfillpad.f:2
pzlasizeheevx
subroutine pzlasizeheevx(wknown, range, n, desca, vl, vu, il, iu, iseed, win, maxsize, vecsize, valsize)
Definition pzlasizeheevx.f:5
pzlasizesep
subroutine pzlasizesep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, rsizeqtq, rsizechk, sizeheevx, rsizeheevx, isizeheevx, sizeheevd, rsizeheevd, isizeheevd, sizesubtst, rsizesubtst, isizesubtst, sizetst, rsizetst, isizetst)
Definition pzlasizesep.f:7
pzlatms
subroutine pzlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, ia, ja, desca, order, work, lwork, info)
Definition pzlatms.f:6
pzsepdriver
program pzsepdriver
Definition pzsepdriver.f:3
pzsepsubtst
subroutine pzsepsubtst(wknown, jobz, range, uplo, n, vl, vu, il, iu, thresh, abstol, a, copya, z, ia, ja, desca, win, wnew, ifail, iclustr, gap, iprepad, ipostpad, work, lwork, rwork, lrwork, lwork1, iwork, liwork, result, tstnrm, qtqnrm, nout)
Definition pzsepsubtst.f:9
pzseptst
subroutine pzseptst(desca, uplo, n, mattype, subtests, thresh, order, abstol, iseed, a, copya, z, lda, win, wnew, ifail, iclustr, gap, iprepad, ipostpad, work, lwork, rwork, lrwork, iwork, liwork, nout, info)
Definition pzseptst.f:8
slcombine
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)
Definition sltimer.f:267