SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ psseptst()

subroutine psseptst ( integer, dimension( * )  desca,
character  uplo,
integer  n,
integer  mattype,
character  subtests,
real  thresh,
integer  order,
real  abstol,
integer, dimension( 4 )  iseed,
real, dimension( lda, * )  a,
real, dimension( lda, * )  copya,
real, dimension( lda, * )  z,
integer  lda,
real, dimension( * )  win,
real, dimension( * )  wnew,
integer, dimension( * )  ifail,
integer, dimension( * )  iclustr,
real, dimension( * )  gap,
integer  iprepad,
integer  ipostpad,
real, dimension( * )  work,
integer  lwork,
integer, dimension( * )  iwork,
integer  liwork,
character  hetero,
integer  nout,
integer  info 
)

Definition at line 1 of file psseptst.f.

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