ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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  IF( fresid.LE.thresh .AND. fresid-fresid.EQ.
510  $ 0.0d+0 .AND. ierr( 1 ).EQ.0 ) THEN
511  kpass = kpass + 1
512  passed = 'PASSED'
513  ELSE
514  IF( myrow.EQ.0 .AND. mycol.EQ.0 )
515  $ WRITE( nout, fmt = 9991 )fresid
516  kfail = kfail + 1
517  passed = 'FAILED'
518 *
519 *
520  END IF
521 *
522 *
523  IF( myrow.EQ.0 .AND. mycol.EQ.0 .AND. ierr( 1 ).NE.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  IF( myrow.EQ.0 .AND. mycol.EQ.0 ) 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  IF( wtime( 1 ).GT.0.0d+0 ) THEN
552  tmflops = nops / wtime( 1 )
553  ELSE
554  tmflops = 0.0d+0
555  END IF
556  IF( wtime( 1 ).GE.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  IF( ctime( 1 ).GT.0.0d+0 ) THEN
564  tmflops = nops / ctime( 1 )
565  ELSE
566  tmflops = 0.0d+0
567  END IF
568  IF( ctime( 1 ).GE.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  IF( wtime( 13 )+wtime( 15 )+wtime( 16 ).GT.0.0d+0 .OR.
578  $ ctime( 13 )+ctime( 15 )+ctime( 16 ).GT.0.0d+0 )
579  $ THEN
580  splitstimed = 1
581  END IF
582  IF( splitstimed.EQ.1 ) 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  IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
604  IF( splitstimed.EQ.1 ) 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
max
#define max(A, B)
Definition: pcgemr.c:180
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
sltimer
subroutine sltimer(I)
Definition: sltimer.f:47
pzlafchk
subroutine pzlafchk(AFORM, DIAG, M, N, A, IA, JA, DESCA, IASEED, ANORM, FRESID, WORK)
Definition: pzlafchk.f:3
pzlatran
subroutine pzlatran(N, NB, A, IA, JA, DESCA, WORK)
Definition: pzlatran.f:2
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
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
slboot
subroutine slboot()
Definition: sltimer.f:2
pzttrdtester
subroutine pzttrdtester(IAM, NPROCS, CHECK, NOUT, THRESH, NVAL, NMAT, MEM, TOTMEM, KPASS, KFAIL, KSKIP)
Definition: pzttrdtester.f:3
pzchekpad
subroutine pzchekpad(ICTXT, MESS, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: pzchekpad.f:3
slcombine
subroutine slcombine(ICTXT, SCOPE, OP, TIMETYPE, N, IBEG, TIMES)
Definition: sltimer.f:267
pzfillpad
subroutine pzfillpad(ICTXT, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: pzfillpad.f:2