ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
psttrdtester.f
Go to the documentation of this file.
1  SUBROUTINE psttrdtester( 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  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  IF( ierr( 1 ).LT.0 ) THEN
330  IF( iam.EQ.0 )
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  IF( nprow.NE.npcol ) 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  IF( ipw+worksiz.GT.memsiz ) THEN
378  IF( iam.EQ.0 )
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  IF( ierr( 1 ).GT.0 ) THEN
389  IF( iam.EQ.0 )
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  IF( fresid.LE.thresh .AND. fresid-fresid.EQ.
506  $ 0.0e+0 .AND. ierr( 1 ).EQ.0 ) THEN
507  kpass = kpass + 1
508  passed = 'PASSED'
509  ELSE
510  IF( myrow.EQ.0 .AND. mycol.EQ.0 )
511  $ WRITE( nout, fmt = 9991 )fresid
512  kfail = kfail + 1
513  passed = 'FAILED'
514 *
515 *
516  END IF
517 *
518 *
519  IF( myrow.EQ.0 .AND. mycol.EQ.0 .AND. ierr( 1 ).NE.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  IF( myrow.EQ.0 .AND. mycol.EQ.0 ) 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  IF( wtime( 1 ).GT.0.0d+0 ) THEN
548  tmflops = nops / wtime( 1 )
549  ELSE
550  tmflops = 0.0d+0
551  END IF
552  IF( wtime( 1 ).GE.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  IF( ctime( 1 ).GT.0.0d+0 ) THEN
560  tmflops = nops / ctime( 1 )
561  ELSE
562  tmflops = 0.0d+0
563  END IF
564  IF( ctime( 1 ).GE.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  IF( wtime( 13 )+wtime( 15 )+wtime( 16 ).GT.0.0d+0 .OR.
574  $ ctime( 13 )+ctime( 15 )+ctime( 16 ).GT.0.0d+0 )
575  $ THEN
576  splitstimed = 1
577  END IF
578  IF( splitstimed.EQ.1 ) 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  IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
600  IF( splitstimed.EQ.1 ) 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 *
667  END
pslafchk
subroutine pslafchk(AFORM, DIAG, M, N, A, IA, JA, DESCA, IASEED, ANORM, FRESID, WORK)
Definition: pslafchk.f:3
max
#define max(A, B)
Definition: pcgemr.c:180
sltimer
subroutine sltimer(I)
Definition: sltimer.f:47
pschekpad
subroutine pschekpad(ICTXT, MESS, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: pschekpad.f:3
psttrdtester
subroutine psttrdtester(IAM, NPROCS, CHECK, NOUT, THRESH, NVAL, NMAT, MEM, TOTMEM, KPASS, KFAIL, KSKIP)
Definition: psttrdtester.f:3
descinit
subroutine descinit(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD, INFO)
Definition: descinit.f:3
slboot
subroutine slboot()
Definition: sltimer.f:2
pslatran
subroutine pslatran(N, NB, A, IA, JA, DESCA, WORK)
Definition: pslatran.f:2
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
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
psfillpad
subroutine psfillpad(ICTXT, M, N, A, LDA, IPRE, IPOST, CHKVAL)
Definition: psfillpad.f:2
slcombine
subroutine slcombine(ICTXT, SCOPE, OP, TIMETYPE, N, IBEG, TIMES)
Definition: sltimer.f:267