ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pcttrdtester.f
Go to the documentation of this file.
1  SUBROUTINE pcttrdtester( 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 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 *
672  END
pclafchk
subroutine pclafchk(AFORM, DIAG, M, N, A, IA, JA, DESCA, IASEED, ANORM, FRESID, WORK)
Definition: pclafchk.f:3
max
#define max(A, B)
Definition: pcgemr.c:180
pcttrdtester
subroutine pcttrdtester(IAM, NPROCS, CHECK, NOUT, THRESH, NVAL, NMAT, MEM, TOTMEM, KPASS, KFAIL, KSKIP)
Definition: pcttrdtester.f:3
pchettrd
subroutine pchettrd(UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, LWORK, INFO)
Definition: pchettrd.f:3
sltimer
subroutine sltimer(I)
Definition: sltimer.f:47
pclatran
subroutine pclatran(N, NB, A, IA, JA, DESCA, WORK)
Definition: pclatran.f:2
pcchekpad
subroutine pcchekpad(ICTXT, MESS, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: pcchekpad.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
slboot
subroutine slboot()
Definition: sltimer.f:2
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
slcombine
subroutine slcombine(ICTXT, SCOPE, OP, TIMETYPE, N, IBEG, TIMES)
Definition: sltimer.f:267