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

◆ pdseptst()

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

Definition at line 1 of file pdseptst.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 DOUBLE PRECISION ABSTOL, THRESH
17* ..
18* .. Array Arguments ..
19 INTEGER DESCA( * ), ICLUSTR( * ), IFAIL( * ),
20 $ ISEED( 4 ), IWORK( * )
21 DOUBLE PRECISION A( LDA, * ), COPYA( LDA, * ), GAP( * ),
22 $ WIN( * ), WNEW( * ), WORK( * ), Z( LDA, * )
23* ..
24*
25* Purpose
26* =======
27*
28* PDSEPTST builds a random matrix, runs PDSYEVX and PDSYEV 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) DOUBLE PRECISION
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) DOUBLE PRECISION
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 ("PDSTEIN"),
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) DOUBLE PRECISION 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 PDSYEVX
150*
151* COPYA (local workspace) DOUBLE PRECISION 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) DOUBLE PRECISION 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* PDSEPCHK and PDSEPQTQ
159*
160* W (local workspace) DOUBLE PRECISION array, dimension (N)
161* On normal exit from PDSYEVX, 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) DOUBLE PRECISION array, dimension (LWORK)
167*
168* LWORK (local input) INTEGER
169* The length of the array WORK. LWORK >= SIZETST as
170* returned by PDLASIZESQP
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 PDLASIZESQP
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 DOUBLE PRECISION HALF, ONE, TEN, ZERO
202 parameter( zero = 0.0d+0, one = 1.0d+0,
203 $ ten = 10.0d+0, half = 0.5d+0 )
204 DOUBLE PRECISION PADVAL
205 parameter( padval = 19.25d+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 DOUBLE PRECISION 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 DOUBLE PRECISION DLARAN, PDLAMCH
235 EXTERNAL dlaran, lsame, numroc, pdlamch
236* ..
237* .. External Subroutines ..
238 EXTERNAL blacs_gridinfo, blacs_pinfo, dlabad, dlasrt,
239 $ dlatms, igamx2d, igebr2d, igebs2d, pdchekpad,
240 $ pdelset, pdfillpad, pdlaset, pdlasizesqp,
241 $ pdlasizesyevx, pdlatms, pdmatgen, pdsepsubtst,
242 $ pdsqpsubtst, pdsyev, slcombine
243* ..
244* .. Intrinsic Functions ..
245 INTRINSIC abs, dble, 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 pdlasizesqp( desca, iprepad, ipostpad, sizemqrleft,
289 $ sizemqrright, sizeqrf, sizetms, sizeqtq,
290 $ sizechk, sizesyevx, isizesyevx, sizesyev,
291 $ sizesyevd, isizesyevd, sizesubtst,
292 $ 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 = pdlamch( context, 'P' )
307 ulpinv = one / ulp
308 unfl = pdlamch( context, 'Safe min' )
309 ovfl = one / unfl
310 CALL dlabad( unfl, ovfl )
311 rtunfl = sqrt( unfl )
312 rtovfl = sqrt( ovfl )
313 aninv = one / dble( 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 pdlaset( '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 pdlaset( '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 pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
400 $ sizetms, iprepad, ipostpad, padval+1.0d+0 )
401*
402 CALL pdlatms( 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 pdchekpad( desca( ctxt_ ), 'PDLATMS1-WORK', sizetms, 1,
409 $ work( indwork ), sizetms, iprepad, ipostpad,
410 $ padval+1.0d+0 )
411*
412 ELSE IF( itype.EQ.5 ) THEN
413*
414* symmetric, eigenvalues specified
415*
416 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
417 $ sizetms, iprepad, ipostpad, padval+2.0d+0 )
418*
419 CALL pdlatms( 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 pdchekpad( desca( ctxt_ ), 'PDLATMS2-WORK', sizetms, 1,
425 $ work( indwork ), sizetms, iprepad, ipostpad,
426 $ padval+2.0d+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 pdmatgen( 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 pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
449 $ sizetms, iprepad, ipostpad, padval+3.0d+0 )
450*
451 CALL pdlatms( 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 pdchekpad( desca( ctxt_ ), 'PDLATMS3-WORK', sizetms, 1,
459 $ work( indwork ), sizetms, iprepad, ipostpad,
460 $ padval+3.0d+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 pdlaset( '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( dlaran( iseed )*dble( nloc ) ), n-ngen )
476*
477 CALL dlatms( 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 pdelset( copya, ngen+1, ngen+1, desca, a( 1, 1 ) )
491 DO 90 i = 2, in
492 CALL pdelset( copya, ngen+i, ngen+i, desca,
493 $ a( i, i ) )
494 CALL pdelset( copya, ngen+i-1, ngen+i, desca,
495 $ a( i-1, i ) )
496 CALL pdelset( 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 pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
525 $ sizetms, iprepad, ipostpad, padval+4.0d+0 )
526*
527 CALL pdlatms( 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 pdchekpad( desca( ctxt_ ), 'PDLATMS4-WORK', sizetms, 1,
533 $ work( indwork ), sizetms, iprepad, ipostpad,
534 $ padval+4.0d+0 )
535*
536*
537* WKNOWN ... NOT SET, GUESS A DEFAULT
538*
539 wknown = .true.
540 ELSE
541 iinfo = 1
542 END IF
543*
544 IF( wknown )
545 $ CALL dlasrt( 'I', n, work( indd ), iinfo )
546*
547*
548* These values aren't actually used, but they make ftncheck happy.
549*
550 il = -1
551 iu = -2
552 vl = one
553 vu = -one
554*
555 CALL pdlasizesyevx( wknown, 'A', n, desca, vl, vu, il, iu,
556 $ iseed, work( indd ), maxsize, vecsize,
557 $ valsize )
558*
559 lsyevxsize = min( maxsize, llwork )
560*
561 CALL pdsepsubtst( wknown, 'v', 'a', uplo, n, vl, vu, il, iu,
562 $ thresh, abstol, a, copya, z, 1, 1, desca,
563 $ work( indd ), win, ifail, iclustr, gap,
564 $ iprepad, ipostpad, work( indwork ), llwork,
565 $ lsyevxsize, iwork, isizesyevx, res, tstnrm,
566 $ qtqnrm, nout )
567*
568*
569*
570 maxtstnrm = tstnrm
571 maxqtqnrm = qtqnrm
572*
573 IF( thresh.LE.zero ) THEN
574 passed = 'SKIPPED '
575 info = 2
576 ELSE IF( res.NE.0 ) THEN
577 passed = 'FAILED '
578 info = 1
579 END IF
580 END IF
581*
582 IF( thresh.GT.zero .AND. lsame( subtests, 'Y' ) ) THEN
583*
584* Subtest 1: JOBZ = 'V', RANGE = 'A', minimum memory
585*
586 IF( info.EQ.0 ) THEN
587*
588 jobz = 'V'
589 range = 'A'
590 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
591 $ iseed, win( 1+iprepad ), maxsize,
592 $ vecsize, valsize )
593*
594 lsyevxsize = vecsize
595*
596 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
597 $ iu, thresh, abstol, a, copya, z, 1, 1,
598 $ desca, win( 1+iprepad ), wnew, ifail,
599 $ iclustr, gap, iprepad, ipostpad,
600 $ work( indwork ), llwork, lsyevxsize,
601 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
602 $ nout )
603*
604 IF( res.NE.0 ) THEN
605 passed = 'FAILED stest 1'
606 maxtstnrm = max( tstnrm, maxtstnrm )
607 maxqtqnrm = max( qtqnrm, maxqtqnrm )
608 info = 1
609 END IF
610 END IF
611*
612* Subtest 2: JOBZ = 'V', RANGE = 'A', random memory
613*
614 IF( info.EQ.0 ) THEN
615 jobz = 'V'
616 range = 'A'
617 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
618 $ iseed, win( 1+iprepad ), maxsize,
619 $ vecsize, valsize )
620*
621 lsyevxsize = vecsize + int( dlaran( iseed )*
622 $ dble( maxsize-vecsize ) )
623*
624 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
625 $ iu, thresh, abstol, a, copya, z, 1, 1,
626 $ desca, win( 1+iprepad ), wnew, ifail,
627 $ iclustr, gap, iprepad, ipostpad,
628 $ work( indwork ), llwork, lsyevxsize,
629 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
630 $ nout )
631*
632 IF( res.NE.0 ) THEN
633 passed = 'FAILED stest 2'
634 maxtstnrm = max( tstnrm, maxtstnrm )
635 maxqtqnrm = max( qtqnrm, maxqtqnrm )
636 info = 1
637 END IF
638 END IF
639*
640* Subtest 3: JOBZ = 'N', RANGE = 'A', minimum memory
641*
642 IF( info.EQ.0 ) THEN
643*
644 jobz = 'N'
645 range = 'A'
646 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
647 $ iseed, win( 1+iprepad ), maxsize,
648 $ vecsize, valsize )
649*
650 lsyevxsize = valsize
651*
652 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
653 $ iu, thresh, abstol, a, copya, z, 1, 1,
654 $ desca, win( 1+iprepad ), wnew, ifail,
655 $ iclustr, gap, iprepad, ipostpad,
656 $ work( indwork ), llwork, lsyevxsize,
657 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
658 $ nout )
659*
660 IF( res.NE.0 ) THEN
661 maxtstnrm = max( tstnrm, maxtstnrm )
662 maxqtqnrm = max( qtqnrm, maxqtqnrm )
663 passed = 'FAILED stest 3'
664 info = 1
665 END IF
666 END IF
667*
668* Subtest 4: JOBZ = 'N', RANGE = 'I', minimum memory
669*
670 IF( info.EQ.0 ) THEN
671*
672 il = -1
673 iu = -1
674 jobz = 'N'
675 range = 'I'
676*
677* We use PDLASIZESYEVX to choose IL and IU for us.
678*
679 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
680 $ iseed, win( 1+iprepad ), maxsize,
681 $ vecsize, valsize )
682*
683 lsyevxsize = valsize
684*
685 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
686 $ iu, thresh, abstol, a, copya, z, 1, 1,
687 $ desca, win( 1+iprepad ), wnew, ifail,
688 $ iclustr, gap, iprepad, ipostpad,
689 $ work( indwork ), llwork, lsyevxsize,
690 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
691 $ nout )
692*
693 IF( res.NE.0 ) THEN
694 maxtstnrm = max( tstnrm, maxtstnrm )
695 maxqtqnrm = max( qtqnrm, maxqtqnrm )
696 passed = 'FAILED stest 4'
697 info = 1
698 END IF
699 END IF
700*
701* Subtest 5: JOBZ = 'V', RANGE = 'I', maximum memory
702*
703 IF( info.EQ.0 ) THEN
704*
705 il = -1
706 iu = -1
707 jobz = 'V'
708 range = 'I'
709*
710* We use PDLASIZESYEVX to choose IL and IU for us.
711*
712 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
713 $ iseed, win( 1+iprepad ), maxsize,
714 $ vecsize, valsize )
715*
716 lsyevxsize = maxsize
717*
718 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
719 $ iu, thresh, abstol, a, copya, z, 1, 1,
720 $ desca, win( 1+iprepad ), wnew, ifail,
721 $ iclustr, gap, iprepad, ipostpad,
722 $ work( indwork ), llwork, lsyevxsize,
723 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
724 $ nout )
725*
726 IF( res.NE.0 ) THEN
727 maxtstnrm = max( tstnrm, maxtstnrm )
728 maxqtqnrm = max( qtqnrm, maxqtqnrm )
729 passed = 'FAILED stest 5'
730 info = 1
731 END IF
732 END IF
733*
734* Subtest 6: JOBZ = 'V', RANGE = 'I', minimum memory
735*
736 IF( info.EQ.0 ) THEN
737 il = -1
738 iu = -1
739 jobz = 'V'
740 range = 'I'
741*
742* We use PDLASIZESYEVX to choose IL and IU for us.
743*
744 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
745 $ iseed, win( 1+iprepad ), maxsize,
746 $ vecsize, valsize )
747*
748 lsyevxsize = vecsize
749*
750 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
751 $ iu, thresh, abstol, a, copya, z, 1, 1,
752 $ desca, win( 1+iprepad ), wnew, ifail,
753 $ iclustr, gap, iprepad, ipostpad,
754 $ work( indwork ), llwork, lsyevxsize,
755 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
756 $ nout )
757*
758 IF( res.NE.0 ) THEN
759 maxtstnrm = max( tstnrm, maxtstnrm )
760 maxqtqnrm = max( qtqnrm, maxqtqnrm )
761 passed = 'FAILED stest 6'
762 info = 1
763 END IF
764 END IF
765*
766* Subtest 7: JOBZ = 'V', RANGE = 'I', random memory
767*
768 IF( info.EQ.0 ) THEN
769 il = -1
770 iu = -1
771 jobz = 'V'
772 range = 'I'
773*
774* We use PDLASIZESYEVX to choose IL and IU for us.
775*
776 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
777 $ iseed, win( 1+iprepad ), maxsize,
778 $ vecsize, valsize )
779 lsyevxsize = vecsize + int( dlaran( iseed )*
780 $ dble( maxsize-vecsize ) )
781*
782 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
783 $ iu, thresh, abstol, a, copya, z, 1, 1,
784 $ desca, win( 1+iprepad ), wnew, ifail,
785 $ iclustr, gap, iprepad, ipostpad,
786 $ work( indwork ), llwork, lsyevxsize,
787 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
788 $ nout )
789*
790 IF( res.NE.0 ) THEN
791 maxtstnrm = max( tstnrm, maxtstnrm )
792 maxqtqnrm = max( qtqnrm, maxqtqnrm )
793 passed = 'FAILED stest 7'
794 info = 1
795 END IF
796 END IF
797*
798* Subtest 8: JOBZ = 'N', RANGE = 'V', minimum memory
799*
800 IF( info.EQ.0 ) THEN
801 vl = one
802 vu = -one
803 jobz = 'N'
804 range = 'V'
805*
806* We use PDLASIZESYEVX to choose VL and VU for us.
807*
808 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
809 $ iseed, win( 1+iprepad ), maxsize,
810 $ vecsize, valsize )
811*
812 lsyevxsize = valsize
813*
814 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
815 $ iu, thresh, abstol, a, copya, z, 1, 1,
816 $ desca, win( 1+iprepad ), wnew, ifail,
817 $ iclustr, gap, iprepad, ipostpad,
818 $ work( indwork ), llwork, lsyevxsize,
819 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
820 $ nout )
821*
822 IF( res.NE.0 ) THEN
823 maxtstnrm = max( tstnrm, maxtstnrm )
824 maxqtqnrm = max( qtqnrm, maxqtqnrm )
825 passed = 'FAILED stest 8'
826 info = 1
827 END IF
828 END IF
829*
830* Subtest 9: JOBZ = 'V', RANGE = 'V', maximum memory
831*
832 IF( info.EQ.0 ) THEN
833 vl = one
834 vu = -one
835 jobz = 'V'
836 range = 'V'
837*
838* We use PDLASIZESYEVX to choose VL and VU for us.
839*
840 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
841 $ iseed, win( 1+iprepad ), maxsize,
842 $ vecsize, valsize )
843*
844 lsyevxsize = maxsize
845*
846 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
847 $ iu, thresh, abstol, a, copya, z, 1, 1,
848 $ desca, win( 1+iprepad ), wnew, ifail,
849 $ iclustr, gap, iprepad, ipostpad,
850 $ work( indwork ), llwork, lsyevxsize,
851 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
852 $ nout )
853*
854 IF( res.NE.0 ) THEN
855 maxtstnrm = max( tstnrm, maxtstnrm )
856 maxqtqnrm = max( qtqnrm, maxqtqnrm )
857 passed = 'FAILED stest 9'
858 info = 1
859 END IF
860 END IF
861*
862* Subtest 10: JOBZ = 'V', RANGE = 'V',
863* minimum memory required for eigenvectors
864*
865 IF( info.EQ.0 ) THEN
866 vl = one
867 vu = -one
868 jobz = 'V'
869 range = 'V'
870*
871* We use PDLASIZESYEVX to choose VL and VU for us.
872*
873 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
874 $ iseed, win( 1+iprepad ), maxsize,
875 $ vecsize, valsize )
876*
877 lsyevxsize = vecsize
878*
879 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
880 $ iu, thresh, abstol, a, copya, z, 1, 1,
881 $ desca, win( 1+iprepad ), wnew, ifail,
882 $ iclustr, gap, iprepad, ipostpad,
883 $ work( indwork ), llwork, lsyevxsize,
884 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
885 $ nout )
886*
887 IF( res.NE.0 ) THEN
888 maxtstnrm = max( tstnrm, maxtstnrm )
889 maxqtqnrm = max( qtqnrm, maxqtqnrm )
890 passed = 'FAILED stest10'
891 info = 1
892 END IF
893 END IF
894*
895* Subtest 11: JOBZ = 'V', RANGE = 'V',
896* random memory (enough for all eigenvectors
897* but not enough to guarantee orthogonality
898*
899 IF( info.EQ.0 ) THEN
900 vl = one
901 vu = -one
902 jobz = 'V'
903 range = 'V'
904*
905* We use PDLASIZESYEVX to choose VL and VU for us.
906*
907 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
908 $ iseed, win( 1+iprepad ), maxsize,
909 $ vecsize, valsize )
910*
911 lsyevxsize = vecsize + int( dlaran( iseed )*
912 $ dble( maxsize-vecsize ) )
913*
914 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
915 $ iu, thresh, abstol, a, copya, z, 1, 1,
916 $ desca, win( 1+iprepad ), wnew, ifail,
917 $ iclustr, gap, iprepad, ipostpad,
918 $ work( indwork ), llwork, lsyevxsize,
919 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
920 $ nout )
921*
922 IF( res.NE.0 ) THEN
923 maxtstnrm = max( tstnrm, maxtstnrm )
924 maxqtqnrm = max( qtqnrm, maxqtqnrm )
925 passed = 'FAILED stest11'
926 info = 1
927 END IF
928 END IF
929*
930* Subtest 12: JOBZ = 'V', RANGE = 'V',
931* miniimum memory required for eigenvalues only
932*
933 IF( info.EQ.0 ) THEN
934 vl = one
935 vu = -one
936 jobz = 'V'
937 range = 'V'
938*
939* We use PDLASIZESYEVX to choose VL and VU for us.
940*
941 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
942 $ iseed, win( 1+iprepad ), maxsize,
943 $ vecsize, valsize )
944*
945 lsyevxsize = valsize
946*
947 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
948 $ iu, thresh, abstol, a, copya, z, 1, 1,
949 $ desca, win( 1+iprepad ), wnew, ifail,
950 $ iclustr, gap, iprepad, ipostpad,
951 $ work( indwork ), llwork, lsyevxsize,
952 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
953 $ nout )
954*
955 IF( res.NE.0 ) THEN
956 maxtstnrm = max( tstnrm, maxtstnrm )
957 maxqtqnrm = max( qtqnrm, maxqtqnrm )
958 passed = 'FAILED stest12'
959 info = 1
960 END IF
961 END IF
962*
963* Subtest 13: JOBZ = 'V', RANGE = 'V',
964* random memory (more than minimum required
965* for eigenvalues, less than required for vectors)
966*
967 IF( info.EQ.0 ) THEN
968 vl = one
969 vu = -one
970 jobz = 'V'
971 range = 'V'
972*
973* We use PDLASIZESYEVX to choose VL and VU for us.
974*
975 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
976 $ iseed, win( 1+iprepad ), maxsize,
977 $ vecsize, valsize )
978*
979 lsyevxsize = valsize + int( dlaran( iseed )*
980 $ dble( vecsize-valsize ) )
981*
982 CALL pdsepsubtst( .true., jobz, range, uplo, n, vl, vu, il,
983 $ iu, thresh, abstol, a, copya, z, 1, 1,
984 $ desca, win( 1+iprepad ), wnew, ifail,
985 $ iclustr, gap, iprepad, ipostpad,
986 $ work( indwork ), llwork, lsyevxsize,
987 $ iwork, isizesyevx, res, tstnrm, qtqnrm,
988 $ nout )
989*
990 IF( res.NE.0 ) THEN
991 maxtstnrm = max( tstnrm, maxtstnrm )
992 maxqtqnrm = max( qtqnrm, maxqtqnrm )
993 passed = 'FAILED stest13'
994 info = 1
995 END IF
996 END IF
997 END IF
998*
999*
1000*
1001 CALL igamx2d( context, 'All', ' ', 1, 1, info, 1, -1, -1, -1, -1,
1002 $ -1 )
1003*
1004 IF( info.EQ.1 ) THEN
1005 IF( iam.EQ.0 ) THEN
1006 WRITE( nout, fmt = 9994 )'C '
1007 WRITE( nout, fmt = 9993 )iseedin( 1 )
1008 WRITE( nout, fmt = 9992 )iseedin( 2 )
1009 WRITE( nout, fmt = 9991 )iseedin( 3 )
1010 WRITE( nout, fmt = 9990 )iseedin( 4 )
1011 IF( lsame( uplo, 'L' ) ) THEN
1012 WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
1013 ELSE
1014 WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
1015 END IF
1016 IF( lsame( subtests, 'Y' ) ) THEN
1017 WRITE( nout, fmt = 9994 )' SUBTESTS= ''Y'' '
1018 ELSE
1019 WRITE( nout, fmt = 9994 )' SUBTESTS= ''N'' '
1020 END IF
1021 WRITE( nout, fmt = 9989 )n
1022 WRITE( nout, fmt = 9988 )nprow
1023 WRITE( nout, fmt = 9987 )npcol
1024 WRITE( nout, fmt = 9986 )nb
1025 WRITE( nout, fmt = 9985 )mattype
1026 WRITE( nout, fmt = 9982 )abstol
1027 WRITE( nout, fmt = 9981 )thresh
1028 WRITE( nout, fmt = 9994 )'C '
1029 END IF
1030 END IF
1031*
1032 CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
1033 CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
1034 IF( iam.EQ.0 ) THEN
1035 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1036 IF( wtime( 1 ).GE.0.0 ) THEN
1037 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1038 $ subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
1039 $ maxqtqnrm, passed
1040 ELSE
1041 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1042 $ subtests, ctime( 1 ), maxtstnrm, maxqtqnrm, passed
1043 END IF
1044 ELSE IF( info.EQ.2 ) THEN
1045 IF( wtime( 1 ).GE.0.0 ) THEN
1046 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1047 $ subtests, wtime( 1 ), ctime( 1 )
1048 ELSE
1049 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1050 $ subtests, ctime( 1 )
1051 END IF
1052 ELSE IF( info.EQ.3 ) THEN
1053 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1054 $ subtests
1055 END IF
1056 END IF
1057*
1058* Now that PDSYEVX been tested, we check PDSYEV if we are a
1059* homogeneous machine.
1060*
1061 IF( lsame( hetero, 'N' ) .AND. lsame( subtests, 'N' ) ) THEN
1062 passed = 'PASSED EV'
1063*
1064* PDSYEV test1:
1065* JOBZ = 'N', eigenvalues only
1066*
1067 IF( info.NE.0 ) THEN
1068*
1069* If the EVX tests fail, we do not perform the EV tests
1070*
1071 passed = 'SKIPPED EV'
1072 ELSE
1073 jobz = 'N'
1074*
1075 CALL pdsyev( jobz, uplo, n, a, 1, 1, desca,
1076 $ work( indwork ), z, 1, 1, desca,
1077 $ work( indwork ), -1, info )
1078 minsize = int( work( indwork ) )
1079*
1080 CALL pdsqpsubtst( wknown, jobz, uplo, n, thresh, abstol, a,
1081 $ copya, z, 1, 1, desca, win, wnew, iprepad,
1082 $ ipostpad, work( indwork ), llwork,
1083 $ minsize, res, tstnrm, qtqnrm, nout )
1084*
1085 IF( res.NE.0 ) THEN
1086 maxtstnrm = max( tstnrm, maxtstnrm )
1087 maxqtqnrm = max( qtqnrm, maxqtqnrm )
1088 passed = 'FAIL EV test1'
1089 info = 1
1090 END IF
1091 END IF
1092*
1093* PDSYEV test2:
1094* JOBZ = 'V', eigenvalues and eigenvectors
1095*
1096 IF( info.EQ.0 ) THEN
1097 jobz = 'V'
1098*
1099 CALL pdsyev( jobz, uplo, n, a, 1, 1, desca,
1100 $ work( indwork ), z, 1, 1, desca,
1101 $ work( indwork ), -1, info )
1102 minsize = int( work( indwork ) )
1103*
1104 CALL pdsqpsubtst( wknown, jobz, uplo, n, thresh, abstol, a,
1105 $ copya, z, 1, 1, desca, win, wnew, iprepad,
1106 $ ipostpad, work( indwork ), llwork,
1107 $ minsize, res, tstnrm, qtqnrm, nout )
1108*
1109 IF( res.NE.0 ) THEN
1110 maxtstnrm = max( tstnrm, maxtstnrm )
1111 maxqtqnrm = max( qtqnrm, maxqtqnrm )
1112 passed = 'FAIL EV test2'
1113 info = 1
1114 END IF
1115 END IF
1116 IF( info.EQ.1 ) THEN
1117 IF( iam.EQ.0 ) THEN
1118 WRITE( nout, fmt = 9994 )'C '
1119 WRITE( nout, fmt = 9993 )iseedin( 1 )
1120 WRITE( nout, fmt = 9992 )iseedin( 2 )
1121 WRITE( nout, fmt = 9991 )iseedin( 3 )
1122 WRITE( nout, fmt = 9990 )iseedin( 4 )
1123 IF( lsame( uplo, 'L' ) ) THEN
1124 WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
1125 ELSE
1126 WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
1127 END IF
1128 WRITE( nout, fmt = 9989 )n
1129 WRITE( nout, fmt = 9988 )nprow
1130 WRITE( nout, fmt = 9987 )npcol
1131 WRITE( nout, fmt = 9986 )nb
1132 WRITE( nout, fmt = 9985 )mattype
1133 WRITE( nout, fmt = 9982 )abstol
1134 WRITE( nout, fmt = 9981 )thresh
1135 WRITE( nout, fmt = 9994 )'C '
1136 END IF
1137 END IF
1138*
1139 CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
1140 CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
1141 IF( iam.EQ.0 ) THEN
1142 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1143 IF( wtime( 1 ).GE.0.0 ) THEN
1144 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1145 $ subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
1146 $ maxqtqnrm, passed
1147 ELSE
1148 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1149 $ subtests, ctime( 1 ), maxtstnrm, maxqtqnrm,
1150 $ passed
1151 END IF
1152 ELSE IF( info.EQ.2 ) THEN
1153 IF( wtime( 1 ).GE.0.0 ) THEN
1154 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1155 $ subtests, wtime( 1 ), ctime( 1 )
1156 ELSE
1157 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1158 $ subtests, ctime( 1 )
1159 END IF
1160 ELSE IF( info.EQ.3 ) THEN
1161 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1162 $ subtests
1163 END IF
1164 END IF
1165 ENDIF
1166*
1167* Now that PDSYEV been tested, we check PDSYEVD if we are a
1168* homogeneous machine.
1169*
1170 IF( lsame( hetero, 'N' ) .AND. lsame( subtests, 'N' ) ) THEN
1171 passed = 'PASSED EVD'
1172*
1173* PDSYEVD test1:
1174*
1175 IF( info.NE.0 ) THEN
1176*
1177* If the EV tests fail, we do not perform the EVD tests
1178*
1179 passed = 'SKIPPED EVD'
1180 ELSE
1181*
1182 np = numroc( n, desca( mb_ ), 0, 0, nprow )
1183 nq = numroc( n, desca( nb_ ), 0, 0, npcol )
1184 minsize = max( 1+6*n+2*np*nq,
1185 $ 3*n + max( nb*( np+1 ), 3*nb ) ) + 2*n
1186*
1187 CALL pdsdpsubtst( wknown, uplo, n, thresh, abstol, a,
1188 $ copya, z, 1, 1, desca, win, wnew, iprepad,
1189 $ ipostpad, work( indwork ), llwork,
1190 $ minsize, iwork, isizesyevd,
1191 $ res, tstnrm, qtqnrm, nout )
1192*
1193 IF( res.NE.0 ) THEN
1194 maxtstnrm = max( tstnrm, maxtstnrm )
1195 maxqtqnrm = max( qtqnrm, maxqtqnrm )
1196 passed = 'FAIL EVD test1'
1197 info = 1
1198 END IF
1199 END IF
1200 IF( info.EQ.1 ) THEN
1201 IF( iam.EQ.0 ) THEN
1202 WRITE( nout, fmt = 9994 )'C '
1203 WRITE( nout, fmt = 9993 )iseedin( 1 )
1204 WRITE( nout, fmt = 9992 )iseedin( 2 )
1205 WRITE( nout, fmt = 9991 )iseedin( 3 )
1206 WRITE( nout, fmt = 9990 )iseedin( 4 )
1207 IF( lsame( uplo, 'L' ) ) THEN
1208 WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
1209 ELSE
1210 WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
1211 END IF
1212 WRITE( nout, fmt = 9989 )n
1213 WRITE( nout, fmt = 9988 )nprow
1214 WRITE( nout, fmt = 9987 )npcol
1215 WRITE( nout, fmt = 9986 )nb
1216 WRITE( nout, fmt = 9985 )mattype
1217 WRITE( nout, fmt = 9982 )abstol
1218 WRITE( nout, fmt = 9981 )thresh
1219 WRITE( nout, fmt = 9994 )'C '
1220 END IF
1221 END IF
1222*
1223 CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
1224 CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
1225 IF( iam.EQ.0 ) THEN
1226 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1227 IF( wtime( 1 ).GE.0.0 ) THEN
1228 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1229 $ subtests, wtime( 1 ), ctime( 1 ), tstnrm,
1230 $ qtqnrm, passed
1231 ELSE
1232 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1233 $ subtests, ctime( 1 ), maxtstnrm, maxqtqnrm,
1234 $ passed
1235 END IF
1236 ELSE IF( info.EQ.2 ) THEN
1237 IF( wtime( 1 ).GE.0.0 ) THEN
1238 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1239 $ subtests, wtime( 1 ), ctime( 1 )
1240 ELSE
1241 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1242 $ subtests, ctime( 1 )
1243 END IF
1244 ELSE IF( info.EQ.3 ) THEN
1245 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1246 $ subtests
1247 END IF
1248 END IF
1249 END IF
1250 RETURN
1251 9999 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x,
1252 $ f8.2, 1x, f8.2, 1x, g9.2, 1x, g9.2, 1x, a14 )
1253 9998 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, 8x,
1254 $ 1x, f8.2, 1x, g9.2, 1x, g9.2, a14 )
1255 9997 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, f8.2,
1256 $ 1x, f8.2, 21x, 'Bypassed' )
1257 9996 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, 8x,
1258 $ 1x, f8.2, 21x, 'Bypassed' )
1259 9995 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 32x,
1260 $ 'Bad MEMORY parameters' )
1261 9994 FORMAT( a )
1262 9993 FORMAT( ' ISEED( 1 ) =', i8 )
1263 9992 FORMAT( ' ISEED( 2 ) =', i8 )
1264 9991 FORMAT( ' ISEED( 3 ) =', i8 )
1265 9990 FORMAT( ' ISEED( 4 ) =', i8 )
1266 9989 FORMAT( ' N=', i8 )
1267 9988 FORMAT( ' NPROW=', i8 )
1268 9987 FORMAT( ' NPCOL=', i8 )
1269 9986 FORMAT( ' NB=', i8 )
1270 9985 FORMAT( ' MATTYPE=', i8 )
1271 9984 FORMAT( ' IBTYPE=', i8 )
1272 9983 FORMAT( ' SUBTESTS=', a1 )
1273 9982 FORMAT( ' ABSTOL=', d16.6 )
1274 9981 FORMAT( ' THRESH=', d16.6 )
1275 9980 FORMAT( ' Increase TOTMEM in PDSEPDRIVER' )
1276*
1277* End of PDSEPTST
1278*
pdmatgen
subroutine pdmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
Definition pdmatgen.f:4
dlatms
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
Definition dlatms.f:3
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition numroc.f:2
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
pdlaset
subroutine pdlaset(uplo, m, n, alpha, beta, a, ia, ja, desca)
Definition pdblastst.f:6862
pdlamch
double precision function pdlamch(ictxt, cmach)
Definition pdblastst.f:6769
pdchekpad
subroutine pdchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
Definition pdchekpad.f:3
pdelset
subroutine pdelset(a, ia, ja, desca, alpha)
Definition pdelset.f:2
pdfillpad
subroutine pdfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
Definition pdfillpad.f:2
pdlasizesqp
subroutine pdlasizesqp(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, sizeqtq, sizechk, sizesyevx, isizesyevx, sizesyev, sizesyevd, isizesyevd, sizesubtst, isizesubtst, sizetst, isizetst)
Definition pdlasizesqp.f:7
pdlasizesyevx
subroutine pdlasizesyevx(wknown, range, n, desca, vl, vu, il, iu, iseed, win, maxsize, vecsize, valsize)
Definition pdlasizesyevx.f:5
pdlatms
subroutine pdlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, ia, ja, desca, order, work, lwork, info)
Definition pdlatms.f:6
pdsdpsubtst
subroutine pdsdpsubtst(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 pdsdpsubtst.f:6
pdsepsubtst
subroutine pdsepsubtst(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 pdsepsubtst.f:7
pdsqpsubtst
subroutine pdsqpsubtst(wknown, jobz, uplo, n, thresh, abstol, a, copya, z, ia, ja, desca, win, wnew, iprepad, ipostpad, work, lwork, lwork1, result, tstnrm, qtqnrm, nout)
Definition pdsqpsubtst.f:7
pdsyev
subroutine pdsyev(jobz, uplo, n, a, ia, ja, desca, w, z, iz, jz, descz, work, lwork, info)
Definition pdsyev.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
dlaran
double precision function dlaran(iseed)
Definition tools.f:2000
Here is the call graph for this function:
Here is the caller graph for this function: