ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
pdttrdtester.f
Go to the documentation of this file.
00001       SUBROUTINE PDTTRDTESTER( IAM, NPROCS, CHECK, NOUT, THRESH, NVAL,
00002      $                         NMAT, MEM, TOTMEM, KPASS, KFAIL, KSKIP )
00003 *
00004 *  -- ScaLAPACK test routine (version 1.7) --
00005 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00006 *     and University of California, Berkeley.
00007 *     February 24, 2000
00008 *
00009 *     .. Scalar Arguments ..
00010       LOGICAL            CHECK
00011       INTEGER            IAM, KFAIL, KPASS, KSKIP, NMAT, NOUT, NPROCS,
00012      $                   TOTMEM
00013       REAL               THRESH
00014 *     ..
00015 *     .. Array Arguments ..
00016       INTEGER            NVAL( * )
00017       DOUBLE PRECISION   MEM( * )
00018 *     ..
00019 *
00020 *     Purpose
00021 *     =======
00022 *
00023 *     PDTTRDTESTER tests PDSYTTRD
00024 *
00025 *     Arguments
00026 *     =========
00027 *
00028 *     IAM     (local input) INTEGER
00029 *     The local process number
00030 *
00031 *     NPROCS  (global input) INTEGER
00032 *     The number of processors
00033 *
00034 *     CHECK   (global input) LOGICAL
00035 *     Specifies whether the user wants to check the answer
00036 *
00037 *     NOUT    (local input) INTEGER
00038 *     File descriptor
00039 *
00040 *     THRESH  (global input) DOUBLE PRECISION
00041 *     Acceptable error threshold
00042 *
00043 *     NVAL    (global input) INTEGER array dimension NMAT
00044 *     The matrix sizes to test
00045 *
00046 *     NMAT    (global input) INTEGER
00047 *     The number of matrix sizes to test
00048 *
00049 *     MEM     (local input) DOUBLE PRECISION array dimension MEMSIZ
00050 *     Where:
00051 *       MEMSIZ = TOTMEM / DBLESZ
00052 *
00053 *     TOTMEM  (global input) INTEGER
00054 *     Number of bytes in MEM
00055 *
00056 *     KPASS   (local input/output) INTEGER
00057 *     The number of tests which passed.  Only relevant on
00058 *     processor 0.
00059 *
00060 *     KFAIL   (local input/output) INTEGER
00061 *     The number of tests which failed.  Only relevant on
00062 *     processor 0.
00063 *
00064 *     KSKIP   (local input/output) INTEGER
00065 *     The number of tests which were skipped.  Only relevant on
00066 *     processor 0.
00067 *
00068 *     ================================================================
00069 *     .. Parameters ..
00070 *
00071       INTEGER            BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
00072      $                   MB_, NB_, RSRC_, CSRC_, LLD_
00073       PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
00074      $                   CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
00075      $                   RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
00076       INTEGER            DBLESZ
00077       DOUBLE PRECISION   PADVAL
00078       PARAMETER          ( DBLESZ = 8, PADVAL = -9923.0D+0 )
00079       INTEGER            TIMETESTS
00080       PARAMETER          ( TIMETESTS = 11 )
00081       INTEGER            TESTS
00082       PARAMETER          ( TESTS = 8 )
00083       INTEGER            MINTIMEN
00084       PARAMETER          ( MINTIMEN = 8 )
00085 *     ..
00086 *     .. Local Scalars ..
00087       LOGICAL            TIME
00088       CHARACTER          UPLO
00089       CHARACTER*6        PASSED
00090       INTEGER            DUMMY, IASEED, ICTXT, IMIDPAD, INFO, IPA, IPD,
00091      $                   IPE, IPOSTPAD, IPREPAD, IPT, IPW, ITEMP, J, K,
00092      $                   LCM, LWMIN, MAXTESTS, MEMSIZ, MYCOL, MYROW, N,
00093      $                   NB, NDIAG, NGRIDS, NN, NOFFD, NP, NPCOL, NPROW,
00094      $                   NPS, NQ, SPLITSTIMED, WORKSIZ, WORKTRD
00095       DOUBLE PRECISION   ANORM, FRESID, NOPS, TMFLOPS
00096 *     ..
00097 *     .. Local Arrays ..
00098       INTEGER            ANBTEST( TESTS ), ANBTIME( TIMETESTS ),
00099      $                   BALTEST( TESTS ), BALTIME( TIMETESTS ),
00100      $                   DESCA( DLEN_ ), DESCD( DLEN_ ), IERR( 1 ),
00101      $                   INTERTEST( TESTS ), INTERTIME( TIMETESTS ),
00102      $                   PNBTEST( TESTS ), PNBTIME( TIMETESTS ),
00103      $                   TWOGEMMTEST( TESTS ), TWOGEMMTIME( TIMETESTS )
00104       DOUBLE PRECISION   CTIME( 100 ), WTIME( 100 )
00105 *     ..
00106 *     .. External Subroutines ..
00107       EXTERNAL           BLACS_BARRIER, BLACS_GET, BLACS_GRIDEXIT,
00108      $                   BLACS_GRIDINFO, BLACS_GRIDINIT, DESCINIT,
00109      $                   IGEBR2D, IGEBS2D, IGSUM2D, PDCHEKPAD,
00110      $                   PDFILLPAD, PDLAFCHK, PDLATRAN, PDMATGEN,
00111      $                   PDSYTDRV, PDSYTTRD, SLBOOT, SLCOMBINE, SLTIMER
00112 *     ..
00113 *     .. External Functions ..
00114       LOGICAL            LSAME
00115       INTEGER            ICEIL, ILCM, NUMROC, PJLAENV
00116       DOUBLE PRECISION   PDLANSY
00117       EXTERNAL           LSAME, ICEIL, ILCM, NUMROC, PJLAENV, PDLANSY
00118 *     ..
00119 *     .. Intrinsic Functions ..
00120       INTRINSIC          DBLE, INT, MAX, SQRT
00121 *     ..
00122 *
00123 *     .. Scalars in Common ..
00124       INTEGER            ANB, BALANCED, BCKBLOCK, GSTBLOCK, INTERLEAVE,
00125      $                   LLTBLOCK, MINSZ, PNB, TIMEINTERNALS, TIMING,
00126      $                   TRSBLOCK, TWOGEMMS
00127 *     ..
00128 *     .. Common blocks ..
00129       COMMON             / BLOCKSIZES / GSTBLOCK, LLTBLOCK, BCKBLOCK,
00130      $                   TRSBLOCK
00131       COMMON             / MINSIZE / MINSZ
00132       COMMON             / PJLAENVTIMING / TIMING
00133       COMMON             / TAILOREDOPTS / PNB, ANB, INTERLEAVE,
00134      $                   BALANCED, TWOGEMMS
00135       COMMON             / TIMECONTROL / TIMEINTERNALS
00136 *     ..
00137 *     .. Data statements ..
00138       DATA               BALTIME / 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0 /
00139       DATA               INTERTIME / 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1 /
00140       DATA               TWOGEMMTIME / 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0 /
00141       DATA               ANBTIME / 16, 16, 16, 16, 16, 8, 8, 32, 32, 16,
00142      $                   16 /
00143       DATA               PNBTIME / 32, 32, 32, 32, 32, 32, 32, 32, 32,
00144      $                   16, 64 /
00145       DATA               BALTEST / 0, 0, 0, 0, 1, 1, 1, 1 /
00146       DATA               INTERTEST / 0, 0, 1, 1, 0, 0, 1, 1 /
00147       DATA               TWOGEMMTEST / 0, 1, 0, 1, 0, 1, 0, 1 /
00148       DATA               ANBTEST / 1, 2, 3, 16, 1, 2, 3, 16 /
00149       DATA               PNBTEST / 1, 16, 8, 1, 16, 8, 1, 16 /
00150 *     ..
00151 *     .. Executable Statements ..
00152 *       This is just to keep ftnchek and toolpack/1 happy
00153       IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
00154      $    RSRC_.LT.0 )RETURN
00155 *
00156 *
00157       IASEED = 0
00158       SPLITSTIMED = 0
00159       NB = 1
00160       UPLO = 'L'
00161       MEMSIZ = TOTMEM / DBLESZ
00162 *
00163 *     Print headings
00164 *
00165       IF( IAM.EQ.0 ) THEN
00166          WRITE( NOUT, FMT = * )
00167          WRITE( NOUT, FMT = 9995 )
00168          WRITE( NOUT, FMT = 9994 )
00169          WRITE( NOUT, FMT = 9993 )
00170          WRITE( NOUT, FMT = * )
00171       END IF
00172 *
00173 *     Loop over different process grids
00174 *
00175       NGRIDS = INT( SQRT( DBLE( NPROCS ) ) )
00176 *
00177       DO 30 NN = 1, NGRIDS
00178 *
00179          NPROW = NN
00180          NPCOL = NN
00181          IERR( 1 ) = 0
00182 *
00183 *        Define process grid
00184 *
00185          CALL BLACS_GET( -1, 0, ICTXT )
00186          CALL BLACS_GRIDINIT( ICTXT, 'Row-major', NPROW, NPCOL )
00187          CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
00188 *
00189 *        Go to bottom of loop if this case doesn't use my process
00190 *
00191          IF( MYROW.GE.NPROW .OR. MYCOL.GE.NPCOL )
00192      $      GO TO 30
00193 *
00194          DO 20 J = 1, NMAT
00195 *
00196             N = NVAL( J )
00197 *
00198 *           Make sure matrix information is correct
00199 *
00200             IERR( 1 ) = 0
00201             IF( N.LT.1 ) THEN
00202                IF( IAM.EQ.0 )
00203      $            WRITE( NOUT, FMT = 9999 )'MATRIX', 'N', N
00204                IERR( 1 ) = 1
00205             END IF
00206 *
00207 *           Make sure no one had error
00208 *
00209             CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00210 *
00211             IF( IERR( 1 ).GT.0 ) THEN
00212                IF( IAM.EQ.0 )
00213      $            WRITE( NOUT, FMT = 9997 )'matrix'
00214                KSKIP = KSKIP + 1
00215                GO TO 20
00216             END IF
00217 *
00218 *           Loop over different blocking sizes
00219 *
00220             IF( N.GT.MINTIMEN ) THEN
00221 *
00222 *              For timing tests, we perform one or two extra tests.
00223 *              Both of these extra tests are performed with the
00224 *              default values for the performance tuning parameters.
00225 *              The second extra test (which is only performed if
00226 *              split times are non-zero) is performed with timeinternals
00227 *              set to 1 (which forces barrier syncs between many
00228 *              phases of the computation).
00229 *
00230                TIME = .TRUE.
00231                MAXTESTS = TIMETESTS + 2
00232             ELSE
00233                TIME = .FALSE.
00234                MAXTESTS = TESTS
00235             END IF
00236 *
00237 *
00238             DO 10 K = 1, MAXTESTS
00239                TIMEINTERNALS = 0
00240                IF( TIME ) THEN
00241                   IF( K.GE.MAXTESTS-1 ) THEN
00242 *
00243 *                    For the last two timings, we let pjlaenv set
00244 *                    the execution path values.  These dummy
00245 *                    initializations aren't really necessary,
00246 *                    but they illustrate the fact that these values are
00247 *                    set in xpjlaenv.  The dummy call to pjlaenv
00248 *                    has the side effect of setting ANB.
00249 *
00250                      MINSZ = -13
00251                      BALANCED = -13
00252                      INTERLEAVE = -13
00253                      TWOGEMMS = -13
00254                      ANB = -13
00255                      PNB = -13
00256                      TIMING = 1
00257                      DUMMY = PJLAENV( ICTXT, 3, 'PDSYTTRD', 'L', 0, 0,
00258      $                       0, 0 )
00259                      IF( K.EQ.MAXTESTS )
00260      $                  TIMEINTERNALS = 1
00261                   ELSE
00262                      TIMING = 0
00263                      MINSZ = 1
00264                      BALANCED = BALTIME( K )
00265                      INTERLEAVE = INTERTIME( K )
00266                      TWOGEMMS = TWOGEMMTIME( K )
00267                      ANB = ANBTIME( K )
00268                      PNB = PNBTIME( K )
00269                   END IF
00270                ELSE
00271                   TIMING = 0
00272                   MINSZ = 1
00273                   BALANCED = BALTEST( K )
00274                   INTERLEAVE = INTERTEST( K )
00275                   TWOGEMMS = TWOGEMMTEST( K )
00276                   ANB = ANBTEST( K )
00277                   PNB = PNBTEST( K )
00278                END IF
00279 *
00280 *              Skip the last test (with timeinternals = 1) if
00281 *              PDSYTTRD is not collecting the split times.
00282 *
00283                IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
00284                   CALL IGEBS2D( ICTXT, 'All', ' ', 1, 1, SPLITSTIMED,
00285      $                          1 )
00286                ELSE
00287                   CALL IGEBR2D( ICTXT, 'All', ' ', 1, 1, SPLITSTIMED, 1,
00288      $                          0, 0 )
00289                END IF
00290 *
00291 *
00292                IF( SPLITSTIMED.EQ.0 .AND. K.EQ.MAXTESTS )
00293      $            GO TO 10
00294 *
00295 *              The following hack tests to make sure that PNB need not
00296 *              be the same on all processes.  (Provided that PNB is set
00297 *              to 1 in the TRD.dat file.)
00298 *
00299                IF( PNB.EQ.1 )
00300      $            PNB = 1 + IAM
00301 *
00302 *              Padding constants
00303 *
00304                NP = NUMROC( N, NB, MYROW, 0, NPROW )
00305                NQ = NUMROC( N, NB, MYCOL, 0, NPCOL )
00306                IF( CHECK ) THEN
00307                   IPREPAD = MAX( NB, NP )
00308                   IMIDPAD = NB
00309                   IPOSTPAD = MAX( NB, NQ )
00310                ELSE
00311                   IPREPAD = 0
00312                   IMIDPAD = 0
00313                   IPOSTPAD = 0
00314                END IF
00315 *
00316 *              Initialize the array descriptor for the matrix A
00317 *
00318 *
00319                CALL DESCINIT( DESCA, N, N, NB, NB, 0, 0, ICTXT,
00320      $                        MAX( 1, NP )+IMIDPAD, IERR( 1 ) )
00321 *
00322                CALL DESCINIT( DESCD, 1, N, NB, NB, 0, 0, ICTXT, 1,
00323      $                        INFO )
00324 *
00325 *              Check all processes for an error
00326 *
00327                CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00328 *
00329                IF( IERR( 1 ).LT.0 ) THEN
00330                   IF( IAM.EQ.0 )
00331      $               WRITE( NOUT, FMT = 9997 )'descriptor'
00332                   KSKIP = KSKIP + 1
00333                   GO TO 10
00334                END IF
00335 *
00336 *              Assign pointers into MEM for SCALAPACK arrays, A is
00337 *              allocated starting at position MEM( IPREPAD+1 )
00338 *
00339                NDIAG = NQ
00340                IF( LSAME( UPLO, 'U' ) ) THEN
00341                   NOFFD = NQ
00342                ELSE
00343                   NOFFD = NUMROC( N-1, NB, MYCOL, 0, NPCOL )
00344                END IF
00345 *
00346                IPA = IPREPAD + 1
00347                IPD = IPA + DESCA( LLD_ )*NQ + IPOSTPAD + IPREPAD
00348                IPE = IPD + NDIAG + IPOSTPAD + IPREPAD
00349                IPT = IPE + NOFFD + IPOSTPAD + IPREPAD
00350                IPW = IPT + NQ + IPOSTPAD + IPREPAD
00351 *
00352 *              Calculate the amount of workspace required for the
00353 *              reduction
00354 *
00355                NPS = MAX( NUMROC( N, 1, 0, 0, NPROW ), 2*ANB )
00356                LWMIN = 2*( ANB+1 )*( 4*NPS+2 ) + NPS
00357 *
00358                WORKTRD = LWMIN + IPOSTPAD
00359                WORKSIZ = WORKTRD
00360 *
00361 *              Figure the amount of workspace required by the check
00362 *
00363                IF( CHECK ) THEN
00364                   ITEMP = 2*NQ + NP
00365                   IF( NPROW.NE.NPCOL ) THEN
00366                      LCM = ILCM( NPROW, NPCOL )
00367                      ITEMP = NB*ICEIL( ICEIL( NP, NB ), LCM / NPROW ) +
00368      $                       ITEMP
00369                   END IF
00370                   ITEMP = MAX( ITEMP, 2*( NB+NP )*NB )
00371                   WORKSIZ = MAX( LWMIN, ITEMP ) + IPOSTPAD
00372                END IF
00373 *
00374 *              Check for adequate memory for problem size
00375 *
00376                IERR( 1 ) = 0
00377                IF( IPW+WORKSIZ.GT.MEMSIZ ) THEN
00378                   IF( IAM.EQ.0 )
00379      $               WRITE( NOUT, FMT = 9996 )'Tridiagonal reduction',
00380      $               ( IPW+WORKSIZ )*DBLESZ
00381                   IERR( 1 ) = 1
00382                END IF
00383 *
00384 *              Check all processes for an error
00385 *
00386                CALL IGSUM2D( ICTXT, 'All', ' ', 1, 1, IERR, 1, -1, 0 )
00387 *
00388                IF( IERR( 1 ).GT.0 ) THEN
00389                   IF( IAM.EQ.0 )
00390      $               WRITE( NOUT, FMT = 9997 )'MEMORY'
00391                   KSKIP = KSKIP + 1
00392                   GO TO 10
00393                END IF
00394 *
00395 *
00396 *
00397 *              Generate the matrix A
00398 *
00399                CALL PDMATGEN( ICTXT, 'Hemm', 'N', DESCA( M_ ),
00400      $                        DESCA( N_ ), DESCA( MB_ ), DESCA( NB_ ),
00401      $                        MEM( IPA ), DESCA( LLD_ ), DESCA( RSRC_ ),
00402      $                        DESCA( CSRC_ ), IASEED, 0, NP, 0, NQ,
00403      $                        MYROW, MYCOL, NPROW, NPCOL )
00404 *
00405 *
00406 *              Need Infinity-norm of A for checking
00407 *
00408                IF( CHECK ) THEN
00409                   CALL PDFILLPAD( ICTXT, NP, NQ, MEM( IPA-IPREPAD ),
00410      $                            DESCA( LLD_ ), IPREPAD, IPOSTPAD,
00411      $                            PADVAL )
00412                   CALL PDFILLPAD( ICTXT, NDIAG, 1, MEM( IPD-IPREPAD ),
00413      $                            NDIAG, IPREPAD, IPOSTPAD, PADVAL )
00414                   CALL PDFILLPAD( ICTXT, NOFFD, 1, MEM( IPE-IPREPAD ),
00415      $                            NOFFD, IPREPAD, IPOSTPAD, PADVAL )
00416                   CALL PDFILLPAD( ICTXT, NQ, 1, MEM( IPT-IPREPAD ), NQ,
00417      $                            IPREPAD, IPOSTPAD, PADVAL )
00418                   CALL PDFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
00419      $                            MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
00420      $                            IPREPAD, IPOSTPAD, PADVAL )
00421                   ANORM = PDLANSY( 'I', UPLO, N, MEM( IPA ), 1, 1,
00422      $                    DESCA, MEM( IPW ) )
00423                   CALL PDCHEKPAD( ICTXT, 'PDLANSY', NP, NQ,
00424      $                            MEM( IPA-IPREPAD ), DESCA( LLD_ ),
00425      $                            IPREPAD, IPOSTPAD, PADVAL )
00426                   CALL PDCHEKPAD( ICTXT, 'PDLANSY', WORKSIZ-IPOSTPAD, 1,
00427      $                            MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
00428      $                            IPREPAD, IPOSTPAD, PADVAL )
00429                   CALL PDFILLPAD( ICTXT, WORKTRD-IPOSTPAD, 1,
00430      $                            MEM( IPW-IPREPAD ), WORKTRD-IPOSTPAD,
00431      $                            IPREPAD, IPOSTPAD, PADVAL )
00432                END IF
00433 *
00434                CALL SLBOOT
00435                CALL BLACS_BARRIER( ICTXT, 'All' )
00436                CALL SLTIMER( 1 )
00437 *
00438 *              Reduce to symmetric tridiagonal form
00439 *
00440                CALL PDSYTTRD( UPLO, N, MEM( IPA ), 1, 1, DESCA,
00441      $                        MEM( IPD ), MEM( IPE ), MEM( IPT ),
00442      $                        MEM( IPW ), LWMIN, INFO )
00443 *
00444                CALL SLTIMER( 1 )
00445 *
00446                IF( CHECK ) THEN
00447 *
00448 *                 Check for memory overwrite
00449 *
00450                   CALL PDCHEKPAD( ICTXT, 'PDSYTTRD', NP, NQ,
00451      $                            MEM( IPA-IPREPAD ), DESCA( LLD_ ),
00452      $                            IPREPAD, IPOSTPAD, PADVAL )
00453                   CALL PDCHEKPAD( ICTXT, 'PDSYTTRD', NDIAG, 1,
00454      $                            MEM( IPD-IPREPAD ), NDIAG, IPREPAD,
00455      $                            IPOSTPAD, PADVAL )
00456 *
00457                   CALL PDCHEKPAD( ICTXT, 'PDSYTTRDc', NOFFD, 1,
00458      $                            MEM( IPE-IPREPAD ), NOFFD, IPREPAD,
00459      $                            IPOSTPAD, PADVAL )
00460                   CALL PDCHEKPAD( ICTXT, 'PDSYTTRDd', NQ, 1,
00461      $                            MEM( IPT-IPREPAD ), NQ, IPREPAD,
00462      $                            IPOSTPAD, PADVAL )
00463                   CALL PDCHEKPAD( ICTXT, 'PDSYTTRDe', WORKTRD-IPOSTPAD,
00464      $                            1, MEM( IPW-IPREPAD ),
00465      $                            WORKTRD-IPOSTPAD, IPREPAD, IPOSTPAD,
00466      $                            PADVAL )
00467                   CALL PDFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
00468      $                            MEM( IPW-IPREPAD ), WORKSIZ-IPOSTPAD,
00469      $                            IPREPAD, IPOSTPAD, PADVAL )
00470 *
00471 *                 Compute fctres = ||A - QTQ'|| / (||A|| * N * eps)
00472 *
00473                   CALL PDSYTDRV( UPLO, N, MEM( IPA ), 1, 1, DESCA,
00474      $                           MEM( IPD ), MEM( IPE ), MEM( IPT ),
00475      $                           MEM( IPW ), IERR( 1 ) )
00476 *
00477 *                 TTRD does not preserve the upper triangular part of A.
00478 *                 The following call to PDLATRAN means that we only
00479 *                 check the lower triangular part of A - QTQ'
00480 *
00481                   CALL PDLATRAN( N, 1, MEM( IPA ), 1, 1, DESCA,
00482      $                           MEM( IPW ) )
00483                   CALL PDLAFCHK( 'Hemm', 'No', N, N, MEM( IPA ), 1, 1,
00484      $                           DESCA, IASEED, ANORM, FRESID,
00485      $                           MEM( IPW ) )
00486 *
00487 *                 Check for memory overwrite
00488 *
00489                   CALL PDCHEKPAD( ICTXT, 'PDSYTDRVf', NP, NQ,
00490      $                            MEM( IPA-IPREPAD ), DESCA( LLD_ ),
00491      $                            IPREPAD, IPOSTPAD, PADVAL )
00492                   CALL PDCHEKPAD( ICTXT, 'PDSYTDRVg', NDIAG, 1,
00493      $                            MEM( IPD-IPREPAD ), NDIAG, IPREPAD,
00494      $                            IPOSTPAD, PADVAL )
00495                   CALL PDCHEKPAD( ICTXT, 'PDSYTDRVh', NOFFD, 1,
00496      $                            MEM( IPE-IPREPAD ), NOFFD, IPREPAD,
00497      $                            IPOSTPAD, PADVAL )
00498                   CALL PDCHEKPAD( ICTXT, 'PDSYTDRVi', WORKSIZ-IPOSTPAD,
00499      $                            1, MEM( IPW-IPREPAD ),
00500      $                            WORKSIZ-IPOSTPAD, IPREPAD, IPOSTPAD,
00501      $                            PADVAL )
00502 *
00503 *                 Test residual and detect NaN result
00504 *
00505                   IF( FRESID.LE.THRESH .AND. FRESID-FRESID.EQ.
00506      $                0.0D+0 .AND. IERR( 1 ).EQ.0 ) THEN
00507                      KPASS = KPASS + 1
00508                      PASSED = 'PASSED'
00509                   ELSE
00510                      IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 )
00511      $                  WRITE( NOUT, FMT = 9991 )FRESID
00512                      KFAIL = KFAIL + 1
00513                      PASSED = 'FAILED'
00514 *
00515 *
00516                   END IF
00517 *
00518 *
00519                   IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 .AND. IERR( 1 ).NE.0 )
00520      $               WRITE( NOUT, FMT = * )'D or E copies incorrect ...'
00521                ELSE
00522 *
00523 *                 Don't perform the checking, only the timing operation
00524 *
00525                   KPASS = KPASS + 1
00526                   FRESID = FRESID - FRESID
00527                   PASSED = 'BYPASS'
00528                END IF
00529 *
00530 *              Gather maximum of all CPU and WALL clock timings
00531 *
00532                CALL SLCOMBINE( ICTXT, 'All', '>', 'W', 50, 1, WTIME )
00533                CALL SLCOMBINE( ICTXT, 'All', '>', 'C', 50, 1, CTIME )
00534 *
00535 *              Print results
00536 *
00537                IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
00538 *
00539 *                 TRD requires 16/3 N^3 floating point operations
00540 *
00541                   NOPS = DBLE( N )
00542                   NOPS = ( 16.0D+0 / 3.0D+0 )*NOPS**3
00543                   NOPS = NOPS / 1.0D+6
00544 *
00545 *                 Print WALL time
00546 *
00547                   IF( WTIME( 1 ).GT.0.0D+0 ) THEN
00548                      TMFLOPS = NOPS / WTIME( 1 )
00549                   ELSE
00550                      TMFLOPS = 0.0D+0
00551                   END IF
00552                   IF( WTIME( 1 ).GE.0.0D+0 )
00553      $               WRITE( NOUT, FMT = 9992 )'WALL', N, INTERLEAVE,
00554      $               TWOGEMMS, BALANCED, ANB, PNB, NPROW*NPCOL,
00555      $               WTIME( 1 ), TMFLOPS, FRESID, PASSED
00556 *
00557 *                 Print CPU time
00558 *
00559                   IF( CTIME( 1 ).GT.0.0D+0 ) THEN
00560                      TMFLOPS = NOPS / CTIME( 1 )
00561                   ELSE
00562                      TMFLOPS = 0.0D+0
00563                   END IF
00564                   IF( CTIME( 1 ).GE.0.0D+0 )
00565      $               WRITE( NOUT, FMT = 9992 )'CPU ', N, INTERLEAVE,
00566      $               TWOGEMMS, BALANCED, ANB, PNB, NPROW*NPCOL,
00567      $               CTIME( 1 ), TMFLOPS, FRESID, PASSED
00568 *
00569 *
00570 *                 If split times were collected (in PDSYttrd.f), print
00571 *                 them out.
00572 *
00573                   IF( WTIME( 13 )+WTIME( 15 )+WTIME( 16 ).GT.0.0D+0 .OR.
00574      $                CTIME( 13 )+CTIME( 15 )+CTIME( 16 ).GT.0.0D+0 )
00575      $                 THEN
00576                      SPLITSTIMED = 1
00577                   END IF
00578                   IF( SPLITSTIMED.EQ.1 ) THEN
00579                      WRITE( NOUT, FMT = 9990 )WTIME( 10 ), WTIME( 11 ),
00580      $                  WTIME( 12 ), WTIME( 13 ), WTIME( 14 ),
00581      $                  WTIME( 15 )
00582                      WRITE( NOUT, FMT = 9989 )WTIME( 16 ), WTIME( 17 ),
00583      $                  WTIME( 18 ), WTIME( 19 ), WTIME( 20 ),
00584      $                  WTIME( 21 )
00585 *
00586                      WRITE( NOUT, FMT = 9988 )CTIME( 10 ), CTIME( 11 ),
00587      $                  CTIME( 12 ), CTIME( 13 ), CTIME( 14 ),
00588      $                  CTIME( 15 )
00589                      WRITE( NOUT, FMT = 9987 )CTIME( 16 ), CTIME( 17 ),
00590      $                  CTIME( 18 ), CTIME( 19 ), CTIME( 20 ),
00591      $                  CTIME( 21 )
00592                      WRITE( NOUT, FMT = 9986 )N, NPROW*NPCOL, PNB, ANB,
00593      $                  INTERLEAVE, BALANCED, TWOGEMMS, TIMEINTERNALS
00594                   END IF
00595                END IF
00596    10       CONTINUE
00597    20    CONTINUE
00598 *
00599          IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
00600             IF( SPLITSTIMED.EQ.1 ) THEN
00601                WRITE( NOUT, FMT = 9985 )
00602                WRITE( NOUT, FMT = 9984 )
00603                WRITE( NOUT, FMT = 9983 )
00604                WRITE( NOUT, FMT = 9982 )
00605                WRITE( NOUT, FMT = 9981 )
00606                WRITE( NOUT, FMT = 9980 )
00607                WRITE( NOUT, FMT = 9979 )
00608                WRITE( NOUT, FMT = 9978 )
00609                WRITE( NOUT, FMT = 9977 )
00610                WRITE( NOUT, FMT = 9976 )
00611                WRITE( NOUT, FMT = 9975 )
00612                WRITE( NOUT, FMT = 9974 )
00613                WRITE( NOUT, FMT = 9973 )
00614             END IF
00615          END IF
00616 *
00617 *
00618          CALL BLACS_GRIDEXIT( ICTXT )
00619    30 CONTINUE
00620       RETURN
00621 *
00622  9999 FORMAT( 'ILLEGAL ', A6, ': ', A5, ' = ', I3,
00623      $      '; It should be at least 1' )
00624  9998 FORMAT( 'ILLEGAL GRID: nprow*npcol = ', I4, '. It can be at most',
00625      $      I4 )
00626  9997 FORMAT( 'Bad ', A6, ' parameters: going on to next test case.' )
00627  9996 FORMAT( 'Unable to perform ', A, ': need TOTMEM of at least',
00628      $      I11 )
00629 *
00630  9995 FORMAT( 'PDSYTTRD, tailored reduction to tridiagonal form, test.'
00631      $       )
00632  9994 FORMAT( 'TIME N     int 2gm bal anb pnb prcs TRD Time ',
00633      $      '     MFLOPS Residual  CHECK' )
00634  9993 FORMAT( '---- ----  --- --- --- --- --- ---- -------- ',
00635      $      '----------- -------- ------' )
00636  9992 FORMAT( A4, 1X, I5, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 1X, I3, 1X,
00637      $      I5, 1X, F9.2, 1X, F11.2, 1X, F8.2, 1X, A6 )
00638  9991 FORMAT( '||A - Q*T*Q''|| / (||A|| * N * eps) = ', G25.7 )
00639  9990 FORMAT( 'wsplit1=[wsplit1;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
00640      $      1X, F9.2, 1X, F9.2, ' ];' )
00641  9989 FORMAT( 'wsplit2=[wsplit2;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
00642      $      1X, F9.2, 1X, F9.2, ' ];' )
00643  9988 FORMAT( 'csplit1=[csplit1;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
00644      $      1X, F9.2, 1X, F9.2, ' ];' )
00645  9987 FORMAT( 'csplit2=[csplit2;', F9.2, 1X, F9.2, 1X, F9.2, 1X, F9.2,
00646      $      1X, F9.2, 1X, F9.2, ' ];' )
00647  9986 FORMAT( 'size_opts=[size_opts;', I4, 1X, I4, 1X, I4, 1X, I4, 1X,
00648      $      I4, 1X, I4, 1X, I4, 1X, I4, 1X, ' ];' )
00649  9985 FORMAT( 'N=1; NPROCS=2; PNB=3; ANB=4; INTERLEAVE=5; BALANCED=6;',
00650      $      ' TWOGEMMS=7; TIMEINTERNALS=8;' )
00651  9984 FORMAT( 'S1_OVERHEAD = 1; % Should be mainly cost of barrier' )
00652  9983 FORMAT( 'S1_BARRIER = 2; % Cost of barrier' )
00653  9982 FORMAT( 'S1_UPDCURCOL = 3; % Update the current column' )
00654  9981 FORMAT( 'S1_HOUSE = 4; % Compute the householder vector' )
00655  9980 FORMAT( 'S1_SPREAD = 5; % Spread across' )
00656  9979 FORMAT( 'S1_TRANSPOSE = 6; % Transpose' )
00657  9978 FORMAT( 'S2_UPDCURBLK = 1; % Update the current block column' )
00658  9977 FORMAT( 'S2_TRMVT = 2; % TRMVT v = A * h; vt = ht * A'' ' )
00659  9976 FORMAT( 'S2_UPD_V = 3; %  v = v + V * HT * h + H * VT * h ' )
00660  9975 FORMAT( 'S2_TRANS_SUM = 4; %  v = v + vt'' ' )
00661  9974 FORMAT( 'S2_DOT = 5; %  c = v'' * h ' )
00662  9973 FORMAT( 'S2_R2K = 6; %  A = A - v * h'' - h * v'' ' )
00663 *
00664 *
00665 *     End of PDTTRDTESTER
00666 *
00667       END