SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pcttrdtester()

subroutine pcttrdtester ( integer  iam,
integer  nprocs,
logical  check,
integer  nout,
real  thresh,
integer, dimension( * )  nval,
integer  nmat,
complex, dimension( * )  mem,
integer  totmem,
integer  kpass,
integer  kfail,
integer  kskip 
)

Definition at line 1 of file pcttrdtester.f.

3*
4* -- ScaLAPACK test routine (version 1.7) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6* and University of California, Berkeley.
7* February 24, 2000
8*
9* .. Scalar Arguments ..
10 LOGICAL CHECK
11 INTEGER IAM, KFAIL, KPASS, KSKIP, NMAT, NOUT, NPROCS,
12 $ TOTMEM
13 REAL THRESH
14* ..
15* .. Array Arguments ..
16 INTEGER NVAL( * )
17 COMPLEX MEM( * )
18* ..
19*
20* Purpose
21* =======
22*
23* PCTTRDTESTER tests PCHETTRD
24*
25* Arguments
26* =========
27*
28* IAM (local input) INTEGER
29* The local process number
30*
31* NPROCS (global input) INTEGER
32* The number of processors
33*
34* CHECK (global input) LOGICAL
35* Specifies whether the user wants to check the answer
36*
37* NOUT (local input) INTEGER
38* File descriptor
39*
40* THRESH (global input) REAL
41* Acceptable error threshold
42*
43* NVAL (global input) INTEGER array dimension NMAT
44* The matrix sizes to test
45*
46* NMAT (global input) INTEGER
47* The number of matrix sizes to test
48*
49* MEM (local input) COMPLEX array dimension MEMSIZ
50* Where:
51* MEMSIZ = TOTMEM / CPLXSZ
52*
53* TOTMEM (global input) INTEGER
54* Number of bytes in MEM
55*
56* KPASS (local input/output) INTEGER
57* The number of tests which passed. Only relevant on
58* processor 0.
59*
60* KFAIL (local input/output) INTEGER
61* The number of tests which failed. Only relevant on
62* processor 0.
63*
64* KSKIP (local input/output) INTEGER
65* The number of tests which were skipped. Only relevant on
66* processor 0.
67*
68* ================================================================
69* .. Parameters ..
70*
71 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
72 $ MB_, NB_, RSRC_, CSRC_, LLD_
73 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
74 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
75 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
76 INTEGER REALSZ, CPLXSZ
77 COMPLEX PADVAL
78 parameter( realsz = 4, cplxsz = 8,
79 $ padval = ( -9923.0e+0, -9924.0e+0 ) )
80 INTEGER TIMETESTS
81 parameter( timetests = 11 )
82 INTEGER TESTS
83 parameter( tests = 8 )
84 INTEGER MINTIMEN
85 parameter( mintimen = 8 )
86* ..
87* .. Local Scalars ..
88 LOGICAL TIME
89 CHARACTER UPLO
90 CHARACTER*6 PASSED
91 INTEGER DUMMY, IASEED, ICTXT, IMIDPAD, INFO, IPA, IPD,
92 $ IPE, IPOSTPAD, IPREPAD, IPT, IPW, ITEMP, J, K,
93 $ LCM, LWMIN, MAXTESTS, MEMSIZ, MYCOL, MYROW, N,
94 $ NB, NDIAG, NGRIDS, NN, NOFFD, NP, NPCOL, NPROW,
95 $ NPS, NQ, SPLITSTIMED, WORKSIZ, WORKTRD
96 REAL ANORM, FRESID
97 DOUBLE PRECISION NOPS, TMFLOPS
98* ..
99* .. Local Arrays ..
100 INTEGER ANBTEST( TESTS ), ANBTIME( TIMETESTS ),
101 $ BALTEST( TESTS ), BALTIME( TIMETESTS ),
102 $ DESCA( DLEN_ ), DESCD( DLEN_ ), IERR( 1 ),
103 $ INTERTEST( TESTS ), INTERTIME( TIMETESTS ),
104 $ PNBTEST( TESTS ), PNBTIME( TIMETESTS ),
105 $ TWOGEMMTEST( TESTS ), TWOGEMMTIME( TIMETESTS )
106 DOUBLE PRECISION CTIME( 100 ), WTIME( 100 )
107* ..
108* .. External Subroutines ..
109 EXTERNAL blacs_barrier, blacs_get, blacs_gridexit,
110 $ blacs_gridinfo, blacs_gridinit, descinit,
111 $ igebr2d, igebs2d, igsum2d, pcchekpad,
112 $ pcfillpad, pchetdrv, pchettrd, pclafchk,
113 $ pclatran, pcmatgen, slboot, slcombine, sltimer
114* ..
115* .. External Functions ..
116 LOGICAL LSAME
117 INTEGER ICEIL, ILCM, NUMROC, PJLAENV
118 REAL PCLANHE
119 EXTERNAL lsame, iceil, ilcm, numroc, pjlaenv, pclanhe
120* ..
121* .. Intrinsic Functions ..
122 INTRINSIC dble, int, max, real, sqrt
123* ..
124*
125* .. Scalars in Common ..
126 INTEGER ANB, BALANCED, BCKBLOCK, GSTBLOCK, INTERLEAVE,
127 $ LLTBLOCK, MINSZ, PNB, TIMEINTERNALS, TIMING,
128 $ TRSBLOCK, TWOGEMMS
129* ..
130* .. Common blocks ..
131 COMMON / blocksizes / gstblock, lltblock, bckblock,
132 $ trsblock
133 COMMON / minsize / minsz
134 COMMON / pjlaenvtiming / timing
135 COMMON / tailoredopts / pnb, anb, interleave,
136 $ balanced, twogemms
137 COMMON / timecontrol / timeinternals
138* ..
139* .. Data statements ..
140 DATA baltime / 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0 /
141 DATA intertime / 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1 /
142 DATA twogemmtime / 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0 /
143 DATA anbtime / 16, 16, 16, 16, 16, 8, 8, 32, 32, 16,
144 $ 16 /
145 DATA pnbtime / 32, 32, 32, 32, 32, 32, 32, 32, 32,
146 $ 16, 64 /
147 DATA baltest / 0, 0, 0, 0, 1, 1, 1, 1 /
148 DATA intertest / 0, 0, 1, 1, 0, 0, 1, 1 /
149 DATA twogemmtest / 0, 1, 0, 1, 0, 1, 0, 1 /
150 DATA anbtest / 1, 2, 3, 16, 1, 2, 3, 16 /
151 DATA pnbtest / 1, 16, 8, 1, 16, 8, 1, 16 /
152* ..
153* .. Executable Statements ..
154* This is just to keep ftnchek and toolpack/1 happy
155 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
156 $ rsrc_.LT.0 )RETURN
157*
158*
159 iaseed = 100
160 splitstimed = 0
161 nb = 1
162 uplo = 'L'
163 memsiz = totmem / cplxsz
164*
165* Print headings
166*
167 IF( iam.EQ.0 ) THEN
168 WRITE( nout, fmt = * )
169 WRITE( nout, fmt = 9995 )
170 WRITE( nout, fmt = 9994 )
171 WRITE( nout, fmt = 9993 )
172 WRITE( nout, fmt = * )
173 END IF
174*
175* Loop over different process grids
176*
177 ngrids = int( sqrt( real( nprocs ) ) )
178*
179 DO 30 nn = 1, ngrids
180*
181 nprow = nn
182 npcol = nn
183 ierr( 1 ) = 0
184*
185* Define process grid
186*
187 CALL blacs_get( -1, 0, ictxt )
188 CALL blacs_gridinit( ictxt, 'Row-major', nprow, npcol )
189 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
190*
191* Go to bottom of loop if this case doesn't use my process
192*
193 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
194 $ GO TO 30
195*
196 DO 20 j = 1, nmat
197*
198 n = nval( j )
199*
200* Make sure matrix information is correct
201*
202 ierr( 1 ) = 0
203 IF( n.LT.1 ) THEN
204 IF( iam.EQ.0 )
205 $ WRITE( nout, fmt = 9999 )'MATRIX', 'N', n
206 ierr( 1 ) = 1
207 END IF
208*
209* Make sure no one had error
210*
211 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
212*
213 IF( ierr( 1 ).GT.0 ) THEN
214 IF( iam.EQ.0 )
215 $ WRITE( nout, fmt = 9997 )'matrix'
216 kskip = kskip + 1
217 GO TO 20
218 END IF
219*
220* Loop over different blocking sizes
221*
222 IF( n.GT.mintimen ) THEN
223*
224* For timing tests, we perform one or two extra tests.
225* Both of these extra tests are performed with the
226* default values for the performance tuning parameters.
227* The second extra test (which is only performed if
228* split times are non-zero) is performed with timeinternals
229* set to 1 (which forces barrier syncs between many
230* phases of the computation).
231*
232 time = .true.
233 maxtests = timetests + 2
234 ELSE
235 time = .false.
236 maxtests = tests
237 END IF
238*
239*
240 DO 10 k = 1, maxtests
241 timeinternals = 0
242 IF( time ) THEN
243 IF( k.GE.maxtests-1 ) THEN
244*
245* For the last two timings, we let pjlaenv set
246* the execution path values. These dummy
247* initializations aren't really necessary,
248* but they illustrate the fact that these values are
249* set in xpjlaenv. The dummy call to pjlaenv
250* has the side effect of setting ANB.
251*
252 minsz = -13
253 balanced = -13
254 interleave = -13
255 twogemms = -13
256 anb = -13
257 pnb = -13
258 timing = 1
259 dummy = pjlaenv( ictxt, 3, 'PCHETTRD', 'L', 0, 0,
260 $ 0, 0 )
261 IF( k.EQ.maxtests )
262 $ timeinternals = 1
263 ELSE
264 timing = 0
265 minsz = 1
266 balanced = baltime( k )
267 interleave = intertime( k )
268 twogemms = twogemmtime( k )
269 anb = anbtime( k )
270 pnb = pnbtime( k )
271 END IF
272 ELSE
273 timing = 0
274 minsz = 1
275 balanced = baltest( k )
276 interleave = intertest( k )
277 twogemms = twogemmtest( k )
278 anb = anbtest( k )
279 pnb = pnbtest( k )
280 END IF
281*
282* Skip the last test (with timeinternals = 1) if
283* PCHETTRD is not collecting the split times.
284*
285 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
286 CALL igebs2d( ictxt, 'All', ' ', 1, 1, splitstimed,
287 $ 1 )
288 ELSE
289 CALL igebr2d( ictxt, 'All', ' ', 1, 1, splitstimed, 1,
290 $ 0, 0 )
291 END IF
292*
293*
294 IF( splitstimed.EQ.0 .AND. k.EQ.maxtests )
295 $ GO TO 10
296*
297* The following hack tests to make sure that PNB need not
298* be the same on all processes. (Provided that PNB is set
299* to 1 in the TRD.dat file.)
300*
301 IF( pnb.EQ.1 )
302 $ pnb = 1 + iam
303*
304* Padding constants
305*
306 np = numroc( n, nb, myrow, 0, nprow )
307 nq = numroc( n, nb, mycol, 0, npcol )
308 IF( check ) THEN
309 iprepad = max( nb, np )
310 imidpad = nb
311 ipostpad = max( nb, nq )
312 ELSE
313 iprepad = 0
314 imidpad = 0
315 ipostpad = 0
316 END IF
317*
318* Initialize the array descriptor for the matrix A
319*
320*
321 CALL descinit( desca, n, n, nb, nb, 0, 0, ictxt,
322 $ max( 1, np )+imidpad, ierr( 1 ) )
323*
324 CALL descinit( descd, 1, n, nb, nb, 0, 0, ictxt, 1,
325 $ info )
326*
327* Check all processes for an error
328*
329 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
330*
331 IF( ierr( 1 ).LT.0 ) THEN
332 IF( iam.EQ.0 )
333 $ WRITE( nout, fmt = 9997 )'descriptor'
334 kskip = kskip + 1
335 GO TO 10
336 END IF
337*
338* Assign pointers into MEM for SCALAPACK arrays, A is
339* allocated starting at position MEM( IPREPAD+1 )
340*
341 ndiag = nq
342 IF( lsame( uplo, 'U' ) ) THEN
343 noffd = nq
344 ELSE
345 noffd = numroc( n-1, nb, mycol, 0, npcol )
346 END IF
347 ndiag = iceil( realsz*ndiag, cplxsz )
348 noffd = iceil( realsz*noffd, cplxsz )
349*
350 ipa = iprepad + 1
351 ipd = ipa + desca( lld_ )*nq + ipostpad + iprepad
352 ipe = ipd + ndiag + ipostpad + iprepad
353 ipt = ipe + noffd + ipostpad + iprepad
354 ipw = ipt + nq + ipostpad + iprepad
355*
356* Calculate the amount of workspace required for the
357* reduction
358*
359 nps = max( numroc( n, 1, 0, 0, nprow ), 2*anb )
360 lwmin = 2*( anb+1 )*( 4*nps+2 ) + nps
361*
362 worktrd = lwmin + ipostpad
363 worksiz = worktrd
364*
365* Figure the amount of workspace required by the check
366*
367 IF( check ) THEN
368 itemp = 2*nq + np
369 IF( nprow.NE.npcol ) THEN
370 lcm = ilcm( nprow, npcol )
371 itemp = nb*iceil( iceil( np, nb ), lcm / nprow ) +
372 $ itemp
373 END IF
374 itemp = max( iceil( realsz*itemp, cplxsz ),
375 $ 2*( nb+np )*nb )
376 worksiz = max( lwmin, itemp ) + ipostpad
377 END IF
378*
379* Check for adequate memory for problem size
380*
381 ierr( 1 ) = 0
382 IF( ipw+worksiz.GT.memsiz ) THEN
383 IF( iam.EQ.0 )
384 $ WRITE( nout, fmt = 9996 )'Tridiagonal reduction',
385 $ ( ipw+worksiz )*cplxsz
386 ierr( 1 ) = 1
387 END IF
388*
389* Check all processes for an error
390*
391 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
392*
393 IF( ierr( 1 ).GT.0 ) THEN
394 IF( iam.EQ.0 )
395 $ WRITE( nout, fmt = 9997 )'MEMORY'
396 kskip = kskip + 1
397 GO TO 10
398 END IF
399*
400*
401*
402* Generate the matrix A
403*
404 CALL pcmatgen( ictxt, 'Hemm', 'N', desca( m_ ),
405 $ desca( n_ ), desca( mb_ ), desca( nb_ ),
406 $ mem( ipa ), desca( lld_ ), desca( rsrc_ ),
407 $ desca( csrc_ ), iaseed, 0, np, 0, nq,
408 $ myrow, mycol, nprow, npcol )
409*
410*
411* Need Infinity-norm of A for checking
412*
413 IF( check ) THEN
414 CALL pcfillpad( ictxt, np, nq, mem( ipa-iprepad ),
415 $ desca( lld_ ), iprepad, ipostpad,
416 $ padval )
417 CALL pcfillpad( ictxt, ndiag, 1, mem( ipd-iprepad ),
418 $ ndiag, iprepad, ipostpad, padval )
419 CALL pcfillpad( ictxt, noffd, 1, mem( ipe-iprepad ),
420 $ noffd, iprepad, ipostpad, padval )
421 CALL pcfillpad( ictxt, nq, 1, mem( ipt-iprepad ), nq,
422 $ iprepad, ipostpad, padval )
423 CALL pcfillpad( ictxt, worksiz-ipostpad, 1,
424 $ mem( ipw-iprepad ), worksiz-ipostpad,
425 $ iprepad, ipostpad, padval )
426 anorm = pclanhe( 'I', uplo, n, mem( ipa ), 1, 1,
427 $ desca, mem( ipw ) )
428 CALL pcchekpad( ictxt, 'PCLANHE', np, nq,
429 $ mem( ipa-iprepad ), desca( lld_ ),
430 $ iprepad, ipostpad, padval )
431 CALL pcchekpad( ictxt, 'PCLANHE', worksiz-ipostpad, 1,
432 $ mem( ipw-iprepad ), worksiz-ipostpad,
433 $ iprepad, ipostpad, padval )
434 CALL pcfillpad( ictxt, worktrd-ipostpad, 1,
435 $ mem( ipw-iprepad ), worktrd-ipostpad,
436 $ iprepad, ipostpad, padval )
437 END IF
438*
439 CALL slboot
440 CALL blacs_barrier( ictxt, 'All' )
441 CALL sltimer( 1 )
442*
443* Reduce to symmetric tridiagonal form
444*
445 CALL pchettrd( uplo, n, mem( ipa ), 1, 1, desca,
446 $ mem( ipd ), mem( ipe ), mem( ipt ),
447 $ mem( ipw ), lwmin, info )
448*
449 CALL sltimer( 1 )
450*
451 IF( check ) THEN
452*
453* Check for memory overwrite
454*
455 CALL pcchekpad( ictxt, 'PCHETTRD', np, nq,
456 $ mem( ipa-iprepad ), desca( lld_ ),
457 $ iprepad, ipostpad, padval )
458 CALL pcchekpad( ictxt, 'PCHETTRD', ndiag, 1,
459 $ mem( ipd-iprepad ), ndiag, iprepad,
460 $ ipostpad, padval )
461*
462 CALL pcchekpad( ictxt, 'PCHETTRDc', noffd, 1,
463 $ mem( ipe-iprepad ), noffd, iprepad,
464 $ ipostpad, padval )
465 CALL pcchekpad( ictxt, 'PCHETTRDd', nq, 1,
466 $ mem( ipt-iprepad ), nq, iprepad,
467 $ ipostpad, padval )
468 CALL pcchekpad( ictxt, 'PCHETTRDe', worktrd-ipostpad,
469 $ 1, mem( ipw-iprepad ),
470 $ worktrd-ipostpad, iprepad, ipostpad,
471 $ padval )
472 CALL pcfillpad( ictxt, worksiz-ipostpad, 1,
473 $ mem( ipw-iprepad ), worksiz-ipostpad,
474 $ iprepad, ipostpad, padval )
475*
476* Compute fctres = ||A - QTQ'|| / (||A|| * N * eps)
477*
478 CALL pchetdrv( uplo, n, mem( ipa ), 1, 1, desca,
479 $ mem( ipd ), mem( ipe ), mem( ipt ),
480 $ mem( ipw ), ierr( 1 ) )
481*
482* TTRD does not preserve the upper triangular part of A.
483* The following call to PCLATRAN means that we only
484* check the lower triangular part of A - QTQ'
485*
486 CALL pclatran( n, 1, mem( ipa ), 1, 1, desca,
487 $ mem( ipw ) )
488 CALL pclafchk( 'Hemm', 'No', n, n, mem( ipa ), 1, 1,
489 $ desca, iaseed, anorm, fresid,
490 $ mem( ipw ) )
491*
492* Check for memory overwrite
493*
494 CALL pcchekpad( ictxt, 'PCHETDRVf', np, nq,
495 $ mem( ipa-iprepad ), desca( lld_ ),
496 $ iprepad, ipostpad, padval )
497 CALL pcchekpad( ictxt, 'PCHETDRVg', ndiag, 1,
498 $ mem( ipd-iprepad ), ndiag, iprepad,
499 $ ipostpad, padval )
500 CALL pcchekpad( ictxt, 'PCHETDRVh', noffd, 1,
501 $ mem( ipe-iprepad ), noffd, iprepad,
502 $ ipostpad, padval )
503 CALL pcchekpad( ictxt, 'PCHETDRVi', worksiz-ipostpad,
504 $ 1, mem( ipw-iprepad ),
505 $ worksiz-ipostpad, iprepad, ipostpad,
506 $ padval )
507*
508* Test residual and detect NaN result
509*
510 IF( fresid.LE.thresh .AND. fresid-fresid.EQ.
511 $ 0.0e+0 .AND. ierr( 1 ).EQ.0 ) THEN
512 kpass = kpass + 1
513 passed = 'PASSED'
514 ELSE
515 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
516 $ WRITE( nout, fmt = 9991 )fresid
517 kfail = kfail + 1
518 passed = 'FAILED'
519*
520*
521 END IF
522*
523*
524 IF( myrow.EQ.0 .AND. mycol.EQ.0 .AND. ierr( 1 ).NE.0 )
525 $ WRITE( nout, fmt = * )'D or E copies incorrect ...'
526 ELSE
527*
528* Don't perform the checking, only the timing operation
529*
530 kpass = kpass + 1
531 fresid = fresid - fresid
532 passed = 'BYPASS'
533 END IF
534*
535* Gather maximum of all CPU and WALL clock timings
536*
537 CALL slcombine( ictxt, 'All', '>', 'W', 50, 1, wtime )
538 CALL slcombine( ictxt, 'All', '>', 'C', 50, 1, ctime )
539*
540* Print results
541*
542 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
543*
544* TRD requires 16/3 N^3 floating point operations
545*
546 nops = dble( n )
547 nops = ( 16.0d+0 / 3.0d+0 )*nops**3
548 nops = nops / 1.0d+6
549*
550* Print WALL time
551*
552 IF( wtime( 1 ).GT.0.0d+0 ) THEN
553 tmflops = nops / wtime( 1 )
554 ELSE
555 tmflops = 0.0d+0
556 END IF
557 IF( wtime( 1 ).GE.0.0d+0 )
558 $ WRITE( nout, fmt = 9992 )'WALL', n, interleave,
559 $ twogemms, balanced, anb, pnb, nprow*npcol,
560 $ wtime( 1 ), tmflops, fresid, passed
561*
562* Print CPU time
563*
564 IF( ctime( 1 ).GT.0.0d+0 ) THEN
565 tmflops = nops / ctime( 1 )
566 ELSE
567 tmflops = 0.0d+0
568 END IF
569 IF( ctime( 1 ).GE.0.0d+0 )
570 $ WRITE( nout, fmt = 9992 )'CPU ', n, interleave,
571 $ twogemms, balanced, anb, pnb, nprow*npcol,
572 $ ctime( 1 ), tmflops, fresid, passed
573*
574*
575* If split times were collected (in PCHEttrd.f), print
576* them out.
577*
578 IF( wtime( 13 )+wtime( 15 )+wtime( 16 ).GT.0.0d+0 .OR.
579 $ ctime( 13 )+ctime( 15 )+ctime( 16 ).GT.0.0d+0 )
580 $ THEN
581 splitstimed = 1
582 END IF
583 IF( splitstimed.EQ.1 ) THEN
584 WRITE( nout, fmt = 9990 )wtime( 10 ), wtime( 11 ),
585 $ wtime( 12 ), wtime( 13 ), wtime( 14 ),
586 $ wtime( 15 )
587 WRITE( nout, fmt = 9989 )wtime( 16 ), wtime( 17 ),
588 $ wtime( 18 ), wtime( 19 ), wtime( 20 ),
589 $ wtime( 21 )
590*
591 WRITE( nout, fmt = 9988 )ctime( 10 ), ctime( 11 ),
592 $ ctime( 12 ), ctime( 13 ), ctime( 14 ),
593 $ ctime( 15 )
594 WRITE( nout, fmt = 9987 )ctime( 16 ), ctime( 17 ),
595 $ ctime( 18 ), ctime( 19 ), ctime( 20 ),
596 $ ctime( 21 )
597 WRITE( nout, fmt = 9986 )n, nprow*npcol, pnb, anb,
598 $ interleave, balanced, twogemms, timeinternals
599 END IF
600 END IF
601 10 CONTINUE
602 20 CONTINUE
603*
604 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
605 IF( splitstimed.EQ.1 ) THEN
606 WRITE( nout, fmt = 9985 )
607 WRITE( nout, fmt = 9984 )
608 WRITE( nout, fmt = 9983 )
609 WRITE( nout, fmt = 9982 )
610 WRITE( nout, fmt = 9981 )
611 WRITE( nout, fmt = 9980 )
612 WRITE( nout, fmt = 9979 )
613 WRITE( nout, fmt = 9978 )
614 WRITE( nout, fmt = 9977 )
615 WRITE( nout, fmt = 9976 )
616 WRITE( nout, fmt = 9975 )
617 WRITE( nout, fmt = 9974 )
618 WRITE( nout, fmt = 9973 )
619 END IF
620 END IF
621*
622*
623 CALL blacs_gridexit( ictxt )
624 30 CONTINUE
625 RETURN
626*
627 9999 FORMAT( 'ILLEGAL ', a6, ': ', a5, ' = ', i3,
628 $ '; It should be at least 1' )
629 9998 FORMAT( 'ILLEGAL GRID: nprow*npcol = ', i4, '. It can be at most',
630 $ i4 )
631 9997 FORMAT( 'Bad ', a6, ' parameters: going on to next test case.' )
632 9996 FORMAT( 'Unable to perform ', a, ': need TOTMEM of at least',
633 $ i11 )
634*
635 9995 FORMAT( 'PCHETTRD, tailored reduction to tridiagonal form, test.'
636 $ )
637 9994 FORMAT( 'TIME N int 2gm bal anb pnb prcs TRD Time ',
638 $ ' MFLOPS Residual CHECK' )
639 9993 FORMAT( '---- ---- --- --- --- --- --- ---- -------- ',
640 $ '----------- -------- ------' )
641 9992 FORMAT( a4, 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 1x,
642 $ i5, 1x, f9.2, 1x, f11.2, 1x, f8.2, 1x, a6 )
643 9991 FORMAT( '||A - Q*T*Q''|| / (||A|| * N * eps) = ', g25.7 )
644 9990 FORMAT( 'wsplit1=[wsplit1;', f9.2, 1x, f9.2, 1x, f9.2, 1x, f9.2,
645 $ 1x, f9.2, 1x, f9.2, ' ];' )
646 9989 FORMAT( 'wsplit2=[wsplit2;', f9.2, 1x, f9.2, 1x, f9.2, 1x, f9.2,
647 $ 1x, f9.2, 1x, f9.2, ' ];' )
648 9988 FORMAT( 'csplit1=[csplit1;', f9.2, 1x, f9.2, 1x, f9.2, 1x, f9.2,
649 $ 1x, f9.2, 1x, f9.2, ' ];' )
650 9987 FORMAT( 'csplit2=[csplit2;', f9.2, 1x, f9.2, 1x, f9.2, 1x, f9.2,
651 $ 1x, f9.2, 1x, f9.2, ' ];' )
652 9986 FORMAT( 'size_opts=[size_opts;', i4, 1x, i4, 1x, i4, 1x, i4, 1x,
653 $ i4, 1x, i4, 1x, i4, 1x, i4, 1x, ' ];' )
654 9985 FORMAT( 'N=1; NPROCS=2; PNB=3; ANB=4; INTERLEAVE=5; BALANCED=6;',
655 $ ' TWOGEMMS=7; TIMEINTERNALS=8;' )
656 9984 FORMAT( 'S1_OVERHEAD = 1; % Should be mainly cost of barrier' )
657 9983 FORMAT( 'S1_BARRIER = 2; % Cost of barrier' )
658 9982 FORMAT( 'S1_UPDCURCOL = 3; % Update the current column' )
659 9981 FORMAT( 'S1_HOUSE = 4; % Compute the householder vector' )
660 9980 FORMAT( 'S1_SPREAD = 5; % Spread across' )
661 9979 FORMAT( 'S1_TRANSPOSE = 6; % Transpose' )
662 9978 FORMAT( 'S2_UPDCURBLK = 1; % Update the current block column' )
663 9977 FORMAT( 'S2_TRMVT = 2; % TRMVT v = A * h; vt = ht * A'' ' )
664 9976 FORMAT( 'S2_UPD_V = 3; % v = v + V * HT * h + H * VT * h ' )
665 9975 FORMAT( 'S2_TRANS_SUM = 4; % v = v + vt'' ' )
666 9974 FORMAT( 'S2_DOT = 5; % c = v'' * h ' )
667 9973 FORMAT( 'S2_R2K = 6; % A = A - v * h'' - h * v'' ' )
668*
669*
670* End of PCTTRDTESTER
671*
pclafchk
subroutine pclafchk(aform, diag, m, n, a, ia, ja, desca, iaseed, anorm, fresid, work)
Definition pclafchk.f:3
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
descinit
subroutine descinit(desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
Definition descinit.f:3
iceil
integer function iceil(inum, idenom)
Definition iceil.f:2
ilcm
integer function ilcm(m, n)
Definition ilcm.f:2
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition numroc.f:2
pcchekpad
subroutine pcchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
Definition pcchekpad.f:3
pcfillpad
subroutine pcfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
Definition pcfillpad.f:2
max
#define max(A, B)
Definition pcgemr.c:180
pchetdrv
subroutine pchetdrv(uplo, n, a, ia, ja, desca, d, e, tau, work, info)
Definition pchetdrv.f:3
pchettrd
subroutine pchettrd(uplo, n, a, ia, ja, desca, d, e, tau, work, lwork, info)
Definition pchettrd.f:3
pclanhe
real function pclanhe(norm, uplo, n, a, ia, ja, desca, work)
Definition pclanhe.f:3
pclatran
subroutine pclatran(n, nb, a, ia, ja, desca, work)
Definition pclatran.f:2
pjlaenv
integer function pjlaenv(ictxt, ispec, name, opts, n1, n2, n3, n4)
Definition pjlaenv.f:3
slboot
subroutine slboot()
Definition sltimer.f:2
sltimer
subroutine sltimer(i)
Definition sltimer.f:47
slcombine
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)
Definition sltimer.f:267
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the call graph for this function:
Here is the caller graph for this function: