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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ psttrdtester()

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

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