SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
•All Classes Files Functions Variables Typedefs Macros

◆ pdgseptst()

subroutine pdgseptst ( integer, dimension( * )  desca,
character  uplo,
integer  n,
integer  mattype,
integer  ibtype,
character  subtests,
double precision  thresh,
integer  order,
double precision  abstol,
integer, dimension( 4 )  iseed,
double precision, dimension( lda, * )  a,
double precision, dimension( lda, * )  copya,
double precision, dimension( lda, * )  b,
double precision, dimension( lda, * )  copyb,
double precision, dimension( lda, * )  z,
integer  lda,
double precision, dimension( * )  win,
double precision, dimension( * )  wnew,
integer, dimension( * )  ifail,
integer, dimension( * )  iclustr,
double precision, dimension( * )  gap,
integer  iprepad,
integer  ipostpad,
double precision, dimension( * )  work,
integer  lwork,
integer, dimension( * )  iwork,
integer  liwork,
integer  nout,
integer  info 
)

Definition at line 3 of file pdgseptst.f.

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 $ LWORK, MATTYPE, N, NOUT, ORDER
18 DOUBLE PRECISION ABSTOL, THRESH
19* ..
20* .. Array Arguments ..
21 INTEGER DESCA( * ), ICLUSTR( * ), IFAIL( * ),
22 $ ISEED( 4 ), IWORK( * )
23 DOUBLE PRECISION A( LDA, * ), B( LDA, * ), COPYA( LDA, * ),
24 $ COPYB( LDA, * ), GAP( * ), WIN( * ), WNEW( * ),
25 $ WORK( * ), Z( LDA, * )
26* ..
27*
28* Purpose
29* =======
30*
31* PDGSEPTST builds a random matrix A, and a well conditioned
32* matrix B, runs PDSYGVX() to compute the eigenvalues
33* and eigenvectors and then calls PDSYGVCHK 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* symmetric 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) symmetric 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) DOUBLE PRECISION
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) DOUBLE PRECISION
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 ("PDSTEIN"),
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) DOUBLE PRECISION 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 PDSYGVX
156*
157* COPYA (local workspace) DOUBLE PRECISION 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) DOUBLE PRECISION 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 PDSYGVX
166*
167* COPYB (local workspace) DOUBLE PRECISION 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) DOUBLE PRECISION 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* PDGSEPCHK
175*
176* W (local workspace) DOUBLE PRECISION array, dimension (N)
177* On normal exit from PDSYGVX, 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) DOUBLE PRECISION array, dimension (LWORK)
183*
184* LWORK (local input) INTEGER
185* The length of the array WORK. LWORK >= SIZETST as
186* returned by PDLASIZEGSEP
187*
188* IWORK (local workspace) INTEGER array, dimension (LIWORK)
189*
190* LIWORK (local input) INTEGER
191* The length of the array IWORK. LIWORK >= ISIZETST as
192* returned by PDLASIZEGSEP
193*
194* NOUT (local input) INTEGER
195* The unit number for output file. Only used on node 0.
196* NOUT = 6, output to screen,
197* NOUT = 0, output to stderr.
198* NOUT = 13, output to file, divide thresh by 10.0
199* NOUT = 14, output to file, divide thresh by 20.0
200* (This hack allows us to test more stringently internally
201* so that when errors on found on other computers they will
202* be serious enough to warrant our attention.)
203*
204* INFO (global output) INTEGER
205* -3 This process is not involved
206* 0 Test succeeded (passed |AQ -QL| and |QT*Q - I| tests)
207* 1 At least one test failed
208* 2 Residual test were not performed, thresh <= 0.0
209* 3 Test was skipped because of inadequate memory space
210*
211* .. Parameters ..
212 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
213 $ MB_, NB_, RSRC_, CSRC_, LLD_
214 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
215 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
216 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
217 DOUBLE PRECISION ZERO, ONE, TEN, HALF
218 parameter( zero = 0.0d+0, one = 1.0d+0, ten = 10.0d+0,
219 $ half = 0.5d+0 )
220 DOUBLE PRECISION PADVAL
221 parameter( padval = 19.25d+0 )
222 INTEGER MAXTYP
223 parameter( maxtyp = 22 )
224* ..
225*
226* .. Local Scalars ..
227 LOGICAL WKNOWN
228 CHARACTER JOBZ, RANGE
229 CHARACTER*14 PASSED
230 INTEGER CONTEXT, I, IAM, IINFO, IL, IMODE, IN, INDD,
231 $ INDWORK, ISIZESUBTST, ISIZESYEVX, ISIZETST,
232 $ ITYPE, IU, J, LLWORK, LSYEVXSIZE, MAXSIZE,
233 $ MYCOL, MYROW, NB, NGEN, NLOC, NNODES, NP,
234 $ NPCOL, NPROW, NQ, RES, SIZECHK, SIZEMQRLEFT,
235 $ SIZEMQRRIGHT, SIZEQRF, SIZEQTQ, SIZESUBTST,
236 $ SIZESYEVX, SIZETMS, SIZETST, VALSIZE, VECSIZE
237 DOUBLE PRECISION ANINV, ANORM, COND, MAXQTQNRM, MAXTSTNRM, OVFL,
238 $ QTQNRM, RTOVFL, RTUNFL, TEMP1, TSTNRM, ULP,
239 $ ULPINV, UNFL, VL, VU
240* ..
241* .. Local Arrays ..
242 INTEGER ISEEDIN( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
243 $ KTYPE( MAXTYP )
244 DOUBLE PRECISION CTIME( 10 ), WTIME( 10 )
245* ..
246* .. External Functions ..
247 LOGICAL LSAME
248 INTEGER NUMROC
249 DOUBLE PRECISION DLARAN, PDLAMCH
250 EXTERNAL lsame, numroc, dlaran, pdlamch
251* ..
252* .. External Subroutines ..
253 EXTERNAL blacs_gridinfo, blacs_pinfo, dlabad, dlasrt,
254 $ dlatms, igamx2d, igebr2d, igebs2d, pdchekpad,
255 $ pdelset, pdfillpad, pdgsepsubtst, pdlaset,
256 $ pdlasizegsep, pdlasizesyevx, pdlatms, pdmatgen,
257 $ slcombine
258* ..
259* .. Intrinsic Functions ..
260 INTRINSIC abs, dble, int, max, min, mod, sqrt
261* ..
262* .. Data statements ..
263 DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
264 $ 8, 8, 9, 9, 9, 9, 9, 10, 11 /
265 DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
266 $ 2, 3, 1, 1, 1, 2, 3, 1, 1 /
267 DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
268 $ 0, 0, 4, 3, 1, 4, 4, 3, 0 /
269* ..
270* .. Executable Statements ..
271* This is just to keep ftnchek happy
272 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
273 $ rsrc_.LT.0 )RETURN
274*
275 info = 0
276 passed = 'PASSED '
277 context = desca( ctxt_ )
278 nb = desca( nb_ )
279*
280 CALL blacs_pinfo( iam, nnodes )
281 CALL blacs_gridinfo( context, nprow, npcol, myrow, mycol )
282*
283*
284* Make sure that we have enough memory
285*
286*
287 CALL pdlasizegsep( desca, iprepad, ipostpad, sizemqrleft,
288 $ sizemqrright, sizeqrf, sizetms, sizeqtq,
289 $ sizechk, sizesyevx, isizesyevx, sizesubtst,
290 $ isizesubtst, sizetst, isizetst )
291*
292 IF( lwork.LT.sizetst ) THEN
293 info = 3
294 END IF
295*
296 CALL igamx2d( context, 'a', ' ', 1, 1, info, 1, 1, 1, -1, -1, 0 )
297*
298 IF( info.EQ.0 ) THEN
299*
300 indd = 1
301 indwork = indd + n
302 llwork = lwork - indwork + 1
303*
304 ulp = pdlamch( context, 'P' )
305 ulpinv = one / ulp
306 unfl = pdlamch( context, 'Safe min' )
307 ovfl = one / unfl
308 CALL dlabad( unfl, ovfl )
309 rtunfl = sqrt( unfl )
310 rtovfl = sqrt( ovfl )
311 aninv = one / dble( max( 1, n ) )
312*
313* This ensures that everyone starts out with the same seed.
314*
315 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
316 CALL igebs2d( context, 'a', ' ', 4, 1, iseed, 4 )
317 ELSE
318 CALL igebr2d( context, 'a', ' ', 4, 1, iseed, 4, 0, 0 )
319 END IF
320 iseedin( 1 ) = iseed( 1 )
321 iseedin( 2 ) = iseed( 2 )
322 iseedin( 3 ) = iseed( 3 )
323 iseedin( 4 ) = iseed( 4 )
324*
325* Compute the matrix A
326*
327* Control parameters:
328*
329* KMAGN KMODE KTYPE
330* =1 O(1) clustered 1 zero
331* =2 large clustered 2 identity
332* =3 small exponential (none)
333* =4 arithmetic diagonal, (w/ eigenvalues)
334* =5 random log symmetric, w/ eigenvalues
335* =6 random (none)
336* =7 random diagonal
337* =8 random symmetric
338* =9 positive definite
339* =10 block diagonal with tridiagonal blocks
340* =11 Geometrically sized clusters.
341*
342 itype = ktype( mattype )
343 imode = kmode( mattype )
344*
345* Compute norm
346*
347 GO TO ( 10, 20, 30 )kmagn( mattype )
348*
349 10 CONTINUE
350 anorm = one
351 GO TO 40
352*
353 20 CONTINUE
354 anorm = ( rtovfl*ulp )*aninv
355 GO TO 40
356*
357 30 CONTINUE
358 anorm = rtunfl*n*ulpinv
359 GO TO 40
360*
361 40 CONTINUE
362 IF( mattype.LE.15 ) THEN
363 cond = ulpinv
364 ELSE
365 cond = ulpinv*aninv / ten
366 END IF
367*
368* Special Matrices
369*
370* Zero
371*
372*
373 IF( itype.EQ.1 ) THEN
374*
375* Zero Matrix
376*
377 DO 50 i = 1, n
378 work( indd+i-1 ) = zero
379 50 CONTINUE
380 CALL pdlaset( 'All', n, n, zero, zero, copya, 1, 1, desca )
381 wknown = .true.
382*
383 ELSE IF( itype.EQ.2 ) THEN
384*
385* Identity Matrix
386*
387 DO 60 i = 1, n
388 work( indd+i-1 ) = one
389 60 CONTINUE
390 CALL pdlaset( 'All', n, n, zero, one, copya, 1, 1, desca )
391 wknown = .true.
392*
393 ELSE IF( itype.EQ.4 ) THEN
394*
395* Diagonal Matrix, [Eigen]values Specified
396*
397 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
398 $ sizetms, iprepad, ipostpad, padval+1.0d+0 )
399*
400 CALL pdlatms( n, n, 'S', iseed, 'S', work( indd ), imode,
401 $ cond, anorm, 0, 0, 'N', copya, 1, 1, desca,
402 $ order, work( indwork+iprepad ), sizetms,
403 $ iinfo )
404 wknown = .true.
405*
406 CALL pdchekpad( desca( ctxt_ ), 'PDLATMS1-WORK', sizetms, 1,
407 $ work( indwork ), sizetms, iprepad, ipostpad,
408 $ padval+1.0d+0 )
409*
410 ELSE IF( itype.EQ.5 ) THEN
411*
412* symmetric, eigenvalues specified
413*
414 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
415 $ sizetms, iprepad, ipostpad, padval+2.0d+0 )
416*
417 CALL pdlatms( n, n, 'S', iseed, 'S', work( indd ), imode,
418 $ cond, anorm, n, n, 'N', copya, 1, 1, desca,
419 $ order, work( indwork+iprepad ), sizetms,
420 $ iinfo )
421*
422 CALL pdchekpad( desca( ctxt_ ), 'PDLATMS2-WORK', sizetms, 1,
423 $ work( indwork ), sizetms, iprepad, ipostpad,
424 $ padval+2.0d+0 )
425*
426 wknown = .true.
427*
428 ELSE IF( itype.EQ.8 ) THEN
429*
430* symmetric, random eigenvalues
431*
432 np = numroc( n, desca( mb_ ), myrow, 0, nprow )
433 nq = numroc( n, desca( nb_ ), mycol, 0, npcol )
434 CALL pdmatgen( desca( ctxt_ ), 'S', 'N', n, n, desca( mb_ ),
435 $ desca( nb_ ), copya, desca( lld_ ),
436 $ desca( rsrc_ ), desca( csrc_ ), iseed( 1 ),
437 $ 0, np, 0, nq, myrow, mycol, nprow, npcol )
438 info = 0
439 wknown = .false.
440*
441 ELSE IF( itype.EQ.9 ) THEN
442*
443* Positive definite, eigenvalues specified.
444*
445*
446 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
447 $ sizetms, iprepad, ipostpad, padval+3.0d+0 )
448*
449 CALL pdlatms( n, n, 'S', iseed, 'S', work( indd ), imode,
450 $ cond, anorm, n, n, 'N', copya, 1, 1, desca,
451 $ order, work( indwork+iprepad ), sizetms,
452 $ iinfo )
453*
454 wknown = .true.
455*
456 CALL pdchekpad( desca( ctxt_ ), 'PDLATMS3-WORK', sizetms, 1,
457 $ work( indwork ), sizetms, iprepad, ipostpad,
458 $ padval+3.0d+0 )
459*
460 ELSE IF( itype.EQ.10 ) THEN
461*
462* Block diagonal matrix with each block being a positive
463* definite tridiagonal submatrix.
464*
465 CALL pdlaset( 'All', n, n, zero, zero, copya, 1, 1, desca )
466 np = numroc( n, desca( mb_ ), 0, 0, nprow )
467 nq = numroc( n, desca( nb_ ), 0, 0, npcol )
468 nloc = min( np, nq )
469 ngen = 0
470 70 CONTINUE
471*
472 IF( ngen.LT.n ) THEN
473 in = min( 1+int( dlaran( iseed )*dble( nloc ) ), n-ngen )
474*
475 CALL dlatms( in, in, 'S', iseed, 'P', work( indd ),
476 $ imode, cond, anorm, 1, 1, 'N', a, lda,
477 $ work( indwork ), iinfo )
478*
479 DO 80 i = 2, in
480 temp1 = abs( a( i-1, i ) ) /
481 $ sqrt( abs( a( i-1, i-1 )*a( i, i ) ) )
482 IF( temp1.GT.half ) THEN
483 a( i-1, i ) = half*sqrt( abs( a( i-1, i-1 )*a( i,
484 $ i ) ) )
485 a( i, i-1 ) = a( i-1, i )
486 END IF
487 80 CONTINUE
488 CALL pdelset( copya, ngen+1, ngen+1, desca, a( 1, 1 ) )
489 DO 90 i = 2, in
490 CALL pdelset( copya, ngen+i, ngen+i, desca,
491 $ a( i, i ) )
492 CALL pdelset( copya, ngen+i-1, ngen+i, desca,
493 $ a( i-1, i ) )
494 CALL pdelset( copya, ngen+i, ngen+i-1, desca,
495 $ a( i, i-1 ) )
496 90 CONTINUE
497 ngen = ngen + in
498 GO TO 70
499 END IF
500 wknown = .false.
501*
502 ELSE IF( itype.EQ.11 ) THEN
503*
504* Geometrically sized clusters. Eigenvalues: 0,1,1,2,2,2,2, ...
505*
506 ngen = 0
507 j = 1
508 temp1 = zero
509 100 CONTINUE
510 IF( ngen.LT.n ) THEN
511 in = min( j, n-ngen )
512 DO 110 i = 0, in - 1
513 work( indd+ngen+i ) = temp1
514 110 CONTINUE
515 temp1 = temp1 + one
516 j = 2*j
517 ngen = ngen + in
518 GO TO 100
519 END IF
520*
521*
522 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
523 $ sizetms, iprepad, ipostpad, padval+4.0d+0 )
524*
525 CALL pdlatms( n, n, 'S', iseed, 'S', work( indd ), imode,
526 $ cond, anorm, 0, 0, 'N', copya, 1, 1, desca,
527 $ order, work( indwork+iprepad ), sizetms,
528 $ iinfo )
529*
530 CALL pdchekpad( desca( ctxt_ ), 'PDLATMS4-WORK', sizetms, 1,
531 $ work( indwork ), sizetms, iprepad, ipostpad,
532 $ padval+4.0d+0 )
533*
534*
535* WKNOWN ... NOT SET, GUESS A DEFAULT
536*
537 wknown = .true.
538 ELSE
539 iinfo = 1
540 END IF
541*
542 IF( wknown )
543 $ CALL dlasrt( 'I', n, work( indd ), iinfo )
544*
545* Create the B matrix
546*
547 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
548 $ sizetms, iprepad, ipostpad, padval+3.3d+0 )
549*
550 anorm = one
551*
552* Update ISEED so that {DLAGSY creates a different Q
553*
554 iseed( 4 ) = mod( iseed( 4 )+257, 4096 )
555 iseed( 3 ) = mod( iseed( 3 )+192, 4096 )
556 iseed( 2 ) = mod( iseed( 2 )+35, 4096 )
557 iseed( 1 ) = mod( iseed( 1 )+128, 4096 )
558 CALL pdlatms( n, n, 'S', iseed, 'P', work( indd ), 3, ten,
559 $ anorm, n, n, 'N', copyb, 1, 1, desca, order,
560 $ work( indwork+iprepad ), sizetms, iinfo )
561*
562 CALL pdchekpad( desca( ctxt_ ), 'PDLATMS5-WORK', sizetms, 1,
563 $ work( indwork ), sizetms, iprepad, ipostpad,
564 $ padval+3.3d+0 )
565*
566*
567* These values aren't actually used, but they make ftncheck happy.
568*
569 il = -1
570 iu = -2
571 vl = one
572 vu = -one
573*
574 CALL pdlasizesyevx( wknown, 'A', n, desca, vl, vu, il, iu,
575 $ iseed, work( indd ), maxsize, vecsize,
576 $ valsize )
577*
578 lsyevxsize = min( maxsize, lwork )
579 wknown = .false.
580*
581 CALL pdgsepsubtst( wknown, ibtype, 'v', 'a', uplo, n, vl, vu,
582 $ il, iu, thresh, abstol, a, copya, b, copyb,
583 $ z, 1, 1, desca, work( indd ), win, ifail,
584 $ iclustr, gap, iprepad, ipostpad,
585 $ work( indwork ), llwork, lsyevxsize, iwork,
586 $ isizesyevx, res, tstnrm, qtqnrm, nout )
587*
588*
589*
590 maxtstnrm = tstnrm
591 maxqtqnrm = qtqnrm
592*
593 IF( thresh.LE.zero ) THEN
594 passed = 'SKIPPED '
595 info = 2
596 ELSE IF( res.NE.0 ) THEN
597 passed = 'FAILED '
598 info = 1
599 END IF
600 END IF
601*
602 IF( thresh.GT.zero .AND. lsame( subtests, 'Y' ) ) THEN
603*
604* Subtest 1: JOBZ = 'V', RANGE = 'A', minimum memory
605*
606 IF( info.EQ.0 ) THEN
607*
608 jobz = 'V'
609 range = 'A'
610 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
611 $ iseed, win( 1+iprepad ), maxsize,
612 $ vecsize, valsize )
613*
614 lsyevxsize = vecsize
615*
616 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
617 $ vu, il, iu, thresh, abstol, a, copya, b,
618 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
619 $ wnew, ifail, iclustr, gap, iprepad,
620 $ ipostpad, work( indwork ), llwork,
621 $ lsyevxsize, iwork, isizesyevx, res,
622 $ tstnrm, qtqnrm, nout )
623*
624 IF( res.NE.0 ) THEN
625 passed = 'FAILED stest 1'
626 maxtstnrm = max( tstnrm, maxtstnrm )
627 maxqtqnrm = max( qtqnrm, maxqtqnrm )
628 info = 1
629 END IF
630 END IF
631*
632* Subtest 2: JOBZ = 'V', RANGE = 'A', random memory
633*
634 IF( info.EQ.0 ) THEN
635 jobz = 'V'
636 range = 'A'
637 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
638 $ iseed, win( 1+iprepad ), maxsize,
639 $ vecsize, valsize )
640*
641 lsyevxsize = vecsize + int( dlaran( iseed )*
642 $ dble( maxsize-vecsize ) )
643*
644 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
645 $ vu, il, iu, thresh, abstol, a, copya, b,
646 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
647 $ wnew, ifail, iclustr, gap, iprepad,
648 $ ipostpad, work( indwork ), llwork,
649 $ lsyevxsize, iwork, isizesyevx, res,
650 $ tstnrm, qtqnrm, nout )
651*
652 IF( res.NE.0 ) THEN
653 passed = 'FAILED stest 2'
654 maxtstnrm = max( tstnrm, maxtstnrm )
655 maxqtqnrm = max( qtqnrm, maxqtqnrm )
656 info = 1
657 END IF
658 END IF
659*
660* Subtest 3: JOBZ = 'N', RANGE = 'A', minimum memory
661*
662 IF( info.EQ.0 ) THEN
663*
664 jobz = 'N'
665 range = 'A'
666 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
667 $ iseed, win( 1+iprepad ), maxsize,
668 $ vecsize, valsize )
669*
670 lsyevxsize = valsize
671 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
672 $ vu, il, iu, thresh, abstol, a, copya, b,
673 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
674 $ wnew, ifail, iclustr, gap, iprepad,
675 $ ipostpad, work( indwork ), llwork,
676 $ lsyevxsize, iwork, isizesyevx, res,
677 $ tstnrm, qtqnrm, nout )
678*
679 IF( res.NE.0 ) THEN
680 maxtstnrm = max( tstnrm, maxtstnrm )
681 maxqtqnrm = max( qtqnrm, maxqtqnrm )
682 passed = 'FAILED stest 3'
683 info = 1
684 END IF
685 END IF
686*
687* Subtest 4: JOBZ = 'N', RANGE = 'I', minimum memory
688*
689 IF( info.EQ.0 ) THEN
690*
691 il = -1
692 iu = -1
693 jobz = 'N'
694 range = 'I'
695*
696* We use PDLASIZESYEVX to choose IL and IU for us.
697*
698 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
699 $ iseed, win( 1+iprepad ), maxsize,
700 $ vecsize, valsize )
701*
702 lsyevxsize = valsize
703*
704 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
705 $ vu, il, iu, thresh, abstol, a, copya, b,
706 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
707 $ wnew, ifail, iclustr, gap, iprepad,
708 $ ipostpad, work( indwork ), llwork,
709 $ lsyevxsize, iwork, isizesyevx, res,
710 $ tstnrm, qtqnrm, nout )
711*
712 IF( res.NE.0 ) THEN
713 maxtstnrm = max( tstnrm, maxtstnrm )
714 maxqtqnrm = max( qtqnrm, maxqtqnrm )
715 passed = 'FAILED stest 4'
716 info = 1
717 END IF
718 END IF
719*
720* Subtest 5: JOBZ = 'V', RANGE = 'I', maximum memory
721*
722 IF( info.EQ.0 ) THEN
723*
724 il = -1
725 iu = -1
726 jobz = 'V'
727 range = 'I'
728*
729* We use PDLASIZESYEVX to choose IL and IU for us.
730*
731 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
732 $ iseed, win( 1+iprepad ), maxsize,
733 $ vecsize, valsize )
734*
735 lsyevxsize = maxsize
736*
737 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
738 $ vu, il, iu, thresh, abstol, a, copya, b,
739 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
740 $ wnew, ifail, iclustr, gap, iprepad,
741 $ ipostpad, work( indwork ), llwork,
742 $ lsyevxsize, iwork, isizesyevx, res,
743 $ tstnrm, qtqnrm, nout )
744*
745 IF( res.NE.0 ) THEN
746 maxtstnrm = max( tstnrm, maxtstnrm )
747 maxqtqnrm = max( qtqnrm, maxqtqnrm )
748 passed = 'FAILED stest 5'
749 info = 1
750 END IF
751 END IF
752*
753* Subtest 6: JOBZ = 'V', RANGE = 'I', minimum memory
754*
755 IF( info.EQ.0 ) THEN
756 il = -1
757 iu = -1
758 jobz = 'V'
759 range = 'I'
760*
761* We use PDLASIZESYEVX to choose IL and IU for us.
762*
763 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
764 $ iseed, win( 1+iprepad ), maxsize,
765 $ vecsize, valsize )
766*
767 lsyevxsize = vecsize
768*
769 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
770 $ vu, il, iu, thresh, abstol, a, copya, b,
771 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
772 $ wnew, ifail, iclustr, gap, iprepad,
773 $ ipostpad, work( indwork ), llwork,
774 $ lsyevxsize, iwork, isizesyevx, res,
775 $ tstnrm, qtqnrm, nout )
776*
777 IF( res.NE.0 ) THEN
778 maxtstnrm = max( tstnrm, maxtstnrm )
779 maxqtqnrm = max( qtqnrm, maxqtqnrm )
780 passed = 'FAILED stest 6'
781 info = 1
782 END IF
783 END IF
784*
785* Subtest 7: JOBZ = 'V', RANGE = 'I', random memory
786*
787 IF( info.EQ.0 ) THEN
788 il = -1
789 iu = -1
790 jobz = 'V'
791 range = 'I'
792*
793* We use PDLASIZESYEVX to choose IL and IU for us.
794*
795 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
796 $ iseed, win( 1+iprepad ), maxsize,
797 $ vecsize, valsize )
798 lsyevxsize = vecsize + int( dlaran( iseed )*
799 $ dble( maxsize-vecsize ) )
800*
801 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
802 $ vu, il, iu, thresh, abstol, a, copya, b,
803 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
804 $ wnew, ifail, iclustr, gap, iprepad,
805 $ ipostpad, work( indwork ), llwork,
806 $ lsyevxsize, iwork, isizesyevx, res,
807 $ tstnrm, qtqnrm, nout )
808*
809 IF( res.NE.0 ) THEN
810 maxtstnrm = max( tstnrm, maxtstnrm )
811 maxqtqnrm = max( qtqnrm, maxqtqnrm )
812 passed = 'FAILED stest 7'
813 info = 1
814 END IF
815 END IF
816*
817* Subtest 8: JOBZ = 'N', RANGE = 'V', minimum memory
818*
819 IF( info.EQ.0 ) THEN
820 vl = one
821 vu = -one
822 jobz = 'N'
823 range = 'V'
824*
825* We use PDLASIZESYEVX to choose VL and VU for us.
826*
827 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
828 $ iseed, win( 1+iprepad ), maxsize,
829 $ vecsize, valsize )
830*
831 lsyevxsize = valsize
832*
833 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
834 $ vu, il, iu, thresh, abstol, a, copya, b,
835 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
836 $ wnew, ifail, iclustr, gap, iprepad,
837 $ ipostpad, work( indwork ), llwork,
838 $ lsyevxsize, iwork, isizesyevx, res,
839 $ tstnrm, qtqnrm, nout )
840*
841 IF( res.NE.0 ) THEN
842 maxtstnrm = max( tstnrm, maxtstnrm )
843 maxqtqnrm = max( qtqnrm, maxqtqnrm )
844 passed = 'FAILED stest 8'
845 info = 1
846 END IF
847 END IF
848*
849* Subtest 9: JOBZ = 'V', RANGE = 'V', maximum memory
850*
851 IF( info.EQ.0 ) THEN
852 vl = one
853 vu = -one
854 jobz = 'V'
855 range = 'V'
856*
857* We use PDLASIZESYEVX to choose VL and VU for us.
858*
859 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
860 $ iseed, win( 1+iprepad ), maxsize,
861 $ vecsize, valsize )
862*
863 lsyevxsize = maxsize
864*
865 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
866 $ vu, il, iu, thresh, abstol, a, copya, b,
867 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
868 $ wnew, ifail, iclustr, gap, iprepad,
869 $ ipostpad, work( indwork ), llwork,
870 $ lsyevxsize, iwork, isizesyevx, res,
871 $ tstnrm, qtqnrm, nout )
872*
873 IF( res.NE.0 ) THEN
874 maxtstnrm = max( tstnrm, maxtstnrm )
875 maxqtqnrm = max( qtqnrm, maxqtqnrm )
876 passed = 'FAILED stest 9'
877 info = 1
878 END IF
879 END IF
880*
881* Subtest 10: JOBZ = 'V', RANGE = 'V',
882* minimum memory required for eigenvectors
883*
884 IF( info.EQ.0 ) THEN
885 vl = one
886 vu = -one
887 jobz = 'V'
888 range = 'V'
889*
890* We use PDLASIZESYEVX to choose VL and VU for us.
891*
892 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
893 $ iseed, win( 1+iprepad ), maxsize,
894 $ vecsize, valsize )
895*
896 lsyevxsize = vecsize
897*
898 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
899 $ vu, il, iu, thresh, abstol, a, copya, b,
900 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
901 $ wnew, ifail, iclustr, gap, iprepad,
902 $ ipostpad, work( indwork ), llwork,
903 $ lsyevxsize, iwork, isizesyevx, res,
904 $ tstnrm, qtqnrm, nout )
905*
906 IF( res.NE.0 ) THEN
907 maxtstnrm = max( tstnrm, maxtstnrm )
908 maxqtqnrm = max( qtqnrm, maxqtqnrm )
909 passed = 'FAILED stest10'
910 info = 1
911 END IF
912 END IF
913*
914* Subtest 11: JOBZ = 'V', RANGE = 'V',
915* random memory (enough for all eigenvectors
916* but not enough to guarantee orthogonality
917*
918 IF( info.EQ.0 ) THEN
919 vl = one
920 vu = -one
921 jobz = 'V'
922 range = 'V'
923*
924* We use PDLASIZESYEVX to choose VL and VU for us.
925*
926 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
927 $ iseed, win( 1+iprepad ), maxsize,
928 $ vecsize, valsize )
929*
930 lsyevxsize = vecsize + int( dlaran( iseed )*
931 $ dble( maxsize-vecsize ) )
932*
933 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
934 $ vu, il, iu, thresh, abstol, a, copya, b,
935 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
936 $ wnew, ifail, iclustr, gap, iprepad,
937 $ ipostpad, work( indwork ), llwork,
938 $ lsyevxsize, iwork, isizesyevx, res,
939 $ tstnrm, qtqnrm, nout )
940*
941 IF( res.NE.0 ) THEN
942 maxtstnrm = max( tstnrm, maxtstnrm )
943 maxqtqnrm = max( qtqnrm, maxqtqnrm )
944 passed = 'FAILED stest11'
945 info = 1
946 END IF
947 END IF
948*
949* Subtest 12: JOBZ = 'V', RANGE = 'V',
950* miniimum memory required for eigenvalues only
951*
952 IF( info.EQ.0 ) THEN
953 vl = one
954 vu = -one
955 jobz = 'V'
956 range = 'V'
957*
958* We use PDLASIZESYEVX to choose VL and VU for us.
959*
960 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
961 $ iseed, win( 1+iprepad ), maxsize,
962 $ vecsize, valsize )
963*
964 lsyevxsize = valsize
965*
966 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
967 $ vu, il, iu, thresh, abstol, a, copya, b,
968 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
969 $ wnew, ifail, iclustr, gap, iprepad,
970 $ ipostpad, work( indwork ), llwork,
971 $ lsyevxsize, iwork, isizesyevx, res,
972 $ tstnrm, qtqnrm, nout )
973*
974 IF( res.NE.0 ) THEN
975 maxtstnrm = max( tstnrm, maxtstnrm )
976 maxqtqnrm = max( qtqnrm, maxqtqnrm )
977 passed = 'FAILED stest12'
978 info = 1
979 END IF
980 END IF
981*
982* Subtest 13: JOBZ = 'V', RANGE = 'V',
983* random memory (more than minimum required
984* for eigenvalues, less than required for vectors)
985*
986 IF( info.EQ.0 ) THEN
987 vl = one
988 vu = -one
989 jobz = 'V'
990 range = 'V'
991*
992* We use PDLASIZESYEVX to choose VL and VU for us.
993*
994 CALL pdlasizesyevx( .true., range, n, desca, vl, vu, il, iu,
995 $ iseed, win( 1+iprepad ), maxsize,
996 $ vecsize, valsize )
997*
998 lsyevxsize = valsize + int( dlaran( iseed )*
999 $ dble( vecsize-valsize ) )
1000*
1001 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
1002 $ vu, il, iu, thresh, abstol, a, copya, b,
1003 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
1004 $ wnew, ifail, iclustr, gap, iprepad,
1005 $ ipostpad, work( indwork ), llwork,
1006 $ lsyevxsize, iwork, isizesyevx, res,
1007 $ tstnrm, qtqnrm, nout )
1008*
1009 IF( res.NE.0 ) THEN
1010 maxtstnrm = max( tstnrm, maxtstnrm )
1011 maxqtqnrm = max( qtqnrm, maxqtqnrm )
1012 passed = 'FAILED stest13'
1013 info = 1
1014 END IF
1015 END IF
1016 END IF
1017*
1018*
1019*
1020 CALL igamx2d( context, 'All', ' ', 1, 1, info, 1, -1, -1, -1, -1,
1021 $ -1 )
1022*
1023 IF( info.EQ.1 ) THEN
1024 IF( iam.EQ.0 ) THEN
1025 WRITE( nout, fmt = 9994 )'C '
1026 WRITE( nout, fmt = 9993 )iseedin( 1 )
1027 WRITE( nout, fmt = 9992 )iseedin( 2 )
1028 WRITE( nout, fmt = 9991 )iseedin( 3 )
1029 WRITE( nout, fmt = 9990 )iseedin( 4 )
1030 IF( lsame( uplo, 'L' ) ) THEN
1031 WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
1032 ELSE
1033 WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
1034 END IF
1035 IF( lsame( subtests, 'Y' ) ) THEN
1036 WRITE( nout, fmt = 9994 )' SUBTESTS= ''Y'' '
1037 ELSE
1038 WRITE( nout, fmt = 9994 )' SUBTESTS= ''N'' '
1039 END IF
1040 WRITE( nout, fmt = 9989 )n
1041 WRITE( nout, fmt = 9988 )nprow
1042 WRITE( nout, fmt = 9987 )npcol
1043 WRITE( nout, fmt = 9986 )nb
1044 WRITE( nout, fmt = 9985 )mattype
1045 WRITE( nout, fmt = 9984 )ibtype
1046 WRITE( nout, fmt = 9982 )abstol
1047 WRITE( nout, fmt = 9981 )thresh
1048 WRITE( nout, fmt = 9994 )'C '
1049 END IF
1050 END IF
1051*
1052 CALL slcombine( context, 'All', '>', 'W', 6, 1, wtime )
1053 CALL slcombine( context, 'All', '>', 'C', 6, 1, ctime )
1054 IF( iam.EQ.0 ) THEN
1055 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1056 IF( wtime( 1 ).GE.0.0 ) THEN
1057 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1058 $ ibtype, subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
1059 $ passed
1060 ELSE
1061 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1062 $ ibtype, subtests, ctime( 1 ), maxtstnrm, passed
1063 END IF
1064 ELSE IF( info.EQ.2 ) THEN
1065 IF( wtime( 1 ).GE.0.0 ) THEN
1066 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1067 $ ibtype, subtests, wtime( 1 ), ctime( 1 )
1068 ELSE
1069 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1070 $ ibtype, subtests, ctime( 1 )
1071 END IF
1072 ELSE IF( info.EQ.3 ) THEN
1073 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1074 $ ibtype, subtests
1075 END IF
1076 END IF
1077*
1078 120 CONTINUE
1079*
1080 RETURN
1081 9999 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1082 $ 1x, f8.2, 1x, f8.2, 1x, g9.2, 1x, a14 )
1083 9998 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1084 $ 1x, 8x, 1x, f8.2, 1x, g9.2, a14 )
1085 9997 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1086 $ 1x, f8.2, 1x, f8.2, 11x, 'Bypassed' )
1087 9996 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1088 $ 1x, 8x, 1x, f8.2, 11x, 'Bypassed' )
1089 9995 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1090 $ 22x, 'Bad MEMORY parameters' )
1091 9994 FORMAT( a )
1092 9993 FORMAT( ' ISEED( 1 ) =', i8 )
1093 9992 FORMAT( ' ISEED( 2 ) =', i8 )
1094 9991 FORMAT( ' ISEED( 3 ) =', i8 )
1095 9990 FORMAT( ' ISEED( 4 ) =', i8 )
1096 9989 FORMAT( ' N=', i8 )
1097 9988 FORMAT( ' NPROW=', i8 )
1098 9987 FORMAT( ' NPCOL=', i8 )
1099 9986 FORMAT( ' NB=', i8 )
1100 9985 FORMAT( ' MATTYPE=', i8 )
1101 9984 FORMAT( ' IBTYPE=', i8 )
1102 9983 FORMAT( ' SUBTESTS=', a1 )
1103 9982 FORMAT( ' ABSTOL=', d16.6 )
1104 9981 FORMAT( ' THRESH=', d16.6 )
1105 9980 FORMAT( ' Increase TOTMEM in PDGSEPDRIVER' )
1106*
1107* End of PDGSEPTST
1108*
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
dlatms
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
Definition dlatms.f:3
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition numroc.f:2
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
pdlaset
subroutine pdlaset(uplo, m, n, alpha, beta, a, ia, ja, desca)
Definition pdblastst.f:6862
pdlamch
double precision function pdlamch(ictxt, cmach)
Definition pdblastst.f:6769
pdchekpad
subroutine pdchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
Definition pdchekpad.f:3
pdelset
subroutine pdelset(a, ia, ja, desca, alpha)
Definition pdelset.f:2
pdfillpad
subroutine pdfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
Definition pdfillpad.f:2
pdgsepsubtst
subroutine pdgsepsubtst(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, lwork1, iwork, liwork, result, tstnrm, qtqnrm, nout)
Definition pdgsepsubtst.f:9
pdlasizegsep
subroutine pdlasizegsep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, sizeqtq, sizechk, sizesyevx, isizesyevx, sizesubtst, isizesubtst, sizetst, isizetst)
Definition pdlasizegsep.f:8
pdlasizesyevx
subroutine pdlasizesyevx(wknown, range, n, desca, vl, vu, il, iu, iseed, win, maxsize, vecsize, valsize)
Definition pdlasizesyevx.f:5
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
slcombine
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)
Definition sltimer.f:267
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
dlaran
double precision function dlaran(iseed)
Definition tools.f:2000
Here is the call graph for this function:
Here is the caller graph for this function: