TESTING/LIN/sdrvgt.f

   1 *> \brief \b SDRVGT
   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 SDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF,
  12 *                          B, X, XACT, WORK, RWORK, IWORK, NOUT )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       LOGICAL            TSTERR
  16 *       INTEGER            NN, NOUT, NRHS
  17 *       REAL               THRESH
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       LOGICAL            DOTYPE( * )
  21 *       INTEGER            IWORK( * ), NVAL( * )
  22 *       REAL               A( * ), AF( * ), B( * ), RWORK( * ), WORK( * ),
  23 *      $                   X( * ), XACT( * )
  24 *       ..
  25 *
  26 *
  27 *> \par Purpose:
  28 *  =============
  29 *>
  30 *> \verbatim
  31 *>
  32 *> SDRVGT tests SGTSV and -SVX.
  33 *> \endverbatim
  34 *
  35 *  Arguments:
  36 *  ==========
  37 *
  38 *> \param[in] DOTYPE
  39 *> \verbatim
  40 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
  41 *>          The matrix types to be used for testing.  Matrices of type j
  42 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  43 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  44 *> \endverbatim
  45 *>
  46 *> \param[in] NN
  47 *> \verbatim
  48 *>          NN is INTEGER
  49 *>          The number of values of N contained in the vector NVAL.
  50 *> \endverbatim
  51 *>
  52 *> \param[in] NVAL
  53 *> \verbatim
  54 *>          NVAL is INTEGER array, dimension (NN)
  55 *>          The values of the matrix dimension N.
  56 *> \endverbatim
  57 *>
  58 *> \param[in] NRHS
  59 *> \verbatim
  60 *>          NRHS is INTEGER
  61 *>          The number of right hand sides, NRHS >= 0.
  62 *> \endverbatim
  63 *>
  64 *> \param[in] THRESH
  65 *> \verbatim
  66 *>          THRESH is REAL
  67 *>          The threshold value for the test ratios.  A result is
  68 *>          included in the output file if RESULT >= THRESH.  To have
  69 *>          every test ratio printed, use THRESH = 0.
  70 *> \endverbatim
  71 *>
  72 *> \param[in] TSTERR
  73 *> \verbatim
  74 *>          TSTERR is LOGICAL
  75 *>          Flag that indicates whether error exits are to be tested.
  76 *> \endverbatim
  77 *>
  78 *> \param[out] A
  79 *> \verbatim
  80 *>          A is REAL array, dimension (NMAX*4)
  81 *> \endverbatim
  82 *>
  83 *> \param[out] AF
  84 *> \verbatim
  85 *>          AF is REAL array, dimension (NMAX*4)
  86 *> \endverbatim
  87 *>
  88 *> \param[out] B
  89 *> \verbatim
  90 *>          B is REAL array, dimension (NMAX*NRHS)
  91 *> \endverbatim
  92 *>
  93 *> \param[out] X
  94 *> \verbatim
  95 *>          X is REAL array, dimension (NMAX*NRHS)
  96 *> \endverbatim
  97 *>
  98 *> \param[out] XACT
  99 *> \verbatim
 100 *>          XACT is REAL array, dimension (NMAX*NRHS)
 101 *> \endverbatim
 102 *>
 103 *> \param[out] WORK
 104 *> \verbatim
 105 *>          WORK is REAL array, dimension
 106 *>                      (NMAX*max(3,NRHS))
 107 *> \endverbatim
 108 *>
 109 *> \param[out] RWORK
 110 *> \verbatim
 111 *>          RWORK is REAL array, dimension
 112 *>                      (max(NMAX,2*NRHS))
 113 *> \endverbatim
 114 *>
 115 *> \param[out] IWORK
 116 *> \verbatim
 117 *>          IWORK is INTEGER array, dimension (2*NMAX)
 118 *> \endverbatim
 119 *>
 120 *> \param[in] NOUT
 121 *> \verbatim
 122 *>          NOUT is INTEGER
 123 *>          The unit number for output.
 124 *> \endverbatim
 125 *
 126 *  Authors:
 127 *  ========
 128 *
 129 *> \author Univ. of Tennessee
 130 *> \author Univ. of California Berkeley
 131 *> \author Univ. of Colorado Denver
 132 *> \author NAG Ltd.
 133 *
 134 *> \date November 2011
 135 *
 136 *> \ingroup single_lin
 137 *
 138 *  =====================================================================
 139       SUBROUTINE SDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF,
 140      $                   B, X, XACT, WORK, RWORK, IWORK, NOUT )
 141 *
 142 *  -- LAPACK test routine (version 3.4.0) --
 143 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 144 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 145 *     November 2011
 146 *
 147 *     .. Scalar Arguments ..
 148       LOGICAL            TSTERR
 149       INTEGER            NN, NOUT, NRHS
 150       REAL               THRESH
 151 *     ..
 152 *     .. Array Arguments ..
 153       LOGICAL            DOTYPE( * )
 154       INTEGER            IWORK( * ), NVAL( * )
 155       REAL               A( * ), AF( * ), B( * ), RWORK( * ), WORK( * ),
 156      $                   X( * ), XACT( * )
 157 *     ..
 158 *
 159 *  =====================================================================
 160 *
 161 *     .. Parameters ..
 162       REAL               ONE, ZERO
 163       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 164       INTEGER            NTYPES
 165       PARAMETER          ( NTYPES = 12 )
 166       INTEGER            NTESTS
 167       PARAMETER          ( NTESTS = 6 )
 168 *     ..
 169 *     .. Local Scalars ..
 170       LOGICAL            TRFCON, ZEROT
 171       CHARACTER          DIST, FACT, TRANS, TYPE
 172       CHARACTER*3        PATH
 173       INTEGER            I, IFACT, IMAT, IN, INFO, ITRAN, IX, IZERO, J,
 174      $                   K, K1, KL, KOFF, KU, LDA, M, MODE, N, NERRS,
 175      $                   NFAIL, NIMAT, NRUN, NT
 176       REAL               AINVNM, ANORM, ANORMI, ANORMO, COND, RCOND,
 177      $                   RCONDC, RCONDI, RCONDO
 178 *     ..
 179 *     .. Local Arrays ..
 180       CHARACTER          TRANSS( 3 )
 181       INTEGER            ISEED( 4 ), ISEEDY( 4 )
 182       REAL               RESULT( NTESTS ), Z( 3 )
 183 *     ..
 184 *     .. External Functions ..
 185       REAL               SASUM, SGET06, SLANGT
 186       EXTERNAL           SASUM, SGET06, SLANGT
 187 *     ..
 188 *     .. External Subroutines ..
 189       EXTERNAL           ALADHD, ALAERH, ALASVM, SCOPY, SERRVX, SGET04,
 190      $                   SGTSV, SGTSVX, SGTT01, SGTT02, SGTT05, SGTTRF,
 191      $                   SGTTRS, SLACPY, SLAGTM, SLARNV, SLASET, SLATB4,
 192      $                   SLATMS, SSCAL
 193 *     ..
 194 *     .. Intrinsic Functions ..
 195       INTRINSIC          MAX
 196 *     ..
 197 *     .. Scalars in Common ..
 198       LOGICAL            LERR, OK
 199       CHARACTER*32       SRNAMT
 200       INTEGER            INFOT, NUNIT
 201 *     ..
 202 *     .. Common blocks ..
 203       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
 204       COMMON             / SRNAMC / SRNAMT
 205 *     ..
 206 *     .. Data statements ..
 207       DATA               ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T',
 208      $                   'C' /
 209 *     ..
 210 *     .. Executable Statements ..
 211 *
 212       PATH( 1: 1 ) = 'Single precision'
 213       PATH( 2: 3 ) = 'GT'
 214       NRUN = 0
 215       NFAIL = 0
 216       NERRS = 0
 217       DO 10 I = 1, 4
 218          ISEED( I ) = ISEEDY( I )
 219    10 CONTINUE
 220 *
 221 *     Test the error exits
 222 *
 223       IF( TSTERR )
 224      $   CALL SERRVX( PATH, NOUT )
 225       INFOT = 0
 226 *
 227       DO 140 IN = 1, NN
 228 *
 229 *        Do for each value of N in NVAL.
 230 *
 231          N = NVAL( IN )
 232          M = MAX( N-1, 0 )
 233          LDA = MAX( 1, N )
 234          NIMAT = NTYPES
 235          IF( N.LE.0 )
 236      $      NIMAT = 1
 237 *
 238          DO 130 IMAT = 1, NIMAT
 239 *
 240 *           Do the tests only if DOTYPE( IMAT ) is true.
 241 *
 242             IF( .NOT.DOTYPE( IMAT ) )
 243      $         GO TO 130
 244 *
 245 *           Set up parameters with SLATB4.
 246 *
 247             CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
 248      $                   COND, DIST )
 249 *
 250             ZEROT = IMAT.GE.8 .AND. IMAT.LE.10
 251             IF( IMAT.LE.6 ) THEN
 252 *
 253 *              Types 1-6:  generate matrices of known condition number.
 254 *
 255                KOFF = MAX( 2-KU, 3-MAX( 1, N ) )
 256                SRNAMT = 'SLATMS'
 257                CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND,
 258      $                      ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
 259      $                      INFO )
 260 *
 261 *              Check the error code from SLATMS.
 262 *
 263                IF( INFO.NE.0 ) THEN
 264                   CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N, KL,
 265      $                         KU, -1, IMAT, NFAIL, NERRS, NOUT )
 266                   GO TO 130
 267                END IF
 268                IZERO = 0
 269 *
 270                IF( N.GT.1 ) THEN
 271                   CALL SCOPY( N-1, AF( 4 ), 3, A, 1 )
 272                   CALL SCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 )
 273                END IF
 274                CALL SCOPY( N, AF( 2 ), 3, A( M+1 ), 1 )
 275             ELSE
 276 *
 277 *              Types 7-12:  generate tridiagonal matrices with
 278 *              unknown condition numbers.
 279 *
 280                IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN
 281 *
 282 *                 Generate a matrix with elements from [-1,1].
 283 *
 284                   CALL SLARNV( 2, ISEED, N+2*M, A )
 285                   IF( ANORM.NE.ONE )
 286      $               CALL SSCAL( N+2*M, ANORM, A, 1 )
 287                ELSE IF( IZERO.GT.0 ) THEN
 288 *
 289 *                 Reuse the last matrix by copying back the zeroed out
 290 *                 elements.
 291 *
 292                   IF( IZERO.EQ.1 ) THEN
 293                      A( N ) = Z( 2 )
 294                      IF( N.GT.1 )
 295      $                  A( 1 ) = Z( 3 )
 296                   ELSE IF( IZERO.EQ.N ) THEN
 297                      A( 3*N-2 ) = Z( 1 )
 298                      A( 2*N-1 ) = Z( 2 )
 299                   ELSE
 300                      A( 2*N-2+IZERO ) = Z( 1 )
 301                      A( N-1+IZERO ) = Z( 2 )
 302                      A( IZERO ) = Z( 3 )
 303                   END IF
 304                END IF
 305 *
 306 *              If IMAT > 7, set one column of the matrix to 0.
 307 *
 308                IF( .NOT.ZEROT ) THEN
 309                   IZERO = 0
 310                ELSE IF( IMAT.EQ.8 ) THEN
 311                   IZERO = 1
 312                   Z( 2 ) = A( N )
 313                   A( N ) = ZERO
 314                   IF( N.GT.1 ) THEN
 315                      Z( 3 ) = A( 1 )
 316                      A( 1 ) = ZERO
 317                   END IF
 318                ELSE IF( IMAT.EQ.9 ) THEN
 319                   IZERO = N
 320                   Z( 1 ) = A( 3*N-2 )
 321                   Z( 2 ) = A( 2*N-1 )
 322                   A( 3*N-2 ) = ZERO
 323                   A( 2*N-1 ) = ZERO
 324                ELSE
 325                   IZERO = ( N+1 ) / 2
 326                   DO 20 I = IZERO, N - 1
 327                      A( 2*N-2+I ) = ZERO
 328                      A( N-1+I ) = ZERO
 329                      A( I ) = ZERO
 330    20             CONTINUE
 331                   A( 3*N-2 ) = ZERO
 332                   A( 2*N-1 ) = ZERO
 333                END IF
 334             END IF
 335 *
 336             DO 120 IFACT = 1, 2
 337                IF( IFACT.EQ.1 ) THEN
 338                   FACT = 'F'
 339                ELSE
 340                   FACT = 'N'
 341                END IF
 342 *
 343 *              Compute the condition number for comparison with
 344 *              the value returned by SGTSVX.
 345 *
 346                IF( ZEROT ) THEN
 347                   IF( IFACT.EQ.1 )
 348      $               GO TO 120
 349                   RCONDO = ZERO
 350                   RCONDI = ZERO
 351 *
 352                ELSE IF( IFACT.EQ.1 ) THEN
 353                   CALL SCOPY( N+2*M, A, 1, AF, 1 )
 354 *
 355 *                 Compute the 1-norm and infinity-norm of A.
 356 *
 357                   ANORMO = SLANGT( '1', N, A, A( M+1 ), A( N+M+1 ) )
 358                   ANORMI = SLANGT( 'I', N, A, A( M+1 ), A( N+M+1 ) )
 359 *
 360 *                 Factor the matrix A.
 361 *
 362                   CALL SGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ),
 363      $                         AF( N+2*M+1 ), IWORK, INFO )
 364 *
 365 *                 Use SGTTRS to solve for one column at a time of
 366 *                 inv(A), computing the maximum column sum as we go.
 367 *
 368                   AINVNM = ZERO
 369                   DO 40 I = 1, N
 370                      DO 30 J = 1, N
 371                         X( J ) = ZERO
 372    30                CONTINUE
 373                      X( I ) = ONE
 374                      CALL SGTTRS( 'No transpose', N, 1, AF, AF( M+1 ),
 375      $                            AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
 376      $                            LDA, INFO )
 377                      AINVNM = MAX( AINVNM, SASUM( N, X, 1 ) )
 378    40             CONTINUE
 379 *
 380 *                 Compute the 1-norm condition number of A.
 381 *
 382                   IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
 383                      RCONDO = ONE
 384                   ELSE
 385                      RCONDO = ( ONE / ANORMO ) / AINVNM
 386                   END IF
 387 *
 388 *                 Use SGTTRS to solve for one column at a time of
 389 *                 inv(A'), computing the maximum column sum as we go.
 390 *
 391                   AINVNM = ZERO
 392                   DO 60 I = 1, N
 393                      DO 50 J = 1, N
 394                         X( J ) = ZERO
 395    50                CONTINUE
 396                      X( I ) = ONE
 397                      CALL SGTTRS( 'Transpose', N, 1, AF, AF( M+1 ),
 398      $                            AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
 399      $                            LDA, INFO )
 400                      AINVNM = MAX( AINVNM, SASUM( N, X, 1 ) )
 401    60             CONTINUE
 402 *
 403 *                 Compute the infinity-norm condition number of A.
 404 *
 405                   IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
 406                      RCONDI = ONE
 407                   ELSE
 408                      RCONDI = ( ONE / ANORMI ) / AINVNM
 409                   END IF
 410                END IF
 411 *
 412                DO 110 ITRAN = 1, 3
 413                   TRANS = TRANSS( ITRAN )
 414                   IF( ITRAN.EQ.1 ) THEN
 415                      RCONDC = RCONDO
 416                   ELSE
 417                      RCONDC = RCONDI
 418                   END IF
 419 *
 420 *                 Generate NRHS random solution vectors.
 421 *
 422                   IX = 1
 423                   DO 70 J = 1, NRHS
 424                      CALL SLARNV( 2, ISEED, N, XACT( IX ) )
 425                      IX = IX + LDA
 426    70             CONTINUE
 427 *
 428 *                 Set the right hand side.
 429 *
 430                   CALL SLAGTM( TRANS, N, NRHS, ONE, A, A( M+1 ),
 431      $                         A( N+M+1 ), XACT, LDA, ZERO, B, LDA )
 432 *
 433                   IF( IFACT.EQ.2 .AND. ITRAN.EQ.1 ) THEN
 434 *
 435 *                    --- Test SGTSV  ---
 436 *
 437 *                    Solve the system using Gaussian elimination with
 438 *                    partial pivoting.
 439 *
 440                      CALL SCOPY( N+2*M, A, 1, AF, 1 )
 441                      CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 442 *
 443                      SRNAMT = 'SGTSV '
 444                      CALL SGTSV( N, NRHS, AF, AF( M+1 ), AF( N+M+1 ), X,
 445      $                           LDA, INFO )
 446 *
 447 *                    Check error code from SGTSV .
 448 *
 449                      IF( INFO.NE.IZERO )
 450      $                  CALL ALAERH( PATH, 'SGTSV ', INFO, IZERO, ' ',
 451      $                               N, N, 1, 1, NRHS, IMAT, NFAIL,
 452      $                               NERRS, NOUT )
 453                      NT = 1
 454                      IF( IZERO.EQ.0 ) THEN
 455 *
 456 *                       Check residual of computed solution.
 457 *
 458                         CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK,
 459      $                               LDA )
 460                         CALL SGTT02( TRANS, N, NRHS, A, A( M+1 ),
 461      $                               A( N+M+1 ), X, LDA, WORK, LDA,
 462      $                               RESULT( 2 ) )
 463 *
 464 *                       Check solution from generated exact solution.
 465 *
 466                         CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 467      $                               RESULT( 3 ) )
 468                         NT = 3
 469                      END IF
 470 *
 471 *                    Print information about the tests that did not pass
 472 *                    the threshold.
 473 *
 474                      DO 80 K = 2, NT
 475                         IF( RESULT( K ).GE.THRESH ) THEN
 476                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 477      $                        CALL ALADHD( NOUT, PATH )
 478                            WRITE( NOUT, FMT = 9999 )'SGTSV ', N, IMAT,
 479      $                        K, RESULT( K )
 480                            NFAIL = NFAIL + 1
 481                         END IF
 482    80                CONTINUE
 483                      NRUN = NRUN + NT - 1
 484                   END IF
 485 *
 486 *                 --- Test SGTSVX ---
 487 *
 488                   IF( IFACT.GT.1 ) THEN
 489 *
 490 *                    Initialize AF to zero.
 491 *
 492                      DO 90 I = 1, 3*N - 2
 493                         AF( I ) = ZERO
 494    90                CONTINUE
 495                   END IF
 496                   CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
 497 *
 498 *                 Solve the system and compute the condition number and
 499 *                 error bounds using SGTSVX.
 500 *
 501                   SRNAMT = 'SGTSVX'
 502                   CALL SGTSVX( FACT, TRANS, N, NRHS, A, A( M+1 ),
 503      $                         A( N+M+1 ), AF, AF( M+1 ), AF( N+M+1 ),
 504      $                         AF( N+2*M+1 ), IWORK, B, LDA, X, LDA,
 505      $                         RCOND, RWORK, RWORK( NRHS+1 ), WORK,
 506      $                         IWORK( N+1 ), INFO )
 507 *
 508 *                 Check the error code from SGTSVX.
 509 *
 510                   IF( INFO.NE.IZERO )
 511      $               CALL ALAERH( PATH, 'SGTSVX', INFO, IZERO,
 512      $                            FACT // TRANS, N, N, 1, 1, NRHS, IMAT,
 513      $                            NFAIL, NERRS, NOUT )
 514 *
 515                   IF( IFACT.GE.2 ) THEN
 516 *
 517 *                    Reconstruct matrix from factors and compute
 518 *                    residual.
 519 *
 520                      CALL SGTT01( N, A, A( M+1 ), A( N+M+1 ), AF,
 521      $                            AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
 522      $                            IWORK, WORK, LDA, RWORK, RESULT( 1 ) )
 523                      K1 = 1
 524                   ELSE
 525                      K1 = 2
 526                   END IF
 527 *
 528                   IF( INFO.EQ.0 ) THEN
 529                      TRFCON = .FALSE.
 530 *
 531 *                    Check residual of computed solution.
 532 *
 533                      CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
 534                      CALL SGTT02( TRANS, N, NRHS, A, A( M+1 ),
 535      $                            A( N+M+1 ), X, LDA, WORK, LDA,
 536      $                            RESULT( 2 ) )
 537 *
 538 *                    Check solution from generated exact solution.
 539 *
 540                      CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 541      $                            RESULT( 3 ) )
 542 *
 543 *                    Check the error bounds from iterative refinement.
 544 *
 545                      CALL SGTT05( TRANS, N, NRHS, A, A( M+1 ),
 546      $                            A( N+M+1 ), B, LDA, X, LDA, XACT, LDA,
 547      $                            RWORK, RWORK( NRHS+1 ), RESULT( 4 ) )
 548                      NT = 5
 549                   END IF
 550 *
 551 *                 Print information about the tests that did not pass
 552 *                 the threshold.
 553 *
 554                   DO 100 K = K1, NT
 555                      IF( RESULT( K ).GE.THRESH ) THEN
 556                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 557      $                     CALL ALADHD( NOUT, PATH )
 558                         WRITE( NOUT, FMT = 9998 )'SGTSVX', FACT, TRANS,
 559      $                     N, IMAT, K, RESULT( K )
 560                         NFAIL = NFAIL + 1
 561                      END IF
 562   100             CONTINUE
 563 *
 564 *                 Check the reciprocal of the condition number.
 565 *
 566                   RESULT( 6 ) = SGET06( RCOND, RCONDC )
 567                   IF( RESULT( 6 ).GE.THRESH ) THEN
 568                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 569      $                  CALL ALADHD( NOUT, PATH )
 570                      WRITE( NOUT, FMT = 9998 )'SGTSVX', FACT, TRANS, N,
 571      $                  IMAT, K, RESULT( K )
 572                      NFAIL = NFAIL + 1
 573                   END IF
 574                   NRUN = NRUN + NT - K1 + 2
 575 *
 576   110          CONTINUE
 577   120       CONTINUE
 578   130    CONTINUE
 579   140 CONTINUE
 580 *
 581 *     Print a summary of the results.
 582 *
 583       CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
 584 *
 585  9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test ', I2,
 586      $      ', ratio = ', G12.5 )
 587  9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N =',
 588      $      I5, ', type ', I2, ', test ', I2, ', ratio = ', G12.5 )
 589       RETURN
 590 *
 591 *     End of SDRVGT
 592 *
 593       END