TESTING/LIN/dchktp.f

   1 *> \brief \b DCHKTP
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE DCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  12 *                          NMAX, AP, AINVP, B, X, XACT, WORK, RWORK,
  13 *                          IWORK, NOUT )
  14 *
  15 *       .. Scalar Arguments ..
  16 *       LOGICAL            TSTERR
  17 *       INTEGER            NMAX, NN, NNS, NOUT
  18 *       DOUBLE PRECISION   THRESH
  19 *       ..
  20 *       .. Array Arguments ..
  21 *       LOGICAL            DOTYPE( * )
  22 *       INTEGER            IWORK( * ), NSVAL( * ), NVAL( * )
  23 *       DOUBLE PRECISION   AINVP( * ), AP( * ), B( * ), RWORK( * ),
  24 *      $                   WORK( * ), X( * ), XACT( * )
  25 *       ..
  26 *
  27 *
  28 *> \par Purpose:
  29 *  =============
  30 *>
  31 *> \verbatim
  32 *>
  33 *> DCHKTP tests DTPTRI, -TRS, -RFS, and -CON, and DLATPS
  34 *> \endverbatim
  35 *
  36 *  Arguments:
  37 *  ==========
  38 *
  39 *> \param[in] DOTYPE
  40 *> \verbatim
  41 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
  42 *>          The matrix types to be used for testing.  Matrices of type j
  43 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  44 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  45 *> \endverbatim
  46 *>
  47 *> \param[in] NN
  48 *> \verbatim
  49 *>          NN is INTEGER
  50 *>          The number of values of N contained in the vector NVAL.
  51 *> \endverbatim
  52 *>
  53 *> \param[in] NVAL
  54 *> \verbatim
  55 *>          NVAL is INTEGER array, dimension (NN)
  56 *>          The values of the matrix column dimension N.
  57 *> \endverbatim
  58 *>
  59 *> \param[in] NNS
  60 *> \verbatim
  61 *>          NNS is INTEGER
  62 *>          The number of values of NRHS contained in the vector NSVAL.
  63 *> \endverbatim
  64 *>
  65 *> \param[in] NSVAL
  66 *> \verbatim
  67 *>          NSVAL is INTEGER array, dimension (NNS)
  68 *>          The values of the number of right hand sides NRHS.
  69 *> \endverbatim
  70 *>
  71 *> \param[in] THRESH
  72 *> \verbatim
  73 *>          THRESH is DOUBLE PRECISION
  74 *>          The threshold value for the test ratios.  A result is
  75 *>          included in the output file if RESULT >= THRESH.  To have
  76 *>          every test ratio printed, use THRESH = 0.
  77 *> \endverbatim
  78 *>
  79 *> \param[in] TSTERR
  80 *> \verbatim
  81 *>          TSTERR is LOGICAL
  82 *>          Flag that indicates whether error exits are to be tested.
  83 *> \endverbatim
  84 *>
  85 *> \param[in] NMAX
  86 *> \verbatim
  87 *>          NMAX is INTEGER
  88 *>          The leading dimension of the work arrays.  NMAX >= the
  89 *>          maximumm value of N in NVAL.
  90 *> \endverbatim
  91 *>
  92 *> \param[out] AP
  93 *> \verbatim
  94 *>          AP is DOUBLE PRECISION array, dimension
  95 *>                      (NMAX*(NMAX+1)/2)
  96 *> \endverbatim
  97 *>
  98 *> \param[out] AINVP
  99 *> \verbatim
 100 *>          AINVP is DOUBLE PRECISION array, dimension
 101 *>                      (NMAX*(NMAX+1)/2)
 102 *> \endverbatim
 103 *>
 104 *> \param[out] B
 105 *> \verbatim
 106 *>          B is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
 107 *>          where NSMAX is the largest entry in NSVAL.
 108 *> \endverbatim
 109 *>
 110 *> \param[out] X
 111 *> \verbatim
 112 *>          X is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
 113 *> \endverbatim
 114 *>
 115 *> \param[out] XACT
 116 *> \verbatim
 117 *>          XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
 118 *> \endverbatim
 119 *>
 120 *> \param[out] WORK
 121 *> \verbatim
 122 *>          WORK is DOUBLE PRECISION array, dimension
 123 *>                      (NMAX*max(3,NSMAX))
 124 *> \endverbatim
 125 *>
 126 *> \param[out] IWORK
 127 *> \verbatim
 128 *>          IWORK is INTEGER array, dimension (NMAX)
 129 *> \endverbatim
 130 *>
 131 *> \param[out] RWORK
 132 *> \verbatim
 133 *>          RWORK is DOUBLE PRECISION array, dimension
 134 *>                      (max(NMAX,2*NSMAX))
 135 *> \endverbatim
 136 *>
 137 *> \param[in] NOUT
 138 *> \verbatim
 139 *>          NOUT is INTEGER
 140 *>          The unit number for output.
 141 *> \endverbatim
 142 *
 143 *  Authors:
 144 *  ========
 145 *
 146 *> \author Univ. of Tennessee
 147 *> \author Univ. of California Berkeley
 148 *> \author Univ. of Colorado Denver
 149 *> \author NAG Ltd.
 150 *
 151 *> \date November 2011
 152 *
 153 *> \ingroup double_lin
 154 *
 155 *  =====================================================================
 156       SUBROUTINE DCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
 157      $                   NMAX, AP, AINVP, B, X, XACT, WORK, RWORK,
 158      $                   IWORK, NOUT )
 159 *
 160 *  -- LAPACK test routine (version 3.4.0) --
 161 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 162 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 163 *     November 2011
 164 *
 165 *     .. Scalar Arguments ..
 166       LOGICAL            TSTERR
 167       INTEGER            NMAX, NN, NNS, NOUT
 168       DOUBLE PRECISION   THRESH
 169 *     ..
 170 *     .. Array Arguments ..
 171       LOGICAL            DOTYPE( * )
 172       INTEGER            IWORK( * ), NSVAL( * ), NVAL( * )
 173       DOUBLE PRECISION   AINVP( * ), AP( * ), B( * ), RWORK( * ),
 174      $                   WORK( * ), X( * ), XACT( * )
 175 *     ..
 176 *
 177 *  =====================================================================
 178 *
 179 *     .. Parameters ..
 180       INTEGER            NTYPE1, NTYPES
 181       PARAMETER          ( NTYPE1 = 10, NTYPES = 18 )
 182       INTEGER            NTESTS
 183       PARAMETER          ( NTESTS = 9 )
 184       INTEGER            NTRAN
 185       PARAMETER          ( NTRAN = 3 )
 186       DOUBLE PRECISION   ONE, ZERO
 187       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 188 *     ..
 189 *     .. Local Scalars ..
 190       CHARACTER          DIAG, NORM, TRANS, UPLO, XTYPE
 191       CHARACTER*3        PATH
 192       INTEGER            I, IDIAG, IMAT, IN, INFO, IRHS, ITRAN, IUPLO,
 193      $                   K, LAP, LDA, N, NERRS, NFAIL, NRHS, NRUN
 194       DOUBLE PRECISION   AINVNM, ANORM, RCOND, RCONDC, RCONDI, RCONDO,
 195      $                   SCALE
 196 *     ..
 197 *     .. Local Arrays ..
 198       CHARACTER          TRANSS( NTRAN ), UPLOS( 2 )
 199       INTEGER            ISEED( 4 ), ISEEDY( 4 )
 200       DOUBLE PRECISION   RESULT( NTESTS )
 201 *     ..
 202 *     .. External Functions ..
 203       LOGICAL            LSAME
 204       DOUBLE PRECISION   DLANTP
 205       EXTERNAL           LSAME, DLANTP
 206 *     ..
 207 *     .. External Subroutines ..
 208       EXTERNAL           ALAERH, ALAHD, ALASUM, DCOPY, DERRTR, DGET04,
 209      $                   DLACPY, DLARHS, DLATPS, DLATTP, DTPCON, DTPRFS,
 210      $                   DTPT01, DTPT02, DTPT03, DTPT05, DTPT06, DTPTRI,
 211      $                   DTPTRS
 212 *     ..
 213 *     .. Scalars in Common ..
 214       LOGICAL            LERR, OK
 215       CHARACTER*32       SRNAMT
 216       INTEGER            INFOT, IOUNIT
 217 *     ..
 218 *     .. Common blocks ..
 219       COMMON             / INFOC / INFOT, IOUNIT, OK, LERR
 220       COMMON             / SRNAMC / SRNAMT
 221 *     ..
 222 *     .. Intrinsic Functions ..
 223       INTRINSIC          MAX
 224 *     ..
 225 *     .. Data statements ..
 226       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
 227       DATA               UPLOS / 'U', 'L' / , TRANSS / 'N', 'T', 'C' /
 228 *     ..
 229 *     .. Executable Statements ..
 230 *
 231 *     Initialize constants and the random number seed.
 232 *
 233       PATH( 1: 1 ) = 'Double precision'
 234       PATH( 2: 3 ) = 'TP'
 235       NRUN = 0
 236       NFAIL = 0
 237       NERRS = 0
 238       DO 10 I = 1, 4
 239          ISEED( I ) = ISEEDY( I )
 240    10 CONTINUE
 241 *
 242 *     Test the error exits
 243 *
 244       IF( TSTERR )
 245      $   CALL DERRTR( PATH, NOUT )
 246       INFOT = 0
 247 *
 248       DO 110 IN = 1, NN
 249 *
 250 *        Do for each value of N in NVAL
 251 *
 252          N = NVAL( IN )
 253          LDA = MAX( 1, N )
 254          LAP = LDA*( LDA+1 ) / 2
 255          XTYPE = 'N'
 256 *
 257          DO 70 IMAT = 1, NTYPE1
 258 *
 259 *           Do the tests only if DOTYPE( IMAT ) is true.
 260 *
 261             IF( .NOT.DOTYPE( IMAT ) )
 262      $         GO TO 70
 263 *
 264             DO 60 IUPLO = 1, 2
 265 *
 266 *              Do first for UPLO = 'U', then for UPLO = 'L'
 267 *
 268                UPLO = UPLOS( IUPLO )
 269 *
 270 *              Call DLATTP to generate a triangular test matrix.
 271 *
 272                SRNAMT = 'DLATTP'
 273                CALL DLATTP( IMAT, UPLO, 'No transpose', DIAG, ISEED, N,
 274      $                      AP, X, WORK, INFO )
 275 *
 276 *              Set IDIAG = 1 for non-unit matrices, 2 for unit.
 277 *
 278                IF( LSAME( DIAG, 'N' ) ) THEN
 279                   IDIAG = 1
 280                ELSE
 281                   IDIAG = 2
 282                END IF
 283 *
 284 *+    TEST 1
 285 *              Form the inverse of A.
 286 *
 287                IF( N.GT.0 )
 288      $            CALL DCOPY( LAP, AP, 1, AINVP, 1 )
 289                SRNAMT = 'DTPTRI'
 290                CALL DTPTRI( UPLO, DIAG, N, AINVP, INFO )
 291 *
 292 *              Check error code from DTPTRI.
 293 *
 294                IF( INFO.NE.0 )
 295      $            CALL ALAERH( PATH, 'DTPTRI', INFO, 0, UPLO // DIAG, N,
 296      $                         N, -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
 297 *
 298 *              Compute the infinity-norm condition number of A.
 299 *
 300                ANORM = DLANTP( 'I', UPLO, DIAG, N, AP, RWORK )
 301                AINVNM = DLANTP( 'I', UPLO, DIAG, N, AINVP, RWORK )
 302                IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
 303                   RCONDI = ONE
 304                ELSE
 305                   RCONDI = ( ONE / ANORM ) / AINVNM
 306                END IF
 307 *
 308 *              Compute the residual for the triangular matrix times its
 309 *              inverse.  Also compute the 1-norm condition number of A.
 310 *
 311                CALL DTPT01( UPLO, DIAG, N, AP, AINVP, RCONDO, RWORK,
 312      $                      RESULT( 1 ) )
 313 *
 314 *              Print the test ratio if it is .GE. THRESH.
 315 *
 316                IF( RESULT( 1 ).GE.THRESH ) THEN
 317                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 318      $               CALL ALAHD( NOUT, PATH )
 319                   WRITE( NOUT, FMT = 9999 )UPLO, DIAG, N, IMAT, 1,
 320      $               RESULT( 1 )
 321                   NFAIL = NFAIL + 1
 322                END IF
 323                NRUN = NRUN + 1
 324 *
 325                DO 40 IRHS = 1, NNS
 326                   NRHS = NSVAL( IRHS )
 327                   XTYPE = 'N'
 328 *
 329                   DO 30 ITRAN = 1, NTRAN
 330 *
 331 *                 Do for op(A) = A, A**T, or A**H.
 332 *
 333                      TRANS = TRANSS( ITRAN )
 334                      IF( ITRAN.EQ.1 ) THEN
 335                         NORM = 'O'
 336                         RCONDC = RCONDO
 337                      ELSE
 338                         NORM = 'I'
 339                         RCONDC = RCONDI
 340                      END IF
 341 *
 342 *+    TEST 2
 343 *                 Solve and compute residual for op(A)*x = b.
 344 *
 345                      SRNAMT = 'DLARHS'
 346                      CALL DLARHS( PATH, XTYPE, UPLO, TRANS, N, N, 0,
 347      $                            IDIAG, NRHS, AP, LAP, XACT, LDA, B,
 348      $                            LDA, ISEED, INFO )
 349                      XTYPE = 'C'
 350                      CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 351 *
 352                      SRNAMT = 'DTPTRS'
 353                      CALL DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, X,
 354      $                            LDA, INFO )
 355 *
 356 *                 Check error code from DTPTRS.
 357 *
 358                      IF( INFO.NE.0 )
 359      $                  CALL ALAERH( PATH, 'DTPTRS', INFO, 0,
 360      $                               UPLO // TRANS // DIAG, N, N, -1,
 361      $                               -1, -1, IMAT, NFAIL, NERRS, NOUT )
 362 *
 363                      CALL DTPT02( UPLO, TRANS, DIAG, N, NRHS, AP, X,
 364      $                            LDA, B, LDA, WORK, RESULT( 2 ) )
 365 *
 366 *+    TEST 3
 367 *                 Check solution from generated exact solution.
 368 *
 369                      CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 370      $                            RESULT( 3 ) )
 371 *
 372 *+    TESTS 4, 5, and 6
 373 *                 Use iterative refinement to improve the solution and
 374 *                 compute error bounds.
 375 *
 376                      SRNAMT = 'DTPRFS'
 377                      CALL DTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B,
 378      $                            LDA, X, LDA, RWORK, RWORK( NRHS+1 ),
 379      $                            WORK, IWORK, INFO )
 380 *
 381 *                 Check error code from DTPRFS.
 382 *
 383                      IF( INFO.NE.0 )
 384      $                  CALL ALAERH( PATH, 'DTPRFS', INFO, 0,
 385      $                               UPLO // TRANS // DIAG, N, N, -1,
 386      $                               -1, NRHS, IMAT, NFAIL, NERRS,
 387      $                               NOUT )
 388 *
 389                      CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 390      $                            RESULT( 4 ) )
 391                      CALL DTPT05( UPLO, TRANS, DIAG, N, NRHS, AP, B,
 392      $                            LDA, X, LDA, XACT, LDA, RWORK,
 393      $                            RWORK( NRHS+1 ), RESULT( 5 ) )
 394 *
 395 *                    Print information about the tests that did not pass
 396 *                    the threshold.
 397 *
 398                      DO 20 K = 2, 6
 399                         IF( RESULT( K ).GE.THRESH ) THEN
 400                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 401      $                        CALL ALAHD( NOUT, PATH )
 402                            WRITE( NOUT, FMT = 9998 )UPLO, TRANS, DIAG,
 403      $                        N, NRHS, IMAT, K, RESULT( K )
 404                            NFAIL = NFAIL + 1
 405                         END IF
 406    20                CONTINUE
 407                      NRUN = NRUN + 5
 408    30             CONTINUE
 409    40          CONTINUE
 410 *
 411 *+    TEST 7
 412 *                 Get an estimate of RCOND = 1/CNDNUM.
 413 *
 414                DO 50 ITRAN = 1, 2
 415                   IF( ITRAN.EQ.1 ) THEN
 416                      NORM = 'O'
 417                      RCONDC = RCONDO
 418                   ELSE
 419                      NORM = 'I'
 420                      RCONDC = RCONDI
 421                   END IF
 422 *
 423                   SRNAMT = 'DTPCON'
 424                   CALL DTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK,
 425      $                         IWORK, INFO )
 426 *
 427 *                 Check error code from DTPCON.
 428 *
 429                   IF( INFO.NE.0 )
 430      $               CALL ALAERH( PATH, 'DTPCON', INFO, 0,
 431      $                            NORM // UPLO // DIAG, N, N, -1, -1,
 432      $                            -1, IMAT, NFAIL, NERRS, NOUT )
 433 *
 434                   CALL DTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK,
 435      $                         RESULT( 7 ) )
 436 *
 437 *                 Print the test ratio if it is .GE. THRESH.
 438 *
 439                   IF( RESULT( 7 ).GE.THRESH ) THEN
 440                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 441      $                  CALL ALAHD( NOUT, PATH )
 442                      WRITE( NOUT, FMT = 9997 ) 'DTPCON', NORM, UPLO,
 443      $                  DIAG, N, IMAT, 7, RESULT( 7 )
 444                      NFAIL = NFAIL + 1
 445                   END IF
 446                   NRUN = NRUN + 1
 447    50          CONTINUE
 448    60       CONTINUE
 449    70    CONTINUE
 450 *
 451 *        Use pathological test matrices to test DLATPS.
 452 *
 453          DO 100 IMAT = NTYPE1 + 1, NTYPES
 454 *
 455 *           Do the tests only if DOTYPE( IMAT ) is true.
 456 *
 457             IF( .NOT.DOTYPE( IMAT ) )
 458      $         GO TO 100
 459 *
 460             DO 90 IUPLO = 1, 2
 461 *
 462 *              Do first for UPLO = 'U', then for UPLO = 'L'
 463 *
 464                UPLO = UPLOS( IUPLO )
 465                DO 80 ITRAN = 1, NTRAN
 466 *
 467 *                 Do for op(A) = A, A**T, or A**H.
 468 *
 469                   TRANS = TRANSS( ITRAN )
 470 *
 471 *                 Call DLATTP to generate a triangular test matrix.
 472 *
 473                   SRNAMT = 'DLATTP'
 474                   CALL DLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, X,
 475      $                         WORK, INFO )
 476 *
 477 *+    TEST 8
 478 *                 Solve the system op(A)*x = b.
 479 *
 480                   SRNAMT = 'DLATPS'
 481                   CALL DCOPY( N, X, 1, B, 1 )
 482                   CALL DLATPS( UPLO, TRANS, DIAG, 'N', N, AP, B, SCALE,
 483      $                         RWORK, INFO )
 484 *
 485 *                 Check error code from DLATPS.
 486 *
 487                   IF( INFO.NE.0 )
 488      $               CALL ALAERH( PATH, 'DLATPS', INFO, 0,
 489      $                            UPLO // TRANS // DIAG // 'N', N, N,
 490      $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
 491 *
 492                   CALL DTPT03( UPLO, TRANS, DIAG, N, 1, AP, SCALE,
 493      $                         RWORK, ONE, B, LDA, X, LDA, WORK,
 494      $                         RESULT( 8 ) )
 495 *
 496 *+    TEST 9
 497 *                 Solve op(A)*x = b again with NORMIN = 'Y'.
 498 *
 499                   CALL DCOPY( N, X, 1, B( N+1 ), 1 )
 500                   CALL DLATPS( UPLO, TRANS, DIAG, 'Y', N, AP, B( N+1 ),
 501      $                         SCALE, RWORK, INFO )
 502 *
 503 *                 Check error code from DLATPS.
 504 *
 505                   IF( INFO.NE.0 )
 506      $               CALL ALAERH( PATH, 'DLATPS', INFO, 0,
 507      $                            UPLO // TRANS // DIAG // 'Y', N, N,
 508      $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
 509 *
 510                   CALL DTPT03( UPLO, TRANS, DIAG, N, 1, AP, SCALE,
 511      $                         RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
 512      $                         RESULT( 9 ) )
 513 *
 514 *                 Print information about the tests that did not pass
 515 *                 the threshold.
 516 *
 517                   IF( RESULT( 8 ).GE.THRESH ) THEN
 518                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 519      $                  CALL ALAHD( NOUT, PATH )
 520                      WRITE( NOUT, FMT = 9996 )'DLATPS', UPLO, TRANS,
 521      $                  DIAG, 'N', N, IMAT, 8, RESULT( 8 )
 522                      NFAIL = NFAIL + 1
 523                   END IF
 524                   IF( RESULT( 9 ).GE.THRESH ) THEN
 525                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 526      $                  CALL ALAHD( NOUT, PATH )
 527                      WRITE( NOUT, FMT = 9996 )'DLATPS', UPLO, TRANS,
 528      $                  DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
 529                      NFAIL = NFAIL + 1
 530                   END IF
 531                   NRUN = NRUN + 2
 532    80          CONTINUE
 533    90       CONTINUE
 534   100    CONTINUE
 535   110 CONTINUE
 536 *
 537 *     Print a summary of the results.
 538 *
 539       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
 540 *
 541  9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5,
 542      $      ', type ', I2, ', test(', I2, ')= ', G12.5 )
 543  9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1,
 544      $      ''', N=', I5, ''', NRHS=', I5, ', type ', I2, ', test(',
 545      $      I2, ')= ', G12.5 )
 546  9997 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''',',
 547      $      I5, ', ... ), type ', I2, ', test(', I2, ')=', G12.5 )
 548  9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''',
 549      $      A1, ''',', I5, ', ... ), type ', I2, ', test(', I2, ')=',
 550      $      G12.5 )
 551       RETURN
 552 *
 553 *     End of DCHKTP
 554 *
 555       END