ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pdseptst.f
Go to the documentation of this file.
1  SUBROUTINE pdseptst( DESCA, UPLO, N, MATTYPE, SUBTESTS, THRESH,
2  $ ORDER, ABSTOL, ISEED, A, COPYA, Z, LDA, WIN,
3  $ WNEW, IFAIL, ICLUSTR, GAP, IPREPAD, IPOSTPAD,
4  $ WORK, LWORK, IWORK, LIWORK, HETERO, NOUT,
5  $ INFO )
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 *
1279  END
1280 
1281 
1282 
1283 
max
#define max(A, B)
Definition: pcgemr.c:180
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
pdlasizesyevx
subroutine pdlasizesyevx(WKNOWN, RANGE, N, DESCA, VL, VU, IL, IU, ISEED, WIN, MAXSIZE, VECSIZE, VALSIZE)
Definition: pdlasizesyevx.f:5
pdchekpad
subroutine pdchekpad(ICTXT, MESS, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: pdchekpad.f:3
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
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
pdseptst
subroutine pdseptst(DESCA, UPLO, N, MATTYPE, SUBTESTS, THRESH, ORDER, ABSTOL, ISEED, A, COPYA, Z, LDA, WIN, WNEW, IFAIL, ICLUSTR, GAP, IPREPAD, IPOSTPAD, WORK, LWORK, IWORK, LIWORK, HETERO, NOUT, INFO)
Definition: pdseptst.f:6
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
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
pdlaset
subroutine pdlaset(UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA)
Definition: pdblastst.f:6862
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
pdfillpad
subroutine pdfillpad(ICTXT, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: pdfillpad.f:2
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
Definition: dlatms.f:3
slcombine
subroutine slcombine(ICTXT, SCOPE, OP, TIMETYPE, N, IBEG, TIMES)
Definition: sltimer.f:267
pdelset
subroutine pdelset(A, IA, JA, DESCA, ALPHA)
Definition: pdelset.f:2
min
#define min(A, B)
Definition: pcgemr.c:181