OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pzgseptst.f
Go to the documentation of this file.
1*
2*
3 SUBROUTINE pzgseptst( 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 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, * ), B( LDA, * ), COPYA( LDA, * ),
25 $ copyb( lda, * ), work( * ), z( lda, * )
26* ..
27*
28* Purpose
29* =======
30*
31* PZGSEPTST builds a random matrix A, and a well conditioned
32* matrix B, runs PZHEGVX() to compute the eigenvalues
33* and eigenvectors and then calls PZHEGVCHK 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) DOUBLE PRECISION
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) DOUBLE PRECISION
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 ("PZSTEIN"),
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*16 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 PZHEGVX
156*
157* COPYA (local workspace) COMPLEX*16 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*16 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 PZHEGVX
166*
167* COPYB (local workspace) COMPLEX*16 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*16 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* PZGSEPCHK
175*
176* W (local workspace) DOUBLE PRECISION array, dimension (N)
177* On normal exit from PZHEGVX, 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*16 array, dimension (LWORK)
183*
184* LWORK (local input) INTEGER
185* The length of the array WORK. LWORK >= SIZETST as
186* returned by PZLASIZEGSEP
187*
188* RWORK (local workspace) COMPLEX*16 array, dimension (LWORK)
189*
190* LRWORK (local input) INTEGER
191* The length of the array WORK. LRWORK >= RSIZETST as
192* returned by PZLASIZEGSEP
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 PZLASIZEGSEP
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 DOUBLE PRECISION ZERO, ONE, TEN, HALF
224 parameter( zero = 0.0d+0, one = 1.0d+0, ten = 10.0d+0,
225 $ half = 0.5d+0 )
226 COMPLEX*16 PADVAL
227 parameter( padval = ( 19.25d+0, 1.1d+1 ) )
228 COMPLEX*16 ZZERO
229 PARAMETER ( ZZERO = ( 0.0d+0, 0.0d+0 ) )
230 COMPLEX*16 ZONE
231 parameter( zone = ( 1.0d+0, 0.0d+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 DOUBLE PRECISION 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 DOUBLE PRECISION DLARAN, PDLAMCH
261 EXTERNAL LSAME, NUMROC, DLARAN, PDLAMCH
262* ..
263* .. External Subroutines ..
264 EXTERNAL blacs_gridinfo, blacs_pinfo, dlabad, dlasrt,
265 $ igamx2d, igebr2d, igebs2d, pzchekpad, pzelset,
266 $ pzfillpad, pzgsepsubtst, pzlaset, pzlasizegsep,
267 $ pzlasizeheevx, pzlatms, pzmatgen, slcombine,
268 $ zlatms
269* ..
270* .. Intrinsic Functions ..
271 INTRINSIC abs, dble, int, max, min, mod, 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 pzlasizegsep( 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 = pdlamch( context, 'P' )
319 ulpinv = one / ulp
320 unfl = pdlamch( context, 'Safe min' )
321 ovfl = one / unfl
322 CALL dlabad( unfl, ovfl )
323 rtunfl = sqrt( unfl )
324 rtovfl = sqrt( ovfl )
325 aninv = one / dble( 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 pzlaset( 'All', n, n, zzero, zzero, 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 pzlaset( 'All', n, n, zzero, zone, 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 pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
413 $ sizetms, iprepad, ipostpad, padval+1.0d+0 )
414*
415 CALL pzlatms( 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 pzchekpad( desca( ctxt_ ), 'PZLATMS1-WORK', sizetms, 1,
422 $ work( indwork ), sizetms, iprepad, ipostpad,
423 $ padval+1.0d+0 )
424*
425 ELSE IF( itype.EQ.5 ) THEN
426*
427* Hermitian, eigenvalues specified
428*
429 CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
430 $ sizetms, iprepad, ipostpad, padval+2.0d+0 )
431*
432 CALL pzlatms( 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 pzchekpad( desca( ctxt_ ), 'PZLATMS2-WORK', sizetms, 1,
438 $ work( indwork ), sizetms, iprepad, ipostpad,
439 $ padval+2.0d+0 )
440*
441 wknown = .true.
442*
443 ELSE IF( itype.EQ.8 ) 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 pzmatgen( 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 ELSE IF( itype.EQ.9 ) THEN
457*
458* Positive definite, eigenvalues specified.
459*
460*
461 CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
462 $ sizetms, iprepad, ipostpad, padval+3.0d+0 )
463*
464 CALL pzlatms( 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 pzchekpad( desca( ctxt_ ), 'pzlatms3-work', SIZETMS, 1,
472 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
473 $ PADVAL+3.0D+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 PZLASET( 'all', N, N, ZZERO, ZZERO, 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( DLARAN( ISEED )*DBLE( NLOC ) ), N-NGEN )
490*
491 CALL ZLATMS( 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 PZELSET( COPYA, NGEN+1, NGEN+1, DESCA, A( 1, 1 ) )
505 DO 90 I = 2, IN
506 CALL PZELSET( COPYA, NGEN+I, NGEN+I, DESCA,
507 $ A( I, I ) )
508 CALL PZELSET( COPYA, NGEN+I-1, NGEN+I, DESCA,
509 $ A( I-1, I ) )
510 CALL PZELSET( 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 PZFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ),
539 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+4.0D+0 )
540*
541 CALL PZLATMS( 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 PZCHEKPAD( DESCA( CTXT_ ), 'pzlatms4-work', SIZETMS, 1,
547 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
548 $ PADVAL+4.0D+0 )
549*
550*
551* WKNOWN ... NOT SET, GUESS A DEFAULT
552*
553 WKNOWN = .TRUE.
554 ELSE
555 IINFO = 1
556 END IF
557*
558 IF( WKNOWN )
559 $ CALL DLASRT( 'i', N, RWORK( INDD ), IINFO )
560*
561* Create the B matrix
562*
563 CALL PZFILLPAD( DESCA( CTXT_ ), SIZETMS, 1, WORK( INDWORK ),
564 $ SIZETMS, IPREPAD, IPOSTPAD, PADVAL+3.3D+0 )
565*
566 ANORM = ONE
567*
568* Update ISEED so that {ZLAGSY creates a different Q
569*
570 ISEED( 4 ) = MOD( ISEED( 4 )+257, 4096 )
571 ISEED( 3 ) = MOD( ISEED( 3 )+192, 4096 )
572 ISEED( 2 ) = MOD( ISEED( 2 )+35, 4096 )
573 ISEED( 1 ) = MOD( ISEED( 1 )+128, 4096 )
574 CALL PZLATMS( N, N, 's', ISEED, 'p', RWORK( INDD ), 3, TEN,
575 $ ANORM, N, N, 'n', COPYB, 1, 1, DESCA, ORDER,
576 $ WORK( INDWORK+IPREPAD ), SIZETMS, IINFO )
577*
578 CALL PZCHEKPAD( DESCA( CTXT_ ), 'pzlatms5-work', SIZETMS, 1,
579 $ WORK( INDWORK ), SIZETMS, IPREPAD, IPOSTPAD,
580 $ PADVAL+3.3D+0 )
581*
582*
583* These values aren't actually used, but they make ftncheck happy.
584*
585 IL = -1
586 IU = -2
587 VL = ONE
588 VU = -ONE
589*
590 CALL PZLASIZEHEEVX( WKNOWN, 'a', N, DESCA, VL, VU, IL, IU,
591 $ ISEED, RWORK( INDD ), MAXSIZE, VECSIZE,
592 $ VALSIZE )
593*
594 LHEEVXSIZE = MIN( MAXSIZE, LRWORK )
595 WKNOWN = .FALSE.
596*
597 CALL PZGSEPSUBTST( WKNOWN, IBTYPE, 'v', 'a', UPLO, N, VL, VU,
598 $ IL, IU, THRESH, ABSTOL, A, COPYA, B, COPYB,
599 $ Z, 1, 1, DESCA, RWORK( INDD ), WIN, IFAIL,
600 $ ICLUSTR, GAP, IPREPAD, IPOSTPAD,
601 $ WORK( INDWORK ), LLWORK, RWORK( INDRWORK ),
602 $ LLRWORK, LHEEVXSIZE, IWORK, ISIZEHEEVX, RES,
603 $ TSTNRM, QTQNRM, NOUT )
604*
605*
606*
607 MAXTSTNRM = TSTNRM
608 MAXQTQNRM = QTQNRM
609*
610.LE. IF( THRESHZERO ) THEN
611 PASSED = 'skipped '
612 INFO = 2
613.NE. ELSE IF( RES0 ) THEN
614 PASSED = 'failed '
615 INFO = 1
616 END IF
617 END IF
618*
619.GT..AND. IF( THRESHZERO LSAME( SUBTESTS, 'y' ) ) THEN
620*
621* Subtest 1: JOBZ = 'V', RANGE = 'A', minimum memory
622*
623.EQ. IF( INFO0 ) THEN
624*
625 JOBZ = 'v'
626 RANGE = 'a'
627 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
628 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
629 $ VECSIZE, VALSIZE )
630*
631 LHEEVXSIZE = VECSIZE
632*
633 CALL PZGSEPSUBTST( .TRUE., IBTYPE, JOBZ, RANGE, UPLO, N, VL,
634 $ VU, IL, IU, THRESH, ABSTOL, A, COPYA, B,
635 $ COPYB, Z, 1, 1, DESCA, WIN( 1+IPREPAD ),
636 $ WNEW, IFAIL, ICLUSTR, GAP, IPREPAD,
637 $ IPOSTPAD, WORK( INDWORK ), LLWORK, RWORK,
638 $ LRWORK, LHEEVXSIZE, IWORK, ISIZEHEEVX,
639 $ RES, TSTNRM, QTQNRM, NOUT )
640*
641.NE. IF( RES0 ) THEN
642 PASSED = 'failed stest 1'
643 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
644 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
645 INFO = 1
646 END IF
647 END IF
648*
649* Subtest 2: JOBZ = 'V', RANGE = 'A', random memory
650*
651.EQ. IF( INFO0 ) THEN
652 JOBZ = 'v'
653 RANGE = 'a'
654 CALL PZLASIZEHEEVX( .TRUE., RANGE, N, DESCA, VL, VU, IL, IU,
655 $ ISEED, WIN( 1+IPREPAD ), MAXSIZE,
656 $ VECSIZE, VALSIZE )
657*
658 LHEEVXSIZE = VECSIZE + INT( DLARAN( ISEED )*
659 $ DBLE( MAXSIZE-VECSIZE ) )
660*
661 CALL PZGSEPSUBTST( .TRUE., IBTYPE, JOBZ, RANGE, UPLO, N, VL,
662 $ VU, IL, IU, THRESH, ABSTOL, A, COPYA, B,
663 $ COPYB, Z, 1, 1, DESCA, WIN( 1+IPREPAD ),
664 $ WNEW, IFAIL, ICLUSTR, GAP, IPREPAD,
665 $ IPOSTPAD, WORK( INDWORK ), LLWORK, RWORK,
666 $ LRWORK, LHEEVXSIZE, IWORK, ISIZEHEEVX,
667 $ RES, TSTNRM, QTQNRM, NOUT )
668*
669.NE. IF( RES0 ) THEN
670 PASSED = 'failed stest 2'
671 MAXTSTNRM = MAX( TSTNRM, MAXTSTNRM )
672 MAXQTQNRM = MAX( QTQNRM, MAXQTQNRM )
673 INFO = 1
674 END IF
675 END IF
676*
677* Subtest 3: JOBZ = 'N', RANGE = 'A', minimum memory
678*
679.EQ. IF( INFO0 ) THEN
680*
681 JOBZ = 'n'
682 range = 'A'
683 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
684 $ iseed, win( 1+iprepad ), maxsize,
685 $ vecsize, valsize )
686*
687 lheevxsize = valsize
688 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
689 $ vu, il, iu, thresh, abstol, a, copya, b,
690 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
691 $ wnew, ifail, iclustr, gap, iprepad,
692 $ ipostpad, work( indwork ), llwork, rwork,
693 $ lrwork, lheevxsize, iwork, isizeheevx,
694 $ res, tstnrm, qtqnrm, nout )
695*
696 IF( res.NE.0 ) THEN
697 maxtstnrm = max( tstnrm, maxtstnrm )
698 maxqtqnrm = max( qtqnrm, maxqtqnrm )
699 passed = 'FAILED stest 3'
700 info = 1
701 END IF
702 END IF
703*
704* Subtest 4: JOBZ = 'N', RANGE = 'I', minimum memory
705*
706 IF( info.EQ.0 ) THEN
707*
708 il = -1
709 iu = -1
710 jobz = 'N'
711 range = 'I'
712*
713* We use PZLASIZEHEEVX to choose IL and IU for us.
714*
715 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
716 $ iseed, win( 1+iprepad ), maxsize,
717 $ vecsize, valsize )
718*
719 lheevxsize = valsize
720*
721 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
722 $ vu, il, iu, thresh, abstol, a, copya, b,
723 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
724 $ wnew, ifail, iclustr, gap, iprepad,
725 $ ipostpad, work( indwork ), llwork, rwork,
726 $ lrwork, lheevxsize, iwork, isizeheevx,
727 $ res, tstnrm, qtqnrm, nout )
728*
729 IF( res.NE.0 ) THEN
730 maxtstnrm = max( tstnrm, maxtstnrm )
731 maxqtqnrm = max( qtqnrm, maxqtqnrm )
732 passed = 'FAILED stest 4'
733 info = 1
734 END IF
735 END IF
736*
737* Subtest 5: JOBZ = 'V', RANGE = 'I', maximum memory
738*
739 IF( info.EQ.0 ) THEN
740*
741 il = -1
742 iu = -1
743 jobz = 'V'
744 range = 'I'
745*
746* We use PZLASIZEHEEVX to choose IL and IU for us.
747*
748 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
749 $ iseed, win( 1+iprepad ), maxsize,
750 $ vecsize, valsize )
751*
752 lheevxsize = maxsize
753*
754 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
755 $ vu, il, iu, thresh, abstol, a, copya, b,
756 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
757 $ wnew, ifail, iclustr, gap, iprepad,
758 $ ipostpad, work( indwork ), llwork, rwork,
759 $ lrwork, lheevxsize, iwork, isizeheevx,
760 $ res, tstnrm, qtqnrm, nout )
761*
762 IF( res.NE.0 ) THEN
763 maxtstnrm = max( tstnrm, maxtstnrm )
764 maxqtqnrm = max( qtqnrm, maxqtqnrm )
765 passed = 'FAILED stest 5'
766 info = 1
767 END IF
768 END IF
769*
770* Subtest 6: JOBZ = 'V', RANGE = 'I', minimum memory
771*
772 IF( info.EQ.0 ) THEN
773 il = -1
774 iu = -1
775 jobz = 'V'
776 range = 'I'
777*
778* We use PZLASIZEHEEVX to choose IL and IU for us.
779*
780 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
781 $ iseed, win( 1+iprepad ), maxsize,
782 $ vecsize, valsize )
783*
784 lheevxsize = vecsize
785*
786 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
787 $ vu, il, iu, thresh, abstol, a, copya, b,
788 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
789 $ wnew, ifail, iclustr, gap, iprepad,
790 $ ipostpad, work( indwork ), llwork, rwork,
791 $ lrwork, lheevxsize, iwork, isizeheevx,
792 $ res, tstnrm, qtqnrm, nout )
793*
794 IF( res.NE.0 ) THEN
795 maxtstnrm = max( tstnrm, maxtstnrm )
796 maxqtqnrm = max( qtqnrm, maxqtqnrm )
797 passed = 'FAILED stest 6'
798 info = 1
799 END IF
800 END IF
801*
802* Subtest 7: JOBZ = 'V', RANGE = 'I', random memory
803*
804 IF( info.EQ.0 ) THEN
805 il = -1
806 iu = -1
807 jobz = 'V'
808 range = 'I'
809*
810* We use PZLASIZEHEEVX to choose IL and IU for us.
811*
812 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
813 $ iseed, win( 1+iprepad ), maxsize,
814 $ vecsize, valsize )
815 lheevxsize = vecsize + int( dlaran( iseed )*
816 $ dble( maxsize-vecsize ) )
817*
818 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
819 $ vu, il, iu, thresh, abstol, a, copya, b,
820 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
821 $ wnew, ifail, iclustr, gap, iprepad,
822 $ ipostpad, work( indwork ), llwork, rwork,
823 $ lrwork, lheevxsize, iwork, isizeheevx,
824 $ res, tstnrm, qtqnrm, nout )
825*
826 IF( res.NE.0 ) THEN
827 maxtstnrm = max( tstnrm, maxtstnrm )
828 maxqtqnrm = max( qtqnrm, maxqtqnrm )
829 passed = 'FAILED stest 7'
830 info = 1
831 END IF
832 END IF
833*
834* Subtest 8: JOBZ = 'N', RANGE = 'V', minimum memory
835*
836 IF( info.EQ.0 ) THEN
837 vl = one
838 vu = -one
839 jobz = 'N'
840 range = 'V'
841*
842* We use PZLASIZEHEEVX to choose VL and VU for us.
843*
844 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
845 $ iseed, win( 1+iprepad ), maxsize,
846 $ vecsize, valsize )
847*
848 lheevxsize = valsize
849*
850 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
851 $ vu, il, iu, thresh, abstol, a, copya, b,
852 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
853 $ wnew, ifail, iclustr, gap, iprepad,
854 $ ipostpad, work( indwork ), llwork, rwork,
855 $ lrwork, lheevxsize, iwork, isizeheevx,
856 $ res, tstnrm, qtqnrm, nout )
857*
858 IF( res.NE.0 ) THEN
859 maxtstnrm = max( tstnrm, maxtstnrm )
860 maxqtqnrm = max( qtqnrm, maxqtqnrm )
861 passed = 'FAILED stest 8'
862 info = 1
863 END IF
864 END IF
865*
866* Subtest 9: JOBZ = 'V', RANGE = 'V', maximum memory
867*
868 IF( info.EQ.0 ) THEN
869 vl = one
870 vu = -one
871 jobz = 'V'
872 range = 'V'
873*
874* We use PZLASIZEHEEVX to choose VL and VU for us.
875*
876 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
877 $ iseed, win( 1+iprepad ), maxsize,
878 $ vecsize, valsize )
879*
880 lheevxsize = maxsize
881*
882 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
883 $ vu, il, iu, thresh, abstol, a, copya, b,
884 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
885 $ wnew, ifail, iclustr, gap, iprepad,
886 $ ipostpad, work( indwork ), llwork, rwork,
887 $ lrwork, lheevxsize, iwork, isizeheevx,
888 $ res, tstnrm, qtqnrm, nout )
889*
890 IF( res.NE.0 ) THEN
891 maxtstnrm = max( tstnrm, maxtstnrm )
892 maxqtqnrm = max( qtqnrm, maxqtqnrm )
893 passed = 'FAILED stest 9'
894 info = 1
895 END IF
896 END IF
897*
898* Subtest 10: JOBZ = 'V', RANGE = 'V',
899* minimum memory required for eigenvectors
900*
901 IF( info.EQ.0 ) THEN
902 vl = one
903 vu = -one
904 jobz = 'V'
905 range = 'V'
906*
907* We use PZLASIZEHEEVX to choose VL and VU for us.
908*
909 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
910 $ iseed, win( 1+iprepad ), maxsize,
911 $ vecsize, valsize )
912*
913 lheevxsize = vecsize
914*
915 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
916 $ vu, il, iu, thresh, abstol, a, copya, b,
917 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
918 $ wnew, ifail, iclustr, gap, iprepad,
919 $ ipostpad, work( indwork ), llwork, rwork,
920 $ lrwork, lheevxsize, iwork, isizeheevx,
921 $ res, tstnrm, qtqnrm, nout )
922*
923 IF( res.NE.0 ) THEN
924 maxtstnrm = max( tstnrm, maxtstnrm )
925 maxqtqnrm = max( qtqnrm, maxqtqnrm )
926 passed = 'FAILED stest10'
927 info = 1
928 END IF
929 END IF
930*
931* Subtest 11: JOBZ = 'V', RANGE = 'V',
932* random memory (enough for all eigenvectors
933* but not enough to guarantee orthogonality
934*
935 IF( info.EQ.0 ) THEN
936 vl = one
937 vu = -one
938 jobz = 'V'
939 range = 'V'
940*
941* We use PZLASIZEHEEVX to choose VL and VU for us.
942*
943 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
944 $ iseed, win( 1+iprepad ), maxsize,
945 $ vecsize, valsize )
946*
947*
948 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
949 $ vu, il, iu, thresh, abstol, a, copya, b,
950 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
951 $ wnew, ifail, iclustr, gap, iprepad,
952 $ ipostpad, work( indwork ), llwork, rwork,
953 $ lrwork, lheevxsize, iwork, isizeheevx,
954 $ res, tstnrm, qtqnrm, nout )
955*
956 IF( res.NE.0 ) THEN
957 maxtstnrm = max( tstnrm, maxtstnrm )
958 maxqtqnrm = max( qtqnrm, maxqtqnrm )
959 passed = 'FAILED stest11'
960 info = 1
961 END IF
962 END IF
963*
964* Subtest 12: JOBZ = 'V', RANGE = 'V',
965* miniimum memory required for eigenvalues only
966*
967 IF( info.EQ.0 ) THEN
968 vl = one
969 vu = -one
970 jobz = 'V'
971 range = 'V'
972*
973* We use PZLASIZEHEEVX to choose VL and VU for us.
974*
975 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
976 $ iseed, win( 1+iprepad ), maxsize,
977 $ vecsize, valsize )
978*
979 lheevxsize = valsize
980*
981 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
982 $ vu, il, iu, thresh, abstol, a, copya, b,
983 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
984 $ wnew, ifail, iclustr, gap, iprepad,
985 $ ipostpad, work( indwork ), llwork, rwork,
986 $ lrwork, lheevxsize, iwork, isizeheevx,
987 $ res, tstnrm, qtqnrm, nout )
988*
989 IF( res.NE.0 ) THEN
990 maxtstnrm = max( tstnrm, maxtstnrm )
991 maxqtqnrm = max( qtqnrm, maxqtqnrm )
992 passed = 'FAILED stest12'
993 info = 1
994 END IF
995 END IF
996*
997* Subtest 13: JOBZ = 'V', RANGE = 'V',
998* random memory (more than minimum required
999* for eigenvalues, less than required for vectors)
1000*
1001 IF( info.EQ.0 ) THEN
1002 vl = one
1003 vu = -one
1004 jobz = 'V'
1005 range = 'V'
1006*
1007* We use PZLASIZEHEEVX to choose VL and VU for us.
1008*
1009 CALL pzlasizeheevx( .true., range, n, desca, vl, vu, il, iu,
1010 $ iseed, win( 1+iprepad ), maxsize,
1011 $ vecsize, valsize )
1012*
1013*
1014 CALL pzgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
1015 $ vu, il, iu, thresh, abstol, a, copya, b,
1016 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
1017 $ wnew, ifail, iclustr, gap, iprepad,
1018 $ ipostpad, work( indwork ), llwork, rwork,
1019 $ lrwork, lheevxsize, iwork, isizeheevx,
1020 $ res, tstnrm, qtqnrm, nout )
1021*
1022 IF( res.NE.0 ) THEN
1023 maxtstnrm = max( tstnrm, maxtstnrm )
1024 maxqtqnrm = max( qtqnrm, maxqtqnrm )
1025 passed = 'FAILED stest13'
1026 info = 1
1027 END IF
1028 END IF
1029 END IF
1030*
1031*
1032*
1033 CALL igamx2d( context, 'All', ' ', 1, 1, INFO, 1, -1, -1, -1, -1,
1034 $ -1 )
1035*
1036.EQ. IF( INFO1 ) THEN
1037.EQ. IF( IAM0 ) THEN
1038 WRITE( NOUT, FMT = 9994 )'c '
1039 WRITE( NOUT, FMT = 9993 )ISEEDIN( 1 )
1040 WRITE( NOUT, FMT = 9992 )ISEEDIN( 2 )
1041 WRITE( NOUT, FMT = 9991 )ISEEDIN( 3 )
1042 WRITE( NOUT, FMT = 9990 )ISEEDIN( 4 )
1043 IF( LSAME( UPLO, 'l' ) ) THEN
1044 WRITE( NOUT, FMT = 9994 )' uplo= ''l'' '
1045 ELSE
1046 WRITE( NOUT, FMT = 9994 )' uplo= ''u'' '
1047 END IF
1048 IF( LSAME( SUBTESTS, 'y' ) ) THEN
1049 WRITE( NOUT, FMT = 9994 )' subtests= ''y'' '
1050 ELSE
1051 WRITE( NOUT, FMT = 9994 )' subtests= ''n'' '
1052 END IF
1053 WRITE( NOUT, FMT = 9989 )N
1054 WRITE( NOUT, FMT = 9988 )NPROW
1055 WRITE( NOUT, FMT = 9987 )NPCOL
1056 WRITE( NOUT, FMT = 9986 )NB
1057 WRITE( NOUT, FMT = 9985 )MATTYPE
1058 WRITE( NOUT, FMT = 9984 )IBTYPE
1059 WRITE( NOUT, FMT = 9982 )ABSTOL
1060 WRITE( NOUT, FMT = 9981 )THRESH
1061 WRITE( NOUT, FMT = 9994 )'c '
1062 END IF
1063 END IF
1064*
1065 CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
1066 CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
1067 IF( iam.EQ.0 ) THEN
1068 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1069 IF( wtime( 1 ).GE.0.0 ) THEN
1070 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1071 $ ibtype, subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
1072 $ passed
1073 ELSE
1074 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1075 $ ibtype, subtests, ctime( 1 ), maxtstnrm, passed
1076 END IF
1077 ELSE IF( info.EQ.2 ) THEN
1078 IF( wtime( 1 ).GE.0.0 ) THEN
1079 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1080 $ ibtype, subtests, wtime( 1 ), ctime( 1 )
1081 ELSE
1082 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1083 $ ibtype, subtests, ctime( 1 )
1084 END IF
1085 ELSE IF( info.EQ.3 ) THEN
1086 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1087 $ ibtype, subtests
1088 END IF
1089 END IF
1090*
1091 120 CONTINUE
1092*
1093 RETURN
1094 9999 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1095 $ 1x, f8.2, 1x, f8.2, 1x, g9.2, 1x, a14 )
1096 9998 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1097 $ 1x, 8x, 1x, f8.2, 1x, g9.2, a14 )
1098 9997 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1099 $ 1x, f8.2, 1x, f8.2, 11x, 'Bypassed' )
1100 9996 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1101 $ 1x, 8x, 1x, f8.2, 11x, 'Bypassed' )
1102 9995 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1103 $ 22x, 'Bad MEMORY parameters' )
1104 9994 FORMAT( a )
1105 9993 FORMAT( ' ISEED( 1 ) =', i8 )
1106 9992 FORMAT( ' ISEED( 2 ) =', i8 )
1107 9991 FORMAT( ' ISEED( 3 ) =', i8 )
1108 9990 FORMAT( ' ISEED( 4 ) =', i8 )
1109 9989 FORMAT( ' N=', i8 )
1110 9988 FORMAT( ' NPROW=', i8 )
1111 9987 FORMAT( ' NPCOL=', i8 )
1112 9986 FORMAT( ' NB=', i8 )
1113 9985 FORMAT( ' MATTYPE=', i8 )
1114 9984 FORMAT( ' IBTYPE=', i8 )
1115 9983 FORMAT( ' SUBTESTS=', a1 )
1116 9982 FORMAT( ' ABSTOL=', d16.6 )
1117 9981 FORMAT( ' THRESH=', d16.6 )
1118 9980 FORMAT( ' Increase TOTMEM in PZGSEPDRIVER' )
1119*
1120* End of PZGSEPTST
1121*
1122 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
pzgsepsubtst
subroutine pzgsepsubtst(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 pzgsepsubtst.f:10
pzgseptst
subroutine pzgseptst(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 pzgseptst.f:8
pzlasizegsep
subroutine pzlasizegsep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, rsizeqtq, rsizechk, sizeheevx, rsizeheevx, isizeheevx, sizesubtst, rsizesubtst, isizesubtst, sizetst, rsizetst, isizetst)
Definition pzlasizegsep.f:7
pzlasizeheevx
subroutine pzlasizeheevx(wknown, range, n, desca, vl, vu, il, iu, iseed, win, maxsize, vecsize, valsize)
Definition pzlasizeheevx.f:5
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
slcombine
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)
Definition sltimer.f:267