ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
psseptst.f
Go to the documentation of this file.
1  SUBROUTINE psseptst( 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  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 *
1280  END
max
#define max(A, B)
Definition: pcgemr.c:180
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
pslasizesyevx
subroutine pslasizesyevx(WKNOWN, RANGE, N, DESCA, VL, VU, IL, IU, ISEED, WIN, MAXSIZE, VECSIZE, VALSIZE)
Definition: pslasizesyevx.f:5
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
pselset
subroutine pselset(A, IA, JA, DESCA, ALPHA)
Definition: pselset.f:2
psseptst
subroutine psseptst(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: psseptst.f:6
pschekpad
subroutine pschekpad(ICTXT, MESS, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: pschekpad.f:3
slatms
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
Definition: slatms.f:3
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
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
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
psfillpad
subroutine psfillpad(ICTXT, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: psfillpad.f:2
pslaset
subroutine pslaset(UPLO, M, N, ALPHA, BETA, A, IA, JA, DESCA)
Definition: psblastst.f:6863
slcombine
subroutine slcombine(ICTXT, SCOPE, OP, TIMETYPE, N, IBEG, TIMES)
Definition: sltimer.f:267
min
#define min(A, B)
Definition: pcgemr.c:181