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