OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pzttrdtester.f
Go to the documentation of this file.
1 SUBROUTINE pzttrdtester( IAM, NPROCS, CHECK, NOUT, THRESH, NVAL,
2 $ NMAT, MEM, TOTMEM, KPASS, KFAIL, KSKIP )
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*16 MEM( * )
18* ..
19*
20* Purpose
21* =======
22*
23* PZTTRDTESTER tests PZHETTRD
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) DOUBLE PRECISION
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*16 array dimension MEMSIZ
50* Where:
51* MEMSIZ = TOTMEM / ZPLXSZ
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 DBLESZ, ZPLXSZ
77 COMPLEX*16 PADVAL
78 parameter( dblesz = 8, zplxsz = 16,
79 $ padval = ( -9923.0d+0, -9924.0d+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 DOUBLE PRECISION ANORM, FRESID, NOPS, TMFLOPS
97* ..
98* .. Local Arrays ..
99 INTEGER ANBTEST( TESTS ), ANBTIME( TIMETESTS ),
100 $ baltest( tests ), baltime( timetests ),
101 $ desca( dlen_ ), descd( dlen_ ), ierr( 1 ),
102 $ intertest( tests ), intertime( timetests ),
103 $ pnbtest( tests ), pnbtime( timetests ),
104 $ twogemmtest( tests ), twogemmtime( timetests )
105 DOUBLE PRECISION CTIME( 100 ), WTIME( 100 )
106* ..
107* .. External Subroutines ..
108 EXTERNAL blacs_barrier, blacs_get, blacs_gridexit,
109 $ blacs_gridinfo, blacs_gridinit, descinit,
110 $ igebr2d, igebs2d, igsum2d, pzchekpad,
111 $ pzfillpad, pzhetdrv, pzhettrd, pzlafchk,
112 $ pzlatran, pzmatgen, slboot, slcombine, sltimer
113* ..
114* .. External Functions ..
115 LOGICAL LSAME
116 INTEGER ICEIL, ILCM, NUMROC, PJLAENV
117 DOUBLE PRECISION PZLANHE
118 EXTERNAL lsame, iceil, ilcm, numroc, pjlaenv, pzlanhe
119* ..
120* .. Intrinsic Functions ..
121 INTRINSIC dble, int, max, sqrt
122* ..
123*
124* .. Scalars in Common ..
125 INTEGER ANB, BALANCED, BCKBLOCK, GSTBLOCK, INTERLEAVE,
126 $ lltblock, minsz, pnb, timeinternals, timing,
127 $ trsblock, twogemms
128* ..
129* .. Common blocks ..
130 COMMON / blocksizes / gstblock, lltblock, bckblock,
131 $ trsblock
132 COMMON / minsize / minsz
133 COMMON / pjlaenvtiming / timing
134 COMMON / tailoredopts / pnb, anb, interleave,
135 $ balanced, twogemms
136 COMMON / timecontrol / timeinternals
137* ..
138* .. Data statements ..
139 DATA baltime / 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0 /
140 DATA intertime / 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1 /
141 DATA twogemmtime / 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0 /
142 DATA anbtime / 16, 16, 16, 16, 16, 8, 8, 32, 32, 16,
143 $ 16 /
144 DATA pnbtime / 32, 32, 32, 32, 32, 32, 32, 32, 32,
145 $ 16, 64 /
146 DATA baltest / 0, 0, 0, 0, 1, 1, 1, 1 /
147 DATA intertest / 0, 0, 1, 1, 0, 0, 1, 1 /
148 DATA twogemmtest / 0, 1, 0, 1, 0, 1, 0, 1 /
149 DATA anbtest / 1, 2, 3, 16, 1, 2, 3, 16 /
150 DATA pnbtest / 1, 16, 8, 1, 16, 8, 1, 16 /
151* ..
152* .. Executable Statements ..
153* This is just to keep ftnchek and toolpack/1 happy
154 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
155 $ rsrc_.LT.0 )RETURN
156*
157*
158 iaseed = 100
159 splitstimed = 0
160 nb = 1
161 uplo = 'L'
162 memsiz = totmem / zplxsz
163*
164* Print headings
165*
166 IF( iam.EQ.0 ) THEN
167 WRITE( nout, fmt = * )
168 WRITE( nout, fmt = 9995 )
169 WRITE( nout, fmt = 9994 )
170 WRITE( nout, fmt = 9993 )
171 WRITE( nout, fmt = * )
172 END IF
173*
174* Loop over different process grids
175*
176 ngrids = int( sqrt( dble( nprocs ) ) )
177*
178 DO 30 nn = 1, ngrids
179*
180 nprow = nn
181 npcol = nn
182 ierr( 1 ) = 0
183*
184* Define process grid
185*
186 CALL blacs_get( -1, 0, ictxt )
187 CALL blacs_gridinit( ictxt, 'Row-major', nprow, npcol )
188 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
189*
190* Go to bottom of loop if this case doesn't use my process
191*
192 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
193 $ GO TO 30
194*
195 DO 20 j = 1, nmat
196*
197 n = nval( j )
198*
199* Make sure matrix information is correct
200*
201 ierr( 1 ) = 0
202 IF( n.LT.1 ) THEN
203 IF( iam.EQ.0 )
204 $ WRITE( nout, fmt = 9999 )'MATRIX', 'N', n
205 ierr( 1 ) = 1
206 END IF
207*
208* Make sure no one had error
209*
210 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
211*
212 IF( ierr( 1 ).GT.0 ) THEN
213 IF( iam.EQ.0 )
214 $ WRITE( nout, fmt = 9997 )'matrix'
215 kskip = kskip + 1
216 GO TO 20
217 END IF
218*
219* Loop over different blocking sizes
220*
221 IF( n.GT.mintimen ) THEN
222*
223* For timing tests, we perform one or two extra tests.
224* Both of these extra tests are performed with the
225* default values for the performance tuning parameters.
226* The second extra test (which is only performed if
227* split times are non-zero) is performed with timeinternals
228* set to 1 (which forces barrier syncs between many
229* phases of the computation).
230*
231 time = .true.
232 maxtests = timetests + 2
233 ELSE
234 time = .false.
235 maxtests = tests
236 END IF
237*
238*
239 DO 10 k = 1, maxtests
240 timeinternals = 0
241 IF( time ) THEN
242 IF( k.GE.maxtests-1 ) THEN
243*
244* For the last two timings, we let pjlaenv set
245* the execution path values. These dummy
246* initializations aren't really necessary,
247* but they illustrate the fact that these values are
248* set in xpjlaenv. The dummy call to pjlaenv
249* has the side effect of setting ANB.
250*
251 minsz = -13
252 balanced = -13
253 interleave = -13
254 twogemms = -13
255 anb = -13
256 pnb = -13
257 timing = 1
258 dummy = pjlaenv( ictxt, 3, 'PZHETTRD', 'L', 0, 0,
259 $ 0, 0 )
260 IF( k.EQ.maxtests )
261 $ timeinternals = 1
262 ELSE
263 timing = 0
264 minsz = 1
265 balanced = baltime( k )
266 interleave = intertime( k )
267 twogemms = twogemmtime( k )
268 anb = anbtime( k )
269 pnb = pnbtime( k )
270 END IF
271 ELSE
272 timing = 0
273 minsz = 1
274 balanced = baltest( k )
275 interleave = intertest( k )
276 twogemms = twogemmtest( k )
277 anb = anbtest( k )
278 pnb = pnbtest( k )
279 END IF
280*
281* Skip the last test (with timeinternals = 1) if
282* PZHETTRD is not collecting the split times.
283*
284 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
285 CALL igebs2d( ictxt, 'All', ' ', 1, 1, splitstimed,
286 $ 1 )
287 ELSE
288 CALL igebr2d( ictxt, 'All', ' ', 1, 1, splitstimed, 1,
289 $ 0, 0 )
290 END IF
291*
292*
293 IF( splitstimed.EQ.0 .AND. k.EQ.maxtests )
294 $ GO TO 10
295*
296* The following hack tests to make sure that PNB need not
297* be the same on all processes. (Provided that PNB is set
298* to 1 in the TRD.dat file.)
299*
300 IF( pnb.EQ.1 )
301 $ pnb = 1 + iam
302*
303* Padding constants
304*
305 np = numroc( n, nb, myrow, 0, nprow )
306 nq = numroc( n, nb, mycol, 0, npcol )
307 IF( check ) THEN
308 iprepad = max( nb, np )
309 imidpad = nb
310 ipostpad = max( nb, nq )
311 ELSE
312 iprepad = 0
313 imidpad = 0
314 ipostpad = 0
315 END IF
316*
317* Initialize the array descriptor for the matrix A
318*
319*
320 CALL descinit( desca, n, n, nb, nb, 0, 0, ictxt,
321 $ max( 1, np )+imidpad, ierr( 1 ) )
322*
323 CALL descinit( descd, 1, n, nb, nb, 0, 0, ictxt, 1,
324 $ info )
325*
326* Check all processes for an error
327*
328 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
329*
330 IF( ierr( 1 ).LT.0 ) THEN
331 IF( iam.EQ.0 )
332 $ WRITE( nout, fmt = 9997 )'descriptor'
333 kskip = kskip + 1
334 GO TO 10
335 END IF
336*
337* Assign pointers into MEM for SCALAPACK arrays, A is
338* allocated starting at position MEM( IPREPAD+1 )
339*
340 ndiag = nq
341 IF( lsame( uplo, 'U' ) ) THEN
342 noffd = nq
343 ELSE
344 noffd = numroc( n-1, nb, mycol, 0, npcol )
345 END IF
346 ndiag = iceil( dblesz*ndiag, zplxsz )
347 noffd = iceil( dblesz*noffd, zplxsz )
348*
349 ipa = iprepad + 1
350 ipd = ipa + desca( lld_ )*nq + ipostpad + iprepad
351 ipe = ipd + ndiag + ipostpad + iprepad
352 ipt = ipe + noffd + ipostpad + iprepad
353 ipw = ipt + nq + ipostpad + iprepad
354*
355* Calculate the amount of workspace required for the
356* reduction
357*
358 nps = max( numroc( n, 1, 0, 0, nprow ), 2*anb )
359 lwmin = 2*( anb+1 )*( 4*nps+2 ) + nps
360*
361 worktrd = lwmin + ipostpad
362 worksiz = worktrd
363*
364* Figure the amount of workspace required by the check
365*
366 IF( check ) THEN
367 itemp = 2*nq + np
368 IF( nprow.NE.npcol ) THEN
369 lcm = ilcm( nprow, npcol )
370 itemp = nb*iceil( iceil( np, nb ), lcm / nprow ) +
371 $ itemp
372 END IF
373 itemp = max( iceil( dblesz*itemp, zplxsz ),
374 $ 2*( nb+np )*nb )
375 worksiz = max( lwmin, itemp ) + ipostpad
376 END IF
377*
378* Check for adequate memory for problem size
379*
380 ierr( 1 ) = 0
381 IF( ipw+worksiz.GT.memsiz ) THEN
382 IF( iam.EQ.0 )
383 $ WRITE( nout, fmt = 9996 )'Tridiagonal reduction',
384 $ ( ipw+worksiz )*zplxsz
385 ierr( 1 ) = 1
386 END IF
387*
388* Check all processes for an error
389*
390 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
391*
392 IF( ierr( 1 ).GT.0 ) THEN
393 IF( iam.EQ.0 )
394 $ WRITE( nout, fmt = 9997 )'MEMORY'
395 kskip = kskip + 1
396 GO TO 10
397 END IF
398*
399*
400*
401* Generate the matrix A
402*
403 CALL pzmatgen( ictxt, 'Hemm', 'n', DESCA( M_ ),
404 $ DESCA( N_ ), DESCA( MB_ ), DESCA( NB_ ),
405 $ MEM( IPA ), DESCA( LLD_ ), DESCA( RSRC_ ),
406 $ DESCA( CSRC_ ), IASEED, 0, NP, 0, NQ,
407 $ MYROW, MYCOL, NPROW, NPCOL )
408*
409*
410* Need Infinity-norm of A for checking
411*
412 IF( CHECK ) THEN
413 CALL PZFILLPAD( ICTXT, NP, NQ, MEM( IPA-IPREPAD ),
414 $ DESCA( LLD_ ), IPREPAD, IPOSTPAD,
415 $ PADVAL )
416 CALL PZFILLPAD( ICTXT, NDIAG, 1, MEM( IPD-IPREPAD ),
417 $ NDIAG, IPREPAD, IPOSTPAD, PADVAL )
418 CALL PZFILLPAD( ICTXT, NOFFD, 1, MEM( IPE-IPREPAD ),
419 $ NOFFD, IPREPAD, IPOSTPAD, PADVAL )
420 CALL PZFILLPAD( ICTXT, NQ, 1, MEM( IPT-IPREPAD ), NQ,
421 $ IPREPAD, IPOSTPAD, PADVAL )
422 CALL PZFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
423 $ MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
424 $ IPREPAD, IPOSTPAD, PADVAL )
425 ANORM = PZLANHE( 'i', UPLO, N, MEM( IPA ), 1, 1,
426 $ DESCA, MEM( IPW ) )
427 CALL PZCHEKPAD( ICTXT, 'pzlanhe', NP, NQ,
428 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
429 $ IPREPAD, IPOSTPAD, PADVAL )
430 CALL PZCHEKPAD( ICTXT, 'pzlanhe', WORKSIZ-IPOSTPAD, 1,
431 $ MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
432 $ IPREPAD, IPOSTPAD, PADVAL )
433 CALL PZFILLPAD( ICTXT, WORKTRD-IPOSTPAD, 1,
434 $ MEM( IPW-IPREPAD ), WORKTRD-IPOSTPAD,
435 $ IPREPAD, IPOSTPAD, PADVAL )
436 END IF
437*
438 CALL SLBOOT
439 CALL BLACS_BARRIER( ICTXT, 'all' )
440 CALL SLTIMER( 1 )
441*
442* Reduce to symmetric tridiagonal form
443*
444 CALL PZHETTRD( UPLO, N, MEM( IPA ), 1, 1, DESCA,
445 $ MEM( IPD ), MEM( IPE ), MEM( IPT ),
446 $ MEM( IPW ), LWMIN, INFO )
447*
448 CALL SLTIMER( 1 )
449*
450 IF( CHECK ) THEN
451*
452* Check for memory overwrite
453*
454 CALL PZCHEKPAD( ICTXT, 'pzhettrd', NP, NQ,
455 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
456 $ IPREPAD, IPOSTPAD, PADVAL )
457 CALL PZCHEKPAD( ICTXT, 'pzhettrd', NDIAG, 1,
458 $ MEM( IPD-IPREPAD ), NDIAG, IPREPAD,
459 $ IPOSTPAD, PADVAL )
460*
461 CALL PZCHEKPAD( ICTXT, 'pzhettrdc', NOFFD, 1,
462 $ MEM( IPE-IPREPAD ), NOFFD, IPREPAD,
463 $ IPOSTPAD, PADVAL )
464 CALL PZCHEKPAD( ICTXT, 'pzhettrdd', NQ, 1,
465 $ MEM( IPT-IPREPAD ), NQ, IPREPAD,
466 $ IPOSTPAD, PADVAL )
467 CALL PZCHEKPAD( ICTXT, 'pzhettrde', WORKTRD-IPOSTPAD,
468 $ 1, MEM( IPW-IPREPAD ),
469 $ WORKTRD-IPOSTPAD, IPREPAD, IPOSTPAD,
470 $ PADVAL )
471 CALL PZFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
472 $ MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
473 $ IPREPAD, IPOSTPAD, PADVAL )
474*
475* Compute fctres = ||A - QTQ'|| / (||A|| * N * eps)
476*
477 CALL PZHETDRV( UPLO, N, MEM( IPA ), 1, 1, DESCA,
478 $ MEM( IPD ), MEM( IPE ), MEM( IPT ),
479 $ MEM( IPW ), IERR( 1 ) )
480*
481* TTRD does not preserve the upper triangular part of A.
482* The following call to PZLATRAN means that we only
483* check the lower triangular part of A - QTQ'
484*
485 CALL PZLATRAN( N, 1, MEM( IPA ), 1, 1, DESCA,
486 $ MEM( IPW ) )
487 CALL PZLAFCHK( 'hemm', 'no', N, N, MEM( IPA ), 1, 1,
488 $ DESCA, IASEED, ANORM, FRESID,
489 $ MEM( IPW ) )
490*
491* Check for memory overwrite
492*
493 CALL PZCHEKPAD( ICTXT, 'pzhetdrvf', NP, NQ,
494 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
495 $ IPREPAD, IPOSTPAD, PADVAL )
496 CALL PZCHEKPAD( ICTXT, 'pzhetdrvg', NDIAG, 1,
497 $ MEM( IPD-IPREPAD ), NDIAG, IPREPAD,
498 $ IPOSTPAD, PADVAL )
499 CALL PZCHEKPAD( ICTXT, 'pzhetdrvh', NOFFD, 1,
500 $ MEM( IPE-IPREPAD ), NOFFD, IPREPAD,
501 $ IPOSTPAD, PADVAL )
502 CALL PZCHEKPAD( ICTXT, 'pzhetdrvi', WORKSIZ-IPOSTPAD,
503 $ 1, MEM( IPW-IPREPAD ),
504 $ WORKSIZ-IPOSTPAD, IPREPAD, IPOSTPAD,
505 $ PADVAL )
506*
507* Test residual and detect NaN result
508*
509.LE..AND..EQ. IF( FRESIDTHRESH FRESID-FRESID
510.AND..EQ. $ 0.0D+0 IERR( 1 )0 ) THEN
511 KPASS = KPASS + 1
512 PASSED = 'passed'
513 ELSE
514.EQ..AND..EQ. IF( MYROW0 MYCOL0 )
515 $ WRITE( NOUT, FMT = 9991 )FRESID
516 KFAIL = KFAIL + 1
517 PASSED = 'failed'
518*
519*
520 END IF
521*
522*
523.EQ..AND..EQ..AND..NE. IF( MYROW0 MYCOL0 IERR( 1 )0 )
524 $ WRITE( NOUT, FMT = * )'d or e copies incorrect ...'
525 ELSE
526*
527* Don't perform the checking, only the timing operation
528*
529 KPASS = KPASS + 1
530 FRESID = FRESID - FRESID
531 PASSED = 'bypass'
532 END IF
533*
534* Gather maximum of all CPU and WALL clock timings
535*
536 CALL SLCOMBINE( ICTXT, 'all', '>', 'w', 50, 1, WTIME )
537 CALL SLCOMBINE( ICTXT, 'all', '>', 'c', 50, 1, CTIME )
538*
539* Print results
540*
541.EQ..AND..EQ. IF( MYROW0 MYCOL0 ) THEN
542*
543* TRD requires 16/3 N^3 floating point operations
544*
545 NOPS = DBLE( N )
546 NOPS = ( 16.0D+0 / 3.0D+0 )*NOPS**3
547 NOPS = NOPS / 1.0D+6
548*
549* Print WALL time
550*
551.GT. IF( WTIME( 1 )0.0D+0 ) THEN
552 TMFLOPS = NOPS / WTIME( 1 )
553 ELSE
554 TMFLOPS = 0.0D+0
555 END IF
556.GE. IF( WTIME( 1 )0.0D+0 )
557 $ WRITE( NOUT, FMT = 9992 )'wall', N, INTERLEAVE,
558 $ TWOGEMMS, BALANCED, ANB, PNB, NPROW*NPCOL,
559 $ WTIME( 1 ), TMFLOPS, FRESID, PASSED
560*
561* Print CPU time
562*
563.GT. IF( CTIME( 1 )0.0D+0 ) THEN
564 TMFLOPS = NOPS / CTIME( 1 )
565 ELSE
566 TMFLOPS = 0.0D+0
567 END IF
568.GE. IF( CTIME( 1 )0.0D+0 )
569 $ WRITE( NOUT, FMT = 9992 )'cpu ', N, INTERLEAVE,
570 $ TWOGEMMS, BALANCED, ANB, PNB, NPROW*NPCOL,
571 $ CTIME( 1 ), TMFLOPS, FRESID, PASSED
572*
573*
574* If split times were collected (in PZHEttrd.f), print
575* them out.
576*
577.GT..OR. IF( WTIME( 13 )+WTIME( 15 )+WTIME( 16 )0.0D+0
578.GT. $ CTIME( 13 )+CTIME( 15 )+CTIME( 16 )0.0D+0 )
579 $ THEN
580 SPLITSTIMED = 1
581 END IF
582.EQ. IF( SPLITSTIMED1 ) THEN
583 WRITE( NOUT, FMT = 9990 )WTIME( 10 ), WTIME( 11 ),
584 $ WTIME( 12 ), WTIME( 13 ), WTIME( 14 ),
585 $ WTIME( 15 )
586 WRITE( NOUT, FMT = 9989 )WTIME( 16 ), WTIME( 17 ),
587 $ WTIME( 18 ), WTIME( 19 ), WTIME( 20 ),
588 $ WTIME( 21 )
589*
590 WRITE( NOUT, FMT = 9988 )CTIME( 10 ), CTIME( 11 ),
591 $ CTIME( 12 ), CTIME( 13 ), CTIME( 14 ),
592 $ CTIME( 15 )
593 WRITE( NOUT, FMT = 9987 )CTIME( 16 ), CTIME( 17 ),
594 $ CTIME( 18 ), CTIME( 19 ), CTIME( 20 ),
595 $ CTIME( 21 )
596 WRITE( NOUT, FMT = 9986 )N, NPROW*NPCOL, PNB, ANB,
597 $ INTERLEAVE, BALANCED, TWOGEMMS, TIMEINTERNALS
598 END IF
599 END IF
600 10 CONTINUE
601 20 CONTINUE
602*
603.EQ..AND..EQ. IF( MYROW0 MYCOL0 ) THEN
604.EQ. IF( SPLITSTIMED1 ) THEN
605 WRITE( NOUT, FMT = 9985 )
606 WRITE( NOUT, FMT = 9984 )
607 WRITE( NOUT, FMT = 9983 )
608 WRITE( NOUT, FMT = 9982 )
609 WRITE( NOUT, FMT = 9981 )
610 WRITE( NOUT, FMT = 9980 )
611 WRITE( NOUT, FMT = 9979 )
612 WRITE( NOUT, FMT = 9978 )
613 WRITE( NOUT, FMT = 9977 )
614 WRITE( NOUT, FMT = 9976 )
615 WRITE( NOUT, FMT = 9975 )
616 WRITE( NOUT, FMT = 9974 )
617 WRITE( NOUT, FMT = 9973 )
618 END IF
619 END IF
620*
621*
622 CALL BLACS_GRIDEXIT( ICTXT )
623 30 CONTINUE
624 RETURN
625*
626 9999 FORMAT( 'illegal ', A6, ': ', A5, ' = ', I3,
627 $ '; it should be at least 1' )
628 9998 FORMAT( 'illegal grid: nprow*npcol = ', I4, '. it can be at most',
629 $ I4 )
630 9997 FORMAT( 'bad ', A6, ' parameters: going on to next test case.' )
631 9996 FORMAT( 'unable to perform ', A, ': need totmem of at least',
632 $ I11 )
633*
634 9995 FORMAT( 'pzhettrd, tailored reduction to tridiagonal form, test.'
635 $ )
636 9994 FORMAT( 'time n int 2gm bal anb pnb prcs trd time ',
637 $ ' mflops residual check' )
638 9993 FORMAT( '---- ---- --- --- --- --- --- ---- -------- ',
639 $ '----------- -------- ------' )
640 9992 FORMAT( A4, 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 1X,
641 $ I5, 1X, F9.2, 1X, F11.2, 1X, F8.2, 1X, A6 )
642 9991 FORMAT( '||a - q*t*q''|| / (||a|| * n * eps) = ', G25.7 )
643 9990 FORMAT( 'wsplit1=[wsplit1;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
644 $ 1X, F9.2, 1X, F9.2, ' ];' )
645 9989 FORMAT( 'wsplit2=[wsplit2;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
646 $ 1X, F9.2, 1X, F9.2, ' ];' )
647 9988 FORMAT( 'csplit1=[csplit1;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
648 $ 1X, F9.2, 1X, F9.2, ' ];' )
649 9987 FORMAT( 'csplit2=[csplit2;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
650 $ 1X, F9.2, 1X, F9.2, ' ];' )
651 9986 FORMAT( 'size_opts=[size_opts;', I4, 1X, I4, 1X, I4, 1X, I4, 1X,
652 $ I4, 1X, I4, 1X, I4, 1X, I4, 1X, ' ];' )
653 9985 FORMAT( 'n=1; nprocs=2; pnb=3; anb=4; interleave=5; balanced=6;',
654 $ ' twogemms=7; timeinternals=8;' )
655 9984 FORMAT( 's1_overhead = 1; % Should be mainly cost of barrier' )
656 9983 FORMAT( 's1_barrier = 2; % Cost of barrier' )
657 9982 FORMAT( 's1_updcurcol = 3; % Update the current column' )
658 9981 FORMAT( 's1_house = 4; % Compute the householder vector' )
659 9980 FORMAT( 's1_spread = 5; % Spread across' )
660 9979 FORMAT( 's1_transpose = 6; % Transpose' )
661 9978 FORMAT( 's2_updcurblk = 1; % Update the current block column' )
662 9977 FORMAT( 's2_trmvt = 2; % TRMVT v = a * h; vt = ht * a'' ' )
663 9976 FORMAT( 's2_upd_v = 3; % v = v + v * ht * h + h * vt * h ' )
664 9975 FORMAT( 's2_trans_sum = 4; % v = v + vt'' ' )
665 9974 FORMAT( 's2_dot = 5; % c = v'' * h ' )
666 9973 FORMAT( 's2_r2k = 6; % A = a - v * h'' - h * v'' ' )
667*
668*
669* End of PZTTRDTESTER
670*
671 END
pzlafchk
subroutine pzlafchk(aform, diag, m, n, a, ia, ja, desca, iaseed, anorm, fresid, work)
Definition pzlafchk.f:3
pzmatgen
subroutine pzmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
Definition pzmatgen.f:4
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
pzchekpad
subroutine pzchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
Definition pzchekpad.f:3
pzfillpad
subroutine pzfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
Definition pzfillpad.f:2
pzhetdrv
subroutine pzhetdrv(uplo, n, a, ia, ja, desca, d, e, tau, work, info)
Definition pzhetdrv.f:3
pzhettrd
subroutine pzhettrd(uplo, n, a, ia, ja, desca, d, e, tau, work, lwork, info)
Definition pzhettrd.f:3
pzlatran
subroutine pzlatran(n, nb, a, ia, ja, desca, work)
Definition pzlatran.f:2
pzttrdtester
subroutine pzttrdtester(iam, nprocs, check, nout, thresh, nval, nmat, mem, totmem, kpass, kfail, kskip)
Definition pzttrdtester.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