OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pcttrdtester.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine pcttrdtester (iam, nprocs, check, nout, thresh, nval, nmat, mem, totmem, kpass, kfail, kskip)

Function/Subroutine Documentation

◆ 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.LE..AND..EQ. IF( FRESIDTHRESH FRESID-FRESID
511.AND..EQ. $ 0.0E+0 IERR( 1 )0 ) THEN
512 KPASS = KPASS + 1
513 PASSED = 'passed'
514 ELSE
515.EQ..AND..EQ. IF( MYROW0 MYCOL0 )
516 $ WRITE( NOUT, FMT = 9991 )FRESID
517 KFAIL = KFAIL + 1
518 PASSED = 'failed'
519*
520*
521 END IF
522*
523*
524.EQ..AND..EQ..AND..NE. IF( MYROW0 MYCOL0 IERR( 1 )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.EQ..AND..EQ. IF( MYROW0 MYCOL0 ) 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.GT. IF( WTIME( 1 )0.0D+0 ) THEN
553 TMFLOPS = NOPS / WTIME( 1 )
554 ELSE
555 TMFLOPS = 0.0D+0
556 END IF
557.GE. IF( WTIME( 1 )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.GT. IF( CTIME( 1 )0.0D+0 ) THEN
565 TMFLOPS = NOPS / CTIME( 1 )
566 ELSE
567 TMFLOPS = 0.0D+0
568 END IF
569.GE. IF( CTIME( 1 )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.GT..OR. IF( WTIME( 13 )+WTIME( 15 )+WTIME( 16 )0.0D+0
579.GT. $ CTIME( 13 )+CTIME( 15 )+CTIME( 16 )0.0D+0 )
580 $ THEN
581 SPLITSTIMED = 1
582 END IF
583.EQ. IF( SPLITSTIMED1 ) 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.EQ..AND..EQ. IF( MYROW0 MYCOL0 ) THEN
605.EQ. IF( SPLITSTIMED1 ) 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
the
end diagonal values have been computed in the(sparse) matrix id.SOL
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
iceil
integer function iceil(inum, idenom)
Definition iceil.f:2
ilcm
integer function ilcm(m, n)
Definition ilcm.f:2
max
#define max(a, b)
Definition macros.h:21
blacs_gridinit
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
descinit
subroutine descinit(desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
Definition mpi.f:777
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762
blacs_gridinfo
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
Definition mpi.f:754
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition mpi.f:786
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
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