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