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