OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pcseptst.f
Go to the documentation of this file.
1
2*
3 SUBROUTINE pcseptst( 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 REAL ABSTOL, THRESH
19* ..
20* .. Array Arguments ..
21 INTEGER DESCA( * ), ICLUSTR( * ), IFAIL( * ),
22 $ iseed( 4 ), iwork( * )
23 REAL GAP( * ), RWORK( * ), WIN( * ), WNEW( * )
24 COMPLEX A( LDA, * ), COPYA( LDA, * ), WORK( * ),
25 $ z( lda, * )
26* ..
27*
28* Purpose
29* =======
30*
31* PCSEPTST builds a random matrix, runs PCHEEVX() 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) REAL
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) REAL
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 ("PCSTEIN"),
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 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 PCHEEVX
153*
154* COPYA (local workspace) COMPLEX 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 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* PCSEPCHK and PCSEPQTQ
162*
163* W (local workspace) REAL array, dimension (N)
164* On normal exit from PCHEEVX, 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 array, dimension (LWORK)
170*
171* LWORK (local input) INTEGER
172* The length of the array WORK. LWORK >= SIZETST as
173* returned by PCLASIZESEP
174*
175* RWORK (local workspace) COMPLEX array, dimension (LWORK)
176*
177* LRWORK (local input) INTEGER
178* The length of the array WORK. LRWORK >= RSIZETST as
179* returned by PCLASIZESEP
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 PCLASIZESEP
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 REAL ZERO, ONE, TEN, HALF
211 parameter( zero = 0.0e+0, one = 1.0e+0, ten = 10.0e+0,
212 $ half = 0.5e+0 )
213 COMPLEX PADVAL
214 parameter( padval = ( 19.25e+0, 1.1e+1 ) )
215 COMPLEX CZERO
216 PARAMETER ( CZERO = ( 0.0e+0, 0.0e+0 ) )
217 COMPLEX CONE
218 parameter( cone = ( 1.0e+0, 0.0e+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, isizeheevd, isizeheevx,
229 $ isizesubtst, isizetst, itype, iu, j,
230 $ lheevdsize, lheevxsize, llrwork, llwork,
231 $ maxsize, mycol, myrow, nb, ngen, nloc, nnodes,
232 $ np, np0, npcol, nprow, nq, nq0, res, rsizechk,
233 $ rsizeheevd, rsizeheevx, rsizeqtq, rsizesubtst,
234 $ rsizetst, sizeheevd, sizeheevx, sizemqrleft,
235 $ sizemqrright, sizeqrf, sizesubtst, sizetms,
236 $ sizetst, valsize, vecsize
237 REAL 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 REAL PSLAMCH, SLARAN
250 EXTERNAL LSAME, NUMROC, PSLAMCH, SLARAN
251* ..
252* .. External Subroutines ..
253 EXTERNAL blacs_gridinfo, blacs_pinfo, clatms, igamx2d,
254 $ igebr2d, igebs2d, pcchekpad, pcelset,
255 $ pcfillpad, pclaset, pclasizeheevx, pclasizesep,
256 $ pclatms, pcmatgen, pcsdpsubtst, pcsepsubtst,
257 $ slabad, slasrt, slcombine
258* ..
259* .. Intrinsic Functions ..
260 INTRINSIC abs, int, max, min, real, 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 EEVX'
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 pclasizesep( desca, iprepad, ipostpad, sizemqrleft,
288 $ sizemqrright, sizeqrf, sizetms, rsizeqtq,
289 $ rsizechk, sizeheevx, rsizeheevx, isizeheevx,
290 $ sizeheevd, rsizeheevd, isizeheevd, sizesubtst,
291 $ rsizesubtst, isizesubtst, sizetst, rsizetst,
292 $ 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 = pslamch( context, 'p' )
309 ULPINV = ONE / ULP
310 UNFL = PSLAMCH( CONTEXT, 'safe min' )
311 OVFL = ONE / UNFL
312 CALL SLABAD( UNFL, OVFL )
313 RTUNFL = SQRT( UNFL )
314 RTOVFL = SQRT( OVFL )
315 ANINV = ONE / REAL( MAX( 1, N ) )
316*
317* This ensures that everyone starts out with the same seed.
318*
319.EQ..AND..EQ. IF( MYROW0 MYCOL0 ) 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.LE. IF( MATTYPE15 ) THEN
367 COND = ULPINV
368 ELSE
369 COND = ULPINV*ANINV / TEN
370 END IF
371*
372* Special Matrices
373*
374* Zero
375*
376*
377.EQ. IF( ITYPE1 ) THEN
378*
379* Zero Matrix
380*
381 DO 50 I = 1, N
382 RWORK( INDD+I-1 ) = ZERO
383 50 CONTINUE
384 CALL PCLASET( 'all', N, N, CZERO, CZERO, COPYA, 1, 1,
385 $ DESCA )
386 WKNOWN = .TRUE.
387*
388.EQ. ELSE IF( ITYPE2 ) THEN
389*
390* Identity Matrix
391*
392 DO 60 I = 1, N
393 RWORK( INDD+I-1 ) = ONE
394 60 CONTINUE
395 CALL PCLASET( 'all', N, N, CZERO, CONE, COPYA, 1, 1, DESCA )
396 WKNOWN = .TRUE.
397*
398.EQ. ELSE IF( ITYPE4 ) THEN
399*
400* Diagonal Matrix, [Eigen]values Specified
401*
402 CALL PCFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ),
403 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+1.0E+0 )
404*
405 CALL PCLATMS( 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 PCCHEKPAD( DESCA( CTXT_ ), 'pclatms1-work', SIZETMS, 1,
412 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
413 $ PADVAL+1.0E+0 )
414*
415.EQ. ELSE IF( ITYPE5 ) THEN
416*
417* Hermitian, eigenvalues specified
418*
419 CALL PCFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ),
420 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+2.0E+0 )
421*
422 CALL PCLATMS( 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 PCCHEKPAD( DESCA( CTXT_ ), 'pclatms2-work', SIZETMS, 1,
428 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
429 $ PADVAL+2.0E+0 )
430*
431 WKNOWN = .TRUE.
432*
433.EQ. ELSE IF( ITYPE8 ) 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 PCMATGEN( 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.EQ. ELSE IF( ITYPE9 ) THEN
447*
448* Positive definite, eigenvalues specified.
449*
450*
451 CALL PCFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ),
452 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+3.0E+0 )
453*
454 CALL PCLATMS( 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 PCCHEKPAD( DESCA( CTXT_ ), 'pclatms3-work', SIZETMS, 1,
462 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
463 $ PADVAL+3.0E+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 PCLASET( 'all', N, N, CZERO, CZERO, 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( SLARAN( ISEED )*REAL( NLOC ) ), N-NGEN )
480*
481 CALL CLATMS( 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 PCELSET( COPYA, NGEN+1, NGEN+1, DESCA, A( 1, 1 ) )
495 DO 90 I = 2, IN
496 CALL PCELSET( COPYA, NGEN+I, NGEN+I, DESCA,
497 $ A( I, I ) )
498 CALL PCELSET( COPYA, NGEN+I-1, NGEN+I, DESCA,
499 $ A( I-1, I ) )
500 CALL PCELSET( 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 PCFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ),
529 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+4.0E+0 )
530*
531 CALL PCLATMS( 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 PCCHEKPAD( DESCA( CTXT_ ), 'pclatms4-work', SIZETMS, 1,
537 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
538 $ PADVAL+4.0E+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 SLASRT( '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 PCLASIZEHEEVX( 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 PCSEPSUBTST( 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.LE. IF( THRESHZERO ) THEN
579 PASSED = 'skipped '
580 INFO = 2
581.NE. ELSE IF( RES0 ) THEN
582 PASSED = 'failed '
583 INFO = 1
584 END IF
585 END IF
586*
587.GT..AND. IF( THRESHZERO LSAME( SUBTESTS, 'y' ) ) THEN
588*
589* Subtest 1: JOBZ = 'V', RANGE = 'A', minimum memory
590*
591.EQ. IF( INFO0 ) THEN
592*
593 JOBZ = 'v'
594 RANGE = 'a'
595 CALL PCLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
596 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
597 $ VECSIZE, VALSIZE )
598*
599 LHEEVXSIZE = VECSIZE
600*
601 CALL PCSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
602 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
603 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
604 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
605 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
606 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
607 $ TSTNRM, QTQNRM, NOUT )
608*
609.NE. IF( RES0 ) THEN
610 PASSED = 'failed stest 1'
611 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
612 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
613 INFO = 1
614 END IF
615 END IF
616*
617* Subtest 2: JOBZ = 'V', RANGE = 'A', random memory
618*
619.EQ. IF( INFO0 ) THEN
620 JOBZ = 'v'
621 RANGE = 'a'
622 CALL PCLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
623 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
624 $ VECSIZE, VALSIZE )
625*
626 LHEEVXSIZE = VECSIZE + INT( SLARAN( ISEED )*
627 $ REAL( MAXSIZE-VECSIZE ) )
628*
629 CALL PCSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
630 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
631 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
632 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
633 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
634 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
635 $ TSTNRM, QTQNRM, NOUT )
636*
637.NE. IF( RES0 ) THEN
638 PASSED = 'failed stest 2'
639 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
640 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
641 INFO = 1
642 END IF
643 END IF
644*
645* Subtest 3: JOBZ = 'N', RANGE = 'A', minimum memory
646*
647.EQ. IF( INFO0 ) THEN
648*
649 JOBZ = 'n'
650 RANGE = 'a'
651 CALL PCLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
652 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
653 $ VECSIZE, VALSIZE )
654*
655 LHEEVXSIZE = VALSIZE
656 CALL PCSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
657 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
658 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
659 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
660 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
661 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
662 $ TSTNRM, QTQNRM, NOUT )
663*
664.NE. IF( RES0 ) THEN
665 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
666 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
667 PASSED = 'failed stest 3'
668 INFO = 1
669 END IF
670 END IF
671*
672* Subtest 4: JOBZ = 'N', RANGE = 'I', minimum memory
673*
674.EQ. IF( INFO0 ) THEN
675*
676 IL = -1
677 IU = -1
678 JOBZ = 'n'
679 RANGE = 'i'
680*
681* We use PCLASIZEHEEVX to choose IL and IU for us.
682*
683 CALL PCLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
684 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
685 $ VECSIZE, VALSIZE )
686*
687 LHEEVXSIZE = VALSIZE
688*
689 CALL PCSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
690 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
691 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
692 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
693 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
694 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
695 $ TSTNRM, QTQNRM, NOUT )
696*
697.NE. IF( RES0 ) THEN
698 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
699 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
700 PASSED = 'failed stest 4'
701 INFO = 1
702 END IF
703 END IF
704*
705* Subtest 5: JOBZ = 'V', RANGE = 'I', maximum memory
706*
707.EQ. IF( INFO0 ) THEN
708*
709 IL = -1
710 IU = -1
711 JOBZ = 'v'
712 RANGE = 'i'
713*
714* We use PCLASIZEHEEVX to choose IL and IU for us.
715*
716 CALL PCLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
717 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
718 $ VECSIZE, VALSIZE )
719*
720 LHEEVXSIZE = MAXSIZE
721*
722 CALL PCSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
723 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
724 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
725 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
726 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
727 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
728 $ TSTNRM, QTQNRM, NOUT )
729*
730.NE. IF( RES0 ) THEN
731 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
732 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
733 PASSED = 'failed stest 5'
734 INFO = 1
735 END IF
736 END IF
737*
738* Subtest 6: JOBZ = 'V', RANGE = 'I', minimum memory
739*
740.EQ. IF( INFO0 ) THEN
741 IL = -1
742 IU = -1
743 JOBZ = 'v'
744 RANGE = 'i'
745*
746* We use PCLASIZEHEEVX to choose IL and IU for us.
747*
748 CALL PCLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
749 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
750 $ VECSIZE, VALSIZE )
751*
752 LHEEVXSIZE = VECSIZE
753*
754 CALL PCSEPSUBTST( .TRUE., JOBZ, RANGE, UPLO, N, VL, VU, IL,
755 $ IU, THRESH, ABSTOL, A, COPYA, Z, 1, 1,
756 $ DESCA, WIN( 1+IPREPAD ), WNEW, IFAIL,
757 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
758 $ WORK( INDWORK ), LLWORK, RWORK, LRWORK,
759 $ LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
760 $ TSTNRM, QTQNRM, NOUT )
761*
762.NE. IF( RES0 ) THEN
763 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
764 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
765 PASSED = 'failed stest 6'
766 INFO = 1
767 END IF
768 END IF
769*
770* Subtest 7: JOBZ = 'V', RANGE = 'I', random memory
771*
772.EQ. IF( INFO0 ) THEN
773 IL = -1
774 IU = -1
775 JOBZ = 'v'
776 range = 'I'
777*
778* We use PCLASIZEHEEVX to choose IL and IU for us.
779*
780 CALL pclasizeheevx( .true., range, n, desca, vl, vu, il, iu,
781 $ iseed, win( 1+iprepad ), maxsize,
782 $ vecsize, valsize )
783 lheevxsize = vecsize + int( slaran( iseed )*
784 $ real( maxsize-vecsize ) )
785*
786 CALL pcsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
787 $ iu, thresh, abstol, a, copya, z, 1, 1,
788 $ desca, win( 1+iprepad ), wnew, ifail,
789 $ iclustr, gap, iprepad, ipostpad,
790 $ work( indwork ), llwork, rwork, lrwork,
791 $ lheevxsize, iwork, isizeheevx, res,
792 $ tstnrm, qtqnrm, nout )
793*
794 IF( res.NE.0 ) THEN
795 maxtstnrm = max( tstnrm, maxtstnrm )
796 maxqtqnrm = max( qtqnrm, maxqtqnrm )
797 passed = 'FAILED stest 7'
798 info = 1
799 END IF
800 END IF
801*
802* Subtest 8: JOBZ = 'N', RANGE = 'V', minimum memory
803*
804 IF( info.EQ.0 ) THEN
805 vl = one
806 vu = -one
807 jobz = 'N'
808 range = 'V'
809*
810* We use PCLASIZEHEEVX to choose VL and VU for us.
811*
812 CALL pclasizeheevx( .true., range, n, desca, vl, vu, il, iu,
813 $ iseed, win( 1+iprepad ), maxsize,
814 $ vecsize, valsize )
815*
816 lheevxsize = valsize
817*
818 CALL pcsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
819 $ iu, thresh, abstol, a, copya, z, 1, 1,
820 $ desca, win( 1+iprepad ), wnew, ifail,
821 $ iclustr, gap, iprepad, ipostpad,
822 $ work( indwork ), llwork, rwork, lrwork,
823 $ lheevxsize, iwork, isizeheevx, res,
824 $ tstnrm, qtqnrm, nout )
825*
826 IF( res.NE.0 ) THEN
827 maxtstnrm = max( tstnrm, maxtstnrm )
828 maxqtqnrm = max( qtqnrm, maxqtqnrm )
829 passed = 'FAILED stest 8'
830 info = 1
831 END IF
832 END IF
833*
834* Subtest 9: JOBZ = 'V', RANGE = 'V', maximum memory
835*
836 IF( info.EQ.0 ) THEN
837 vl = one
838 vu = -one
839 jobz = 'V'
840 range = 'V'
841*
842* We use PCLASIZEHEEVX to choose VL and VU for us.
843*
844 CALL pclasizeheevx( .true., range, n, desca, vl, vu, il, iu,
845 $ iseed, win( 1+iprepad ), maxsize,
846 $ vecsize, valsize )
847*
848 lheevxsize = maxsize
849*
850 CALL pcsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
851 $ iu, thresh, abstol, a, copya, z, 1, 1,
852 $ desca, win( 1+iprepad ), wnew, ifail,
853 $ iclustr, gap, iprepad, ipostpad,
854 $ work( indwork ), llwork, rwork, lrwork,
855 $ lheevxsize, iwork, isizeheevx, res,
856 $ tstnrm, qtqnrm, nout )
857*
858 IF( res.NE.0 ) THEN
859 maxtstnrm = max( tstnrm, maxtstnrm )
860 maxqtqnrm = max( qtqnrm, maxqtqnrm )
861 passed = 'FAILED stest 9'
862 info = 1
863 END IF
864 END IF
865*
866* Subtest 10: JOBZ = 'V', RANGE = 'V',
867* minimum memory required for eigenvectors
868*
869 IF( info.EQ.0 ) THEN
870 vl = one
871 vu = -one
872 jobz = 'V'
873 range = 'V'
874*
875* We use PCLASIZEHEEVX to choose VL and VU for us.
876*
877 CALL pclasizeheevx( .true., range, n, desca, vl, vu, il, iu,
878 $ iseed, win( 1+iprepad ), maxsize,
879 $ vecsize, valsize )
880*
881 lheevxsize = vecsize
882*
883 CALL pcsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
884 $ iu, thresh, abstol, a, copya, z, 1, 1,
885 $ desca, win( 1+iprepad ), wnew, ifail,
886 $ iclustr, gap, iprepad, ipostpad,
887 $ work( indwork ), llwork, rwork, lrwork,
888 $ lheevxsize, iwork, isizeheevx, res,
889 $ tstnrm, qtqnrm, nout )
890*
891 IF( res.NE.0 ) THEN
892 maxtstnrm = max( tstnrm, maxtstnrm )
893 maxqtqnrm = max( qtqnrm, maxqtqnrm )
894 passed = 'FAILED stest10'
895 info = 1
896 END IF
897 END IF
898*
899* Subtest 11: JOBZ = 'V', RANGE = 'V',
900* random memory (enough for all eigenvectors
901* but not enough to guarantee orthogonality
902*
903 IF( info.EQ.0 ) THEN
904 vl = one
905 vu = -one
906 jobz = 'V'
907 range = 'V'
908*
909* We use PCLASIZEHEEVX to choose VL and VU for us.
910*
911 CALL pclasizeheevx( .true., range, n, desca, vl, vu, il, iu,
912 $ iseed, win( 1+iprepad ), maxsize,
913 $ vecsize, valsize )
914*
915*
916 CALL pcsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
917 $ iu, thresh, abstol, a, copya, z, 1, 1,
918 $ desca, win( 1+iprepad ), wnew, ifail,
919 $ iclustr, gap, iprepad, ipostpad,
920 $ work( indwork ), llwork, rwork, lrwork,
921 $ lheevxsize, iwork, isizeheevx, res,
922 $ tstnrm, qtqnrm, nout )
923*
924 IF( res.NE.0 ) THEN
925 maxtstnrm = max( tstnrm, maxtstnrm )
926 maxqtqnrm = max( qtqnrm, maxqtqnrm )
927 passed = 'FAILED stest11'
928 info = 1
929 END IF
930 END IF
931*
932* Subtest 12: JOBZ = 'V', RANGE = 'V',
933* miniimum memory required for eigenvalues only
934*
935 IF( info.EQ.0 ) THEN
936 vl = one
937 vu = -one
938 jobz = 'V'
939 range = 'V'
940*
941* We use PCLASIZEHEEVX to choose VL and VU for us.
942*
943 CALL pclasizeheevx( .true., range, n, desca, vl, vu, il, iu,
944 $ iseed, win( 1+iprepad ), maxsize,
945 $ vecsize, valsize )
946*
947 lheevxsize = valsize
948*
949 CALL pcsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
950 $ iu, thresh, abstol, a, copya, z, 1, 1,
951 $ desca, win( 1+iprepad ), wnew, ifail,
952 $ iclustr, gap, iprepad, ipostpad,
953 $ work( indwork ), llwork, rwork, lrwork,
954 $ lheevxsize, iwork, isizeheevx, res,
955 $ tstnrm, qtqnrm, nout )
956*
957 IF( res.NE.0 ) THEN
958 maxtstnrm = max( tstnrm, maxtstnrm )
959 maxqtqnrm = max( qtqnrm, maxqtqnrm )
960 passed = 'FAILED stest12'
961 info = 1
962 END IF
963 END IF
964*
965* Subtest 13: JOBZ = 'V', RANGE = 'V',
966* random memory (more than minimum required
967* for eigenvalues, less than required for vectors)
968*
969 IF( info.EQ.0 ) THEN
970 vl = one
971 vu = -one
972 jobz = 'V'
973 range = 'V'
974*
975* We use PCLASIZEHEEVX to choose VL and VU for us.
976*
977 CALL pclasizeheevx( .true., range, n, desca, vl, vu, il, iu,
978 $ iseed, win( 1+iprepad ), maxsize,
979 $ vecsize, valsize )
980*
981*
982 CALL pcsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
983 $ iu, thresh, abstol, a, copya, z, 1, 1,
984 $ desca, win( 1+iprepad ), wnew, ifail,
985 $ iclustr, gap, iprepad, ipostpad,
986 $ work( indwork ), llwork, rwork, lrwork,
987 $ lheevxsize, iwork, isizeheevx, res,
988 $ tstnrm, qtqnrm, nout )
989*
990 IF( res.NE.0 ) THEN
991 maxtstnrm = max( tstnrm, maxtstnrm )
992 maxqtqnrm = max( qtqnrm, maxqtqnrm )
993 passed = 'FAILED stest13'
994 info = 1
995 END IF
996 END IF
997 END IF
998*
999*
1000*
1001 CALL igamx2d( context, 'All', ' ', 1, 1, info, 1, -1, -1, -1, -1,
1002 $ -1 )
1003*
1004 IF( info.EQ.1 ) THEN
1005 IF( iam.EQ.0 ) THEN
1006 WRITE( nout, fmt = 9994 )'C '
1007 WRITE( nout, fmt = 9993 )iseedin( 1 )
1008 WRITE( nout, fmt = 9992 )iseedin( 2 )
1009 WRITE( nout, fmt = 9991 )iseedin( 3 )
1010 WRITE( nout, fmt = 9990 )iseedin( 4 )
1011 IF( lsame( uplo, 'L' ) ) THEN
1012 WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
1013 ELSE
1014 WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
1015 END IF
1016 IF( lsame( subtests, 'Y' ) ) THEN
1017 WRITE( nout, fmt = 9994 )' SUBTESTS= ''Y'' '
1018 ELSE
1019 WRITE( nout, fmt = 9994 )' SUBTESTS= ''N'' '
1020 END IF
1021 WRITE( nout, fmt = 9989 )n
1022 WRITE( nout, fmt = 9988 )nprow
1023 WRITE( nout, fmt = 9987 )npcol
1024 WRITE( nout, fmt = 9986 )nb
1025 WRITE( nout, fmt = 9985 )mattype
1026 WRITE( nout, fmt = 9982 )abstol
1027 WRITE( nout, fmt = 9981 )thresh
1028 WRITE( nout, fmt = 9994 )'C '
1029 END IF
1030 END IF
1031*
1032 CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
1033 CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
1034 IF( iam.EQ.0 ) THEN
1035 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1036 IF( wtime( 1 ).GE.0.0 ) THEN
1037 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1038 $ subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
1039 $ maxqtqnrm, passed
1040 ELSE
1041 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1042 $ subtests, ctime( 1 ), maxtstnrm, maxqtqnrm, passed
1043 END IF
1044 ELSE IF( info.EQ.2 ) THEN
1045 IF( wtime( 1 ).GE.0.0 ) THEN
1046 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1047 $ subtests, wtime( 1 ), ctime( 1 )
1048 ELSE
1049 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1050 $ subtests, ctime( 1 )
1051 END IF
1052 ELSE IF( info.EQ.3 ) THEN
1053 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1054 $ subtests
1055 END IF
1056 END IF
1057*
1058* Now that PCHEEVX been tested, we check PCHEEVD
1059*
1060 passed = 'PASSED EEVD'
1061*
1062* PCHEEVD test1:
1063*
1064 IF( info.EQ.0 ) THEN
1065*
1066 np0 = numroc( n, nb, 0, 0, nprow )
1067 nq0 = numroc( max( n, 1 ), nb, 0, 0, npcol )
1068 lheevdsize = 1 + 9*n + 3*np0*nq0
1069 isizeheevd = max( 1, 2+7*n+8*npcol )
1070*
1071 CALL pcsdpsubtst( wknown, uplo, n, thresh, abstol, a, copya, z,
1072 $ 1, 1, desca, win, wnew, iprepad, ipostpad,
1073 $ work( indwork ), llwork, rwork, lrwork,
1074 $ lheevdsize, iwork, isizeheevd, res, tstnrm,
1075 $ qtqnrm, nout )
1076*
1077 maxtstnrm = tstnrm
1078 maxqtqnrm = qtqnrm
1079
1080 IF( res.NE.0 ) THEN
1081 passed = 'FAILED EEVD'
1082 info = 1
1083 END IF
1084 END IF
1085*
1086*
1087*
1088 CALL igamx2d( context, 'All', ' ', 1, 1, info, 1, -1, -1, -1, -1,
1089 $ -1 )
1090*
1091 IF( info.EQ.1 ) THEN
1092 IF( iam.EQ.0 ) THEN
1093 WRITE( nout, fmt = 9994 )'C '
1094 WRITE( nout, fmt = 9993 )iseedin( 1 )
1095 WRITE( nout, fmt = 9992 )iseedin( 2 )
1096 WRITE( nout, fmt = 9991 )iseedin( 3 )
1097 WRITE( nout, fmt = 9990 )iseedin( 4 )
1098 IF( lsame( uplo, 'L' ) ) THEN
1099 WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
1100 ELSE
1101 WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
1102 END IF
1103 IF( lsame( subtests, 'Y' ) ) THEN
1104 WRITE( nout, fmt = 9994 )' SUBTESTS= ''Y'' '
1105 ELSE
1106 WRITE( nout, fmt = 9994 )' SUBTESTS= ''N'' '
1107 END IF
1108 WRITE( nout, fmt = 9989 )n
1109 WRITE( nout, fmt = 9988 )nprow
1110 WRITE( nout, fmt = 9987 )npcol
1111 WRITE( nout, fmt = 9986 )nb
1112 WRITE( nout, fmt = 9985 )mattype
1113 WRITE( nout, fmt = 9982 )abstol
1114 WRITE( nout, fmt = 9981 )thresh
1115 WRITE( nout, fmt = 9994 )'C '
1116 END IF
1117 END IF
1118*
1119 CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
1120 CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
1121 IF( iam.EQ.0 ) THEN
1122 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1123 IF( wtime( 1 ).GE.0.0 ) THEN
1124 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1125 $ subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
1126 $ maxqtqnrm, passed
1127 ELSE
1128 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1129 $ subtests, ctime( 1 ), maxtstnrm, maxqtqnrm, passed
1130 END IF
1131 ELSE IF( info.EQ.2 ) THEN
1132 IF( wtime( 1 ).GE.0.0 ) THEN
1133 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1134 $ subtests, wtime( 1 ), ctime( 1 )
1135 ELSE
1136 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1137 $ subtests, ctime( 1 )
1138 END IF
1139 ELSE IF( info.EQ.3 ) THEN
1140 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1141 $ subtests
1142 END IF
1143 END IF
1144 120 CONTINUE
1145*
1146 RETURN
1147 9999 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, f8.2,
1148 $ 1x, f8.2, 1x, g9.2, 1x, g9.2, 1x, a14 )
1149 9998 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, 8x,
1150 $ 1x, f8.2, 1x, g9.2, 1x, g9.2, a14 )
1151 9997 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, f8.2,
1152 $ 1x, f8.2, 21x, 'Bypassed' )
1153 9996 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, 8x,
1154 $ 1x, f8.2, 21x, 'Bypassed' )
1155 9995 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 32x,
1156 $ 'Bad MEMORY parameters' )
1157 9994 FORMAT( a )
1158 9993 FORMAT( ' ISEED( 1 ) =', i8 )
1159 9992 FORMAT( ' ISEED( 2 ) =', i8 )
1160 9991 FORMAT( ' ISEED( 3 ) =', i8 )
1161 9990 FORMAT( ' ISEED( 4 ) =', i8 )
1162 9989 FORMAT( ' N=', i8 )
1163 9988 FORMAT( ' NPROW=', i8 )
1164 9987 FORMAT( ' NPCOL=', i8 )
1165 9986 FORMAT( ' NB=', i8 )
1166 9985 FORMAT( ' MATTYPE=', i8 )
1167 9984 FORMAT( ' IBTYPE=', i8 )
1168 9983 FORMAT( ' SUBTESTS=', a1 )
1169 9982 FORMAT( ' ABSTOL=', d16.6 )
1170 9981 FORMAT( ' THRESH=', d16.6 )
1171 9980 FORMAT( ' Increase TOTMEM in PCSEPDRIVER' )
1172*
1173* End of PCSEPTST
1174*
1175 END
pcmatgen
subroutine pcmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
Definition pcmatgen.f:4
stest
subroutine stest(len, scomp, strue, ssize, sfac)
Definition cblat1.f:609
slabad
subroutine slabad(small, large)
SLABAD
Definition slabad.f:74
slasrt
subroutine slasrt(id, n, d, info)
SLASRT sorts numbers in increasing or decreasing order.
Definition slasrt.f:88
clatms
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
Definition clatms.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
pclaset
subroutine pclaset(uplo, m, n, alpha, beta, a, ia, ja, desca)
Definition pcblastst.f:7508
pcchekpad
subroutine pcchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
Definition pcchekpad.f:3
pcelset
subroutine pcelset(a, ia, ja, desca, alpha)
Definition pcelset.f:2
pcfillpad
subroutine pcfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
Definition pcfillpad.f:2
pclasizeheevx
subroutine pclasizeheevx(wknown, range, n, desca, vl, vu, il, iu, iseed, win, maxsize, vecsize, valsize)
Definition pclasizeheevx.f:5
pclasizesep
subroutine pclasizesep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, rsizeqtq, rsizechk, sizeheevx, rsizeheevx, isizeheevx, sizeheevd, rsizeheevd, isizeheevd, sizesubtst, rsizesubtst, isizesubtst, sizetst, rsizetst, isizetst)
Definition pclasizesep.f:7
pclatms
subroutine pclatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, ia, ja, desca, order, work, lwork, info)
Definition pclatms.f:6
pcsdpsubtst
subroutine pcsdpsubtst(wknown, uplo, n, thresh, abstol, a, copya, z, ia, ja, desca, win, wnew, iprepad, ipostpad, work, lwork, rwork, lrwork, lwork1, iwork, liwork, result, tstnrm, qtqnrm, nout)
Definition pcsdpsubtst.f:6
pcsepsubtst
subroutine pcsepsubtst(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 pcsepsubtst.f:9
pcseptst
subroutine pcseptst(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 pcseptst.f:8
slcombine
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)
Definition sltimer.f:267