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