ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzseprtst.f
Go to the documentation of this file.
1  SUBROUTINE pzseprtst(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, RWORK, LRWORK,
5  $ IWORK, LIWORK, HETERO, NOUT, INFO )
6 *
7 * -- ScaLAPACK routine (@(MODE)version *TBA*) --
8 * University of California, Berkeley and
9 * University of Tennessee, Knoxville.
10 * October 21, 2006
11 *
12  IMPLICIT NONE
13 *
14 * .. Scalar Arguments ..
15  CHARACTER HETERO, SUBTESTS, UPLO
16  INTEGER INFO, IPOSTPAD, IPREPAD, LDA, LIWORK, LWORK,
17  $ MATTYPE, N, NOUT, ORDER
18  INTEGER LRWORK
19  DOUBLE PRECISION ABSTOL, THRESH
20 * ..
21 * .. Array Arguments ..
22  INTEGER DESCA( * ), ICLUSTR( * ), IFAIL( * ),
23  $ iseed( 4 ), iwork( * )
24  DOUBLE PRECISION GAP( * ), WIN( * ), WNEW( * ), RWORK( * )
25  COMPLEX*16 A( LDA, * ), COPYA( LDA, * ),
26  $ work( * ), z( lda, * )
27 * ..
28 *
29 * Purpose
30 * =======
31 *
32 * PZSEPRTST builds a random matrix and runs PZHEEVR to
33 * compute the eigenvalues and eigenvectors. Then it performs two tests
34 * to determine if the result is good enough. The two tests are:
35 * |AQ -QL| / (abstol + ulp * norm(A) )
36 * and
37 * |QT * Q - I| / ulp * norm(A)
38 *
39 * The random matrix built depends upon the following parameters:
40 * N, NB, ISEED, ORDER
41 *
42 * Arguments
43 * =========
44 *
45 * NP = the number of rows local to a given process.
46 * NQ = the number of columns local to a given process.
47 *
48 * DESCA (global and local input) INTEGER array of dimension DLEN_
49 * The array descriptor for the distributed matrices
50 *
51 * UPLO (global input) CHARACTER*1
52 * Specifies whether the upper or lower triangular part of the
53 * matrix A is stored:
54 * = 'U': Upper triangular
55 * = 'L': Lower triangular
56 *
57 * N (global input) INTEGER
58 * Size of the matrix to be tested. (global size)
59 *
60 * MATTYPE (global input) INTEGER
61 * Matrix type
62 * Currently, the list of possible types is:
63 *
64 * (1) The zero matrix.
65 * (2) The identity matrix.
66 *
67 * (3) A diagonal matrix with evenly spaced entries
68 * 1, ..., ULP and random signs.
69 * (ULP = (first number larger than 1) - 1 )
70 * (4) A diagonal matrix with geometrically spaced entries
71 * 1, ..., ULP and random signs.
72 * (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
73 * and random signs.
74 *
75 * (6) Same as (4), but multiplied by SQRT( overflow threshold )
76 * (7) Same as (4), but multiplied by SQRT( underflow threshold )
77 *
78 * (8) A matrix of the form U' D U, where U is orthogonal and
79 * D has evenly spaced entries 1, ..., ULP with random signs
80 * on the diagonal.
81 *
82 * (9) A matrix of the form U' D U, where U is orthogonal and
83 * D has geometrically spaced entries 1, ..., ULP with random
84 * signs on the diagonal.
85 *
86 * (10) A matrix of the form U' D U, where U is orthogonal and
87 * D has "clustered" entries 1, ULP,..., ULP with random
88 * signs on the diagonal.
89 *
90 * (11) Same as (8), but multiplied by SQRT( overflow threshold )
91 * (12) Same as (8), but multiplied by SQRT( underflow threshold )
92 *
93 * (13) A matrix with random entries chosen from (-1,1).
94 * (14) Same as (13), but multiplied by SQRT( overflow threshold )
95 * (15) Same as (13), but multiplied by SQRT( underflow threshold )
96 * (16) Same as (8), but diagonal elements are all positive.
97 * (17) Same as (9), but diagonal elements are all positive.
98 * (18) Same as (10), but diagonal elements are all positive.
99 * (19) Same as (16), but multiplied by SQRT( overflow threshold )
100 * (20) Same as (16), but multiplied by SQRT( underflow threshold )
101 * (21) A tridiagonal matrix that is a direct sum of smaller diagonally
102 * dominant submatrices. Each unreduced submatrix has geometrically
103 * spaced diagonal entries 1, ..., ULP.
104 * (22) A matrix of the form U' D U, where U is orthogonal and
105 * D has ceil(lgN) "clusters" at 0,1,2,...,ceil(lgN)-1. The
106 * size of the cluster at the value I is 2^I.
107 *
108 * SUBTESTS (global input) CHARACTER*1
109 * 'Y' - Perform subset tests
110 * 'N' - Do not perform subset tests
111 *
112 * THRESH (global input) DOUBLE PRECISION
113 * A test will count as "failed" if the "error", computed as
114 * described below, exceeds THRESH. Note that the error
115 * is scaled to be O(1), so THRESH should be a reasonably
116 * small multiple of 1, e.g., 10 or 100. In particular,
117 * it should not depend on the precision (single vs. double)
118 * or the size of the matrix. It must be at least zero.
119 *
120 * ORDER (global input) INTEGER
121 * Number of reflectors used in test matrix creation.
122 * If ORDER is large, it will
123 * take more time to create the test matrices but they will
124 * be closer to random.
125 * ORDER .lt. N not implemented
126 *
127 * ABSTOL (global input) DOUBLE PRECISION
128 * For the purposes of this test, ABSTOL=0.0 is fine.
129 * THis test does not test for high relative accuracy.
130 *
131 * ISEED (global input/output) INTEGER array, dimension (4)
132 * On entry, the seed of the random number generator; the array
133 * elements must be between 0 and 4095, and ISEED(4) must be
134 * odd.
135 * On exit, the seed is updated.
136 *
137 * A (local workspace) COMPLEX*16 array, dim (N*N)
138 * global dimension (N, N), local dimension (LDA, NQ)
139 * The test matrix, which is then overwritten.
140 * A is distributed in a block cyclic manner over both rows
141 * and columns. The actual location of a particular element
142 * in A is controlled by the values of NPROW, NPCOL, and NB.
143 *
144 * COPYA (local workspace) COMPLEX*16 array, dim (N, N)
145 * COPYA is used to hold an identical copy of the array A
146 * identical in both form and content to A
147 *
148 * Z (local workspace) COMPLEX*16 array, dim (N*N)
149 * Z is distributed in the same manner as A
150 * Z is used as workspace by the test routines
151 * PZSEPCHK and PZSEPQTQ
152 *
153 * W (local workspace) DOUBLE PRECISION array, dimension (N)
154 * On normal exit, the first M entries
155 * contain the selected eigenvalues in ascending order.
156 *
157 * IFAIL (global workspace) INTEGER array, dimension (N)
158 * Not used, only for backward compatibility
159 *
160 * WORK (local workspace) COMPLEX*16 array, dimension (LWORK)
161 *
162 * LWORK (local input) INTEGER
163 * The length of the array WORK. LWORK >= SIZETST as
164 * returned by PZLASIZESEPR
165 *
166 * RWORK (local workspace) DOUBLE PRECISION array, dimension (LRWORK)
167 *
168 * LRWORK (local input) INTEGER
169 * The length of the array WORK. LRWORK >= RSIZETST as
170 * returned by P@(CRPF)LASIZESEPR
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 PZLASIZESEPR
177 *
178 * HETERO (input) INTEGER
179 *
180 * NOUT (local input) INTEGER
181 * The unit number for output file. Only used on node 0.
182 * NOUT = 6, output to screen,
183 * NOUT = 0, output to stderr.
184 * NOUT = 13, output to file, divide thresh by 10.0
185 * NOUT = 14, output to file, divide thresh by 20.0
186 * (This hack allows us to test more stringently internally
187 * so that when errors on found on other computers they will
188 * be serious enough to warrant our attention.)
189 *
190 * INFO (global output) INTEGER
191 * -3 This process is not involved
192 * 0 Test succeeded (passed |AQ -QL| and |QT*Q - I| tests)
193 * 1 At least one test failed
194 * 2 Residual test were not performed, thresh <= 0.0
195 * 3 Test was skipped because of inadequate memory space
196 *
197 * .. Parameters ..
198  INTEGER CTXT_, MB_, NB_, RSRC_, CSRC_, LLD_
199  PARAMETER ( CTXT_ = 2, mb_ = 5, nb_ = 6,
200  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
201  DOUBLE PRECISION HALF, ONE, TEN, ZERO
202  parameter( zero = 0.0d0, one = 1.0d0,
203  $ ten = 10.0d0, half = 0.5d0 )
204  COMPLEX*16 PADVAL
205  parameter( padval = ( 19.25d0, 1.1d1 ) )
206  COMPLEX*16 ZZERO
207  PARAMETER ( ZZERO = ( 0.0d0, 0.0d0 ) )
208  COMPLEX*16 ZONE
209  parameter( zone = ( 1.0d0, 0.0d0 ) )
210  INTEGER MAXTYP
211  parameter( maxtyp = 22 )
212 * ..
213 *
214 * .. Local Scalars ..
215  LOGICAL WKNOWN
216  CHARACTER JOBZ, RANGE
217  CHARACTER*14 PASSED
218  INTEGER CONTEXT, I, IAM, IHETERO, IINFO, IL, IMODE, IN,
219  $ indd, indwork, isizesubtst, isizeevr,
220  $ isizetst, itype, iu, j, llwork, levrsize,
221  $ maxsize, mycol, myrow, nb, ngen, nloc,
222  $ nnodes, np, npcol, nprow, nq, res, sizechk,
223  $ sizemqrleft, sizemqrright, sizeqrf, sizeqtq,
224  $ sizesubtst, sizeevr, sizetms,
225  $ sizetst, valsize, vecsize
226  INTEGER INDRWORK, LLRWORK, RSIZEEVR, RSIZESUBTST,
227  $ RSIZETST
228  DOUBLE PRECISION ANINV, ANORM, COND, MAXQTQNRM, MAXTSTNRM, OVFL,
229  $ QTQNRM, RTOVFL, RTUNFL, TEMP1, TSTNRM, ULP,
230  $ ulpinv, unfl, vl, vu
231 * ..
232 * .. Local Arrays ..
233  INTEGER ISEEDIN( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
234  $ KTYPE( MAXTYP )
235  DOUBLE PRECISION CTIME( 10 ), WTIME( 10 )
236 * ..
237 * .. External Functions ..
238  LOGICAL LSAME
239  INTEGER NUMROC
240  DOUBLE PRECISION DLARAN, PDLAMCH
241  EXTERNAL DLARAN, LSAME, NUMROC, PDLAMCH
242 * ..
243 * .. External Subroutines ..
244  EXTERNAL blacs_gridinfo, blacs_pinfo, dlabad, dlasrt,
245  $ igamx2d, igebr2d, igebs2d, pzchekpad, pzelset,
246  $ pzfillpad, pzlaset, pzlasizeheevr,
247  $ pzlasizesepr, pzlatms, pzmatgen, pzseprsubtst,
248  $ slcombine, zlatms
249 * ..
250 * .. Intrinsic Functions ..
251  INTRINSIC abs, dble, int, max, min, sqrt
252 * ..
253 * .. Data statements ..
254  DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
255  $ 8, 8, 9, 9, 9, 9, 9, 10, 11 /
256  DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
257  $ 2, 3, 1, 1, 1, 2, 3, 1, 1 /
258  DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
259  $ 0, 0, 4, 3, 1, 4, 4, 3, 0 /
260 * ..
261 * .. Executable Statements ..
262 *
263  info = 0
264  passed = 'PASSED EVR'
265  context = desca( ctxt_ )
266  nb = desca( nb_ )
267 *
268  CALL blacs_pinfo( iam, nnodes )
269  CALL blacs_gridinfo( context, nprow, npcol, myrow, mycol )
270 *
271 * Distribute HETERO across processes
272 *
273  IF( iam.EQ.0 ) THEN
274  IF( lsame( hetero, 'Y' ) ) THEN
275  ihetero = 2
276  ELSE
277  ihetero = 1
278  END IF
279  CALL igebs2d( context, 'All', ' ', 1, 1, ihetero, 1 )
280  ELSE
281  CALL igebr2d( context, 'All', ' ', 1, 1, ihetero, 1, 0, 0 )
282  END IF
283  IF( ihetero.EQ.2 ) THEN
284  hetero = 'Y'
285  ELSE
286  hetero = 'N'
287  END IF
288 *
289 * Make sure that there is enough memory
290 *
291  CALL pzlasizesepr( desca, iprepad, ipostpad, sizemqrleft,
292  $ sizemqrright, sizeqrf, sizetms, sizeqtq,
293  $ sizechk, sizeevr, rsizeevr, isizeevr,
294  $ sizesubtst, rsizesubtst,
295  $ isizesubtst, sizetst, rsizetst, isizetst )
296  IF( lrwork.LT.rsizetst ) THEN
297  info = 3
298  END IF
299 *
300  CALL igamx2d( context, 'a', ' ', 1, 1, info, 1, 1, 1, -1, -1, 0 )
301 *
302  IF( info.EQ.0 ) THEN
303 *
304  indd = 1
305  indrwork = indd + n
306  indwork = 1
307  llwork = lwork - indwork + 1
308  llrwork = lrwork - indrwork + 1
309 *
310  ulp = pdlamch( context, 'P' )
311  ulpinv = one / ulp
312  unfl = pdlamch( context, 'Safe min' )
313  ovfl = one / unfl
314  CALL dlabad( unfl, ovfl )
315  rtunfl = sqrt( unfl )
316  rtovfl = sqrt( ovfl )
317  aninv = one / dble( max( 1, n ) )
318 *
319 * This ensures that everyone starts out with the same seed.
320 *
321  IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
322  CALL igebs2d( context, 'a', ' ', 4, 1, iseed, 4 )
323  ELSE
324  CALL igebr2d( context, 'a', ' ', 4, 1, iseed, 4, 0, 0 )
325  END IF
326  iseedin( 1 ) = iseed( 1 )
327  iseedin( 2 ) = iseed( 2 )
328  iseedin( 3 ) = iseed( 3 )
329  iseedin( 4 ) = iseed( 4 )
330 *
331 * Compute the matrix A
332 *
333 * Control parameters:
334 *
335 * KMAGN KMODE KTYPE
336 * =1 O(1) clustered 1 zero
337 * =2 large clustered 2 identity
338 * =3 small exponential (none)
339 * =4 arithmetic diagonal, (w/ eigenvalues)
340 * =5 random log Hermitian, w/ eigenvalues
341 * =6 random (none)
342 * =7 random diagonal
343 * =8 random Hermitian
344 * =9 positive definite
345 * =10 block diagonal with tridiagonal blocks
346 * =11 Geometrically sized clusters.
347 *
348  itype = ktype( mattype )
349  imode = kmode( mattype )
350 *
351 * Compute norm
352 *
353  GO TO ( 10, 20, 30 )kmagn( mattype )
354 *
355  10 CONTINUE
356  anorm = one
357  GO TO 40
358 *
359  20 CONTINUE
360  anorm = ( rtovfl*ulp )*aninv
361  GO TO 40
362 *
363  30 CONTINUE
364  anorm = rtunfl*n*ulpinv
365  GO TO 40
366 *
367  40 CONTINUE
368  IF( mattype.LE.15 ) THEN
369  cond = ulpinv
370  ELSE
371  cond = ulpinv*aninv / ten
372  END IF
373 *
374 * Special Matrices
375 *
376  IF( itype.EQ.1 ) THEN
377 *
378 * Zero Matrix
379 *
380  DO 50 i = 1, n
381  rwork( indd+i-1 ) = zero
382  50 CONTINUE
383  CALL pzlaset( 'All', n, n,zzero,zzero, copya, 1, 1, desca )
384  wknown = .true.
385 *
386  ELSE IF( itype.EQ.2 ) THEN
387 *
388 * Identity Matrix
389 *
390  DO 60 i = 1, n
391  rwork( indd+i-1 ) = one
392  60 CONTINUE
393  CALL pzlaset( 'All', n, n,zzero,zone, copya, 1, 1, desca )
394  wknown = .true.
395 *
396  ELSE IF( itype.EQ.4 ) THEN
397 *
398 * Diagonal Matrix, [Eigen]values Specified
399 *
400  CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
401  $ sizetms, iprepad, ipostpad, padval+1.0d0 )
402 *
403  CALL pzlatms( n, n, 'S', iseed, 'S',rwork( indd ), imode,
404  $ cond, anorm, 0, 0, 'N', copya, 1, 1, desca,
405  $ order, work( indwork+iprepad ), sizetms,
406  $ iinfo )
407  wknown = .true.
408 *
409  CALL pzchekpad( desca( ctxt_ ), 'PZLATMS1-WORK', sizetms, 1,
410  $ work( indwork ), sizetms, iprepad, ipostpad,
411  $ padval+1.0d0 )
412 *
413  ELSE IF( itype.EQ.5 ) THEN
414 *
415 * Hermitian, eigenvalues specified
416 *
417  CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
418  $ sizetms, iprepad, ipostpad, padval+2.0d0 )
419 *
420  CALL pzlatms( n, n, 'S', iseed, 'S',rwork( indd ), imode,
421  $ cond, anorm, n, n, 'N', copya, 1, 1, desca,
422  $ order, work( indwork+iprepad ), sizetms,
423  $ iinfo )
424 *
425  CALL pzchekpad( desca( ctxt_ ), 'PZLATMS2-WORK', sizetms, 1,
426  $ work( indwork ), sizetms, iprepad, ipostpad,
427  $ padval+2.0d0 )
428 *
429  wknown = .true.
430 *
431  ELSE IF( itype.EQ.8 ) THEN
432 *
433 * Hermitian, random eigenvalues
434 *
435  np = numroc( n, desca( mb_ ), myrow, 0, nprow )
436  nq = numroc( n, desca( nb_ ), mycol, 0, npcol )
437  CALL pzmatgen( desca( ctxt_ ), 'H', 'N', n, n, desca( mb_ ),
438  $ desca( nb_ ), copya, desca( lld_ ),
439  $ desca( rsrc_ ), desca( csrc_ ), iseed( 1 ),
440  $ 0, np, 0, nq, myrow, mycol, nprow, npcol )
441  info = 0
442  wknown = .false.
443 *
444  ELSE IF( itype.EQ.9 ) THEN
445 *
446 * Positive definite, eigenvalues specified.
447 *
448  CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
449  $ sizetms, iprepad, ipostpad, padval+3.0d0 )
450 *
451  CALL pzlatms( n, n, 'S', iseed, 'S',rwork( 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 pzchekpad( desca( ctxt_ ), 'PZLATMS3-WORK', sizetms, 1,
459  $ work( indwork ), sizetms, iprepad, ipostpad,
460  $ padval+3.0d0 )
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 pzlaset( 'All', n, n,zzero,zzero, 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 zlatms( in, in, 'S', iseed, 'P',rwork( 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 pzelset( copya, ngen+1, ngen+1, desca, a( 1, 1 ) )
491  DO 90 i = 2, in
492  CALL pzelset( copya, ngen+i, ngen+i, desca,
493  $ a( i, i ) )
494  CALL pzelset( copya, ngen+i-1, ngen+i, desca,
495  $ a( i-1, i ) )
496  CALL pzelset( 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  rwork( 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  CALL pzfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
524  $ sizetms, iprepad, ipostpad, padval+4.0d0 )
525 *
526  CALL pzlatms( n, n, 'S', iseed, 'S',rwork( indd ), imode,
527  $ cond, anorm, 0, 0, 'N', copya, 1, 1, desca,
528  $ order, work( indwork+iprepad ), sizetms,
529  $ iinfo )
530 *
531  CALL pzchekpad( desca( ctxt_ ), 'PZLATMS4-WORK', sizetms, 1,
532  $ work( indwork ), sizetms, iprepad, ipostpad,
533  $ padval+4.0d0 )
534 *
535  ELSE
536  iinfo = 1
537  END IF
538 *
539  IF( wknown )
540  $ CALL dlasrt( 'I', n,rwork( indd ), iinfo )
541 *
542  CALL pzlasizeheevr( wknown, 'A', n, desca, vl, vu, il, iu,
543  $ iseed,rwork( indd ), maxsize, vecsize,
544  $ valsize )
545  levrsize = min( maxsize, llrwork )
546 *
547  CALL pzseprsubtst( wknown, 'v', 'a', uplo, n, vl, vu, il, iu,
548  $ thresh, abstol, a, copya, z, 1, 1, desca,
549  $ rwork( indd ), win, ifail, iclustr, gap,
550  $ iprepad, ipostpad, work( indwork ), llwork,
551  $ rwork( indrwork ), llrwork,
552  $ levrsize, iwork, isizeevr, res, tstnrm,
553  $ qtqnrm, nout )
554 *
555  maxtstnrm = tstnrm
556  maxqtqnrm = qtqnrm
557 *
558  IF( thresh.LE.zero ) THEN
559  passed = 'SKIPPED '
560  info = 2
561  ELSE IF( res.NE.0 ) THEN
562  passed = 'FAILED '
563  info = 1
564  END IF
565  END IF
566 *
567  IF( thresh.GT.zero .AND. lsame( subtests, 'Y' ) ) THEN
568 *
569 * Subtest 1: JOBZ = 'N', RANGE = 'A', minimum memory
570 *
571  IF( info.EQ.0 ) THEN
572 *
573  jobz = 'N'
574  range = 'A'
575  CALL pzlasizeheevr( .true., range, n, desca, vl, vu, il, iu,
576  $ iseed, win( 1+iprepad ), maxsize,
577  $ vecsize, valsize )
578 *
579  levrsize = valsize
580 *
581  CALL pzseprsubtst( .true., jobz, range, uplo, n, vl, vu, il,
582  $ iu, thresh, abstol, a, copya, z, 1, 1,
583  $ desca, win( 1+iprepad ), wnew, ifail,
584  $ iclustr, gap, iprepad, ipostpad,
585  $ work( indwork ), llwork,
586  $ rwork, lrwork, levrsize,
587  $ iwork, isizeevr, res, tstnrm, qtqnrm,
588  $ nout )
589 *
590  IF( res.NE.0 ) THEN
591  maxtstnrm = max( tstnrm, maxtstnrm )
592  maxqtqnrm = max( qtqnrm, maxqtqnrm )
593  passed = 'FAILED stest 1'
594  info = 1
595  END IF
596  END IF
597 *
598 * Subtest 2: JOBZ = 'N', RANGE = 'I', minimum memory
599 *
600  IF( info.EQ.0 ) THEN
601 *
602  il = -1
603  iu = -1
604  jobz = 'N'
605  range = 'I'
606 *
607 * Use PZLASIZEHEEVR to choose IL and IU.
608 *
609  CALL pzlasizeheevr( .true., range, n, desca, vl, vu, il, iu,
610  $ iseed, win( 1+iprepad ), maxsize,
611  $ vecsize, valsize )
612 *
613  levrsize = valsize
614 *
615  CALL pzseprsubtst( .true., jobz, range, uplo, n, vl, vu, il,
616  $ iu, thresh, abstol, a, copya, z, 1, 1,
617  $ desca, win( 1+iprepad ), wnew, ifail,
618  $ iclustr, gap, iprepad, ipostpad,
619  $ work( indwork ), llwork,
620  $ rwork, lrwork, levrsize,
621  $ iwork, isizeevr, res, tstnrm, qtqnrm,
622  $ nout )
623 *
624  IF( res.NE.0 ) THEN
625  maxtstnrm = max( tstnrm, maxtstnrm )
626  maxqtqnrm = max( qtqnrm, maxqtqnrm )
627  passed = 'FAILED stest 2'
628  info = 1
629  END IF
630  END IF
631 *
632 * Subtest 3: JOBZ = 'V', RANGE = 'I', minimum memory
633 *
634  IF( info.EQ.0 ) THEN
635  il = -1
636  iu = -1
637  jobz = 'V'
638  range = 'I'
639 *
640 * We use PZLASIZEHEEVR to choose IL and IU for us.
641 *
642  CALL pzlasizeheevr( .true., range, n, desca, vl, vu, il, iu,
643  $ iseed, win( 1+iprepad ), maxsize,
644  $ vecsize, valsize )
645 *
646  levrsize = vecsize
647 *
648  CALL pzseprsubtst( .true., jobz, range, uplo, n, vl, vu, il,
649  $ iu, thresh, abstol, a, copya, z, 1, 1,
650  $ desca, win( 1+iprepad ), wnew, ifail,
651  $ iclustr, gap, iprepad, ipostpad,
652  $ work( indwork ), llwork,
653  $ rwork, lrwork, levrsize,
654  $ iwork, isizeevr, res, tstnrm, qtqnrm,
655  $ nout )
656 *
657  IF( res.NE.0 ) THEN
658  maxtstnrm = max( tstnrm, maxtstnrm )
659  maxqtqnrm = max( qtqnrm, maxqtqnrm )
660  passed = 'FAILED stest 3'
661  info = 1
662  END IF
663  END IF
664 *
665 * Subtest 4: JOBZ = 'N', RANGE = 'V', minimum memory
666 *
667  IF( info.EQ.0 ) THEN
668  vl = one
669  vu = -one
670  jobz = 'N'
671  range = 'V'
672 *
673 * We use PZLASIZEHEEVR to choose IL and IU for us.
674 *
675  CALL pzlasizeheevr( .true., range, n, desca, vl, vu, il, iu,
676  $ iseed, win( 1+iprepad ), maxsize,
677  $ vecsize, valsize )
678 *
679  levrsize = valsize
680 *
681  CALL pzseprsubtst( .true., jobz, range, uplo, n, vl, vu, il,
682  $ iu, thresh, abstol, a, copya, z, 1, 1,
683  $ desca, win( 1+iprepad ), wnew, ifail,
684  $ iclustr, gap, iprepad, ipostpad,
685  $ work( indwork ), llwork,
686  $ rwork, lrwork, levrsize,
687  $ iwork, isizeevr, res, tstnrm, qtqnrm,
688  $ nout )
689 *
690  IF( res.NE.0 ) THEN
691  maxtstnrm = max( tstnrm, maxtstnrm )
692  maxqtqnrm = max( qtqnrm, maxqtqnrm )
693  passed = 'FAILED stest 4'
694  info = 1
695  END IF
696  END IF
697 *
698 * Subtest 5: JOBZ = 'V', RANGE = 'V', minimum memory
699 *
700  IF( info.EQ.0 ) THEN
701  vl = one
702  vu = -one
703  jobz = 'V'
704  range = 'V'
705 *
706 * We use PZLASIZEHEEVR to choose VL and VU for us.
707 *
708  CALL pzlasizeheevr( .true., range, n, desca, vl, vu, il, iu,
709  $ iseed, win( 1+iprepad ), maxsize,
710  $ vecsize, valsize )
711 *
712  levrsize = vecsize
713 *
714  CALL pzseprsubtst( .true., jobz, range, uplo, n, vl, vu, il,
715  $ iu, thresh, abstol, a, copya, z, 1, 1,
716  $ desca, win( 1+iprepad ), wnew, ifail,
717  $ iclustr, gap, iprepad, ipostpad,
718  $ work( indwork ), llwork,
719  $ rwork, lrwork, levrsize,
720  $ iwork, isizeevr, res, tstnrm, qtqnrm,
721  $ nout )
722 *
723  IF( res.NE.0 ) THEN
724  maxtstnrm = max( tstnrm, maxtstnrm )
725  maxqtqnrm = max( qtqnrm, maxqtqnrm )
726  passed = 'FAILED stest 5'
727  info = 1
728  END IF
729  END IF
730  END IF
731 *
732  CALL igamx2d( context, 'All', ' ', 1, 1, info, 1, -1, -1, -1, -1,
733  $ -1 )
734  IF( info.EQ.1 ) THEN
735  IF( iam.EQ.0 .AND. .false. ) THEN
736  WRITE( nout, fmt = 9994 )'C '
737  WRITE( nout, fmt = 9993 )iseedin( 1 )
738  WRITE( nout, fmt = 9992 )iseedin( 2 )
739  WRITE( nout, fmt = 9991 )iseedin( 3 )
740  WRITE( nout, fmt = 9990 )iseedin( 4 )
741  IF( lsame( uplo, 'L' ) ) THEN
742  WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
743  ELSE
744  WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
745  END IF
746  IF( lsame( subtests, 'Y' ) ) THEN
747  WRITE( nout, fmt = 9994 )' SUBTESTS= ''Y'' '
748  ELSE
749  WRITE( nout, fmt = 9994 )' SUBTESTS= ''N'' '
750  END IF
751  WRITE( nout, fmt = 9989 )n
752  WRITE( nout, fmt = 9988 )nprow
753  WRITE( nout, fmt = 9987 )npcol
754  WRITE( nout, fmt = 9986 )nb
755  WRITE( nout, fmt = 9985 )mattype
756  WRITE( nout, fmt = 9982 )abstol
757  WRITE( nout, fmt = 9981 )thresh
758  WRITE( nout, fmt = 9994 )'C '
759  END IF
760  END IF
761 *
762  CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
763  CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
764  IF( iam.EQ.0 ) THEN
765  IF( info.EQ.0 .OR. info.EQ.1 ) THEN
766  IF( wtime( 1 ).GE.0.0 ) THEN
767  WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
768  $ subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
769  $ maxqtqnrm, passed
770  ELSE
771  WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
772  $ subtests, ctime( 1 ), maxtstnrm, maxqtqnrm, passed
773  END IF
774  ELSE IF( info.EQ.2 ) THEN
775  IF( wtime( 1 ).GE.0.0 ) THEN
776  WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
777  $ subtests, wtime( 1 ), ctime( 1 )
778  ELSE
779  WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
780  $ subtests, ctime( 1 )
781  END IF
782  ELSE IF( info.EQ.3 ) THEN
783  WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
784  $ subtests
785  END IF
786 C WRITE(*,*)'************************************************'
787  END IF
788 *
789 
790  RETURN
791  9999 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x,
792  $ f8.2, 1x, f8.2, 1x, g9.2, 1x, g9.2, 1x, a14 )
793  9998 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, 8x,
794  $ 1x, f8.2, 1x, g9.2, 1x, g9.2, a14 )
795  9997 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, f8.2,
796  $ 1x, f8.2, 21x, 'Bypassed' )
797  9996 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 1x, 8x,
798  $ 1x, f8.2, 21x, 'Bypassed' )
799  9995 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, a1, 32x,
800  $ 'Bad MEMORY parameters' )
801  9994 FORMAT( a )
802  9993 FORMAT( ' ISEED( 1 ) =', i8 )
803  9992 FORMAT( ' ISEED( 2 ) =', i8 )
804  9991 FORMAT( ' ISEED( 3 ) =', i8 )
805  9990 FORMAT( ' ISEED( 4 ) =', i8 )
806  9989 FORMAT( ' N=', i8 )
807  9988 FORMAT( ' NPROW=', i8 )
808  9987 FORMAT( ' NPCOL=', i8 )
809  9986 FORMAT( ' NB=', i8 )
810  9985 FORMAT( ' MATTYPE=', i8 )
811 C 9984 FORMAT( ' IBTYPE=', I8 )
812 C 9983 FORMAT( ' SUBTESTS=', A1 )
813  9982 FORMAT( ' ABSTOL=', d16.6 )
814  9981 FORMAT( ' THRESH=', d16.6 )
815 C 9980 FORMAT( ' Increase TOTMEM in PZSEPRDRIVER' )
816 *
817 * End of PZSEPRTST
818 *
819  END
820 
821 
822 
823 
pzlasizeheevr
subroutine pzlasizeheevr(WKNOWN, RANGE, N, DESCA, VL, VU, IL, IU, ISEED, WIN, MAXSIZE, VECSIZE, VALSIZE)
Definition: pzlasizeheevr.f:3
max
#define max(A, B)
Definition: pcgemr.c:180
pzseprsubtst
subroutine pzseprsubtst(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: pzseprsubtst.f:7
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
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
Definition: zlatms.f:3
pzlasizesepr
subroutine pzlasizesepr(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, SIZECHK, SIZEHEEVR, RSIZEHEEVR, ISIZEHEEVR, SIZESUBTST, RSIZESUBTST, ISIZESUBTST, SIZETST, RSIZETST, ISIZETST)
Definition: pzlasizesepr.f:7
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
pzseprtst
subroutine pzseprtst(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, HETERO, NOUT, INFO)
Definition: pzseprtst.f:6
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