TESTING/LIN/zchkgt.f

   1 *> \brief \b ZCHKGT
   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 ZCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  12 *                          A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       LOGICAL            TSTERR
  16 *       INTEGER            NN, NNS, NOUT
  17 *       DOUBLE PRECISION   THRESH
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       LOGICAL            DOTYPE( * )
  21 *       INTEGER            IWORK( * ), NSVAL( * ), NVAL( * )
  22 *       DOUBLE PRECISION   RWORK( * )
  23 *       COMPLEX*16         A( * ), AF( * ), B( * ), WORK( * ), X( * ),
  24 *      $                   XACT( * )
  25 *       ..
  26 *
  27 *
  28 *> \par Purpose:
  29 *  =============
  30 *>
  31 *> \verbatim
  32 *>
  33 *> ZCHKGT tests ZGTTRF, -TRS, -RFS, and -CON
  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 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[out] A
  86 *> \verbatim
  87 *>          A is COMPLEX*16 array, dimension (NMAX*4)
  88 *> \endverbatim
  89 *>
  90 *> \param[out] AF
  91 *> \verbatim
  92 *>          AF is COMPLEX*16 array, dimension (NMAX*4)
  93 *> \endverbatim
  94 *>
  95 *> \param[out] B
  96 *> \verbatim
  97 *>          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
  98 *>          where NSMAX is the largest entry in NSVAL.
  99 *> \endverbatim
 100 *>
 101 *> \param[out] X
 102 *> \verbatim
 103 *>          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
 104 *> \endverbatim
 105 *>
 106 *> \param[out] XACT
 107 *> \verbatim
 108 *>          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
 109 *> \endverbatim
 110 *>
 111 *> \param[out] WORK
 112 *> \verbatim
 113 *>          WORK is COMPLEX*16 array, dimension
 114 *>                      (NMAX*max(3,NSMAX))
 115 *> \endverbatim
 116 *>
 117 *> \param[out] RWORK
 118 *> \verbatim
 119 *>          RWORK is DOUBLE PRECISION array, dimension
 120 *>                      (max(NMAX)+2*NSMAX)
 121 *> \endverbatim
 122 *>
 123 *> \param[out] IWORK
 124 *> \verbatim
 125 *>          IWORK is INTEGER array, dimension (NMAX)
 126 *> \endverbatim
 127 *>
 128 *> \param[in] NOUT
 129 *> \verbatim
 130 *>          NOUT is INTEGER
 131 *>          The unit number for output.
 132 *> \endverbatim
 133 *
 134 *  Authors:
 135 *  ========
 136 *
 137 *> \author Univ. of Tennessee
 138 *> \author Univ. of California Berkeley
 139 *> \author Univ. of Colorado Denver
 140 *> \author NAG Ltd.
 141 *
 142 *> \date November 2011
 143 *
 144 *> \ingroup complex16_lin
 145 *
 146 *  =====================================================================
 147       SUBROUTINE ZCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
 148      $                   A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
 149 *
 150 *  -- LAPACK test routine (version 3.4.0) --
 151 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 152 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 153 *     November 2011
 154 *
 155 *     .. Scalar Arguments ..
 156       LOGICAL            TSTERR
 157       INTEGER            NN, NNS, NOUT
 158       DOUBLE PRECISION   THRESH
 159 *     ..
 160 *     .. Array Arguments ..
 161       LOGICAL            DOTYPE( * )
 162       INTEGER            IWORK( * ), NSVAL( * ), NVAL( * )
 163       DOUBLE PRECISION   RWORK( * )
 164       COMPLEX*16         A( * ), AF( * ), B( * ), WORK( * ), X( * ),
 165      $                   XACT( * )
 166 *     ..
 167 *
 168 *  =====================================================================
 169 *
 170 *     .. Parameters ..
 171       DOUBLE PRECISION   ONE, ZERO
 172       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 173       INTEGER            NTYPES
 174       PARAMETER          ( NTYPES = 12 )
 175       INTEGER            NTESTS
 176       PARAMETER          ( NTESTS = 7 )
 177 *     ..
 178 *     .. Local Scalars ..
 179       LOGICAL            TRFCON, ZEROT
 180       CHARACTER          DIST, NORM, TRANS, TYPE
 181       CHARACTER*3        PATH
 182       INTEGER            I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J,
 183      $                   K, KL, KOFF, KU, LDA, M, MODE, N, NERRS, NFAIL,
 184      $                   NIMAT, NRHS, NRUN
 185       DOUBLE PRECISION   AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
 186      $                   RCONDO
 187 *     ..
 188 *     .. Local Arrays ..
 189       CHARACTER          TRANSS( 3 )
 190       INTEGER            ISEED( 4 ), ISEEDY( 4 )
 191       DOUBLE PRECISION   RESULT( NTESTS )
 192       COMPLEX*16         Z( 3 )
 193 *     ..
 194 *     .. External Functions ..
 195       DOUBLE PRECISION   DGET06, DZASUM, ZLANGT
 196       EXTERNAL           DGET06, DZASUM, ZLANGT
 197 *     ..
 198 *     .. External Subroutines ..
 199       EXTERNAL           ALAERH, ALAHD, ALASUM, ZCOPY, ZDSCAL, ZERRGE,
 200      $                   ZGET04, ZGTCON, ZGTRFS, ZGTT01, ZGTT02, ZGTT05,
 201      $                   ZGTTRF, ZGTTRS, ZLACPY, ZLAGTM, ZLARNV, ZLATB4,
 202      $                   ZLATMS
 203 *     ..
 204 *     .. Intrinsic Functions ..
 205       INTRINSIC          MAX
 206 *     ..
 207 *     .. Scalars in Common ..
 208       LOGICAL            LERR, OK
 209       CHARACTER*32       SRNAMT
 210       INTEGER            INFOT, NUNIT
 211 *     ..
 212 *     .. Common blocks ..
 213       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
 214       COMMON             / SRNAMC / SRNAMT
 215 *     ..
 216 *     .. Data statements ..
 217       DATA               ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T',
 218      $                   'C' /
 219 *     ..
 220 *     .. Executable Statements ..
 221 *
 222       PATH( 1: 1 ) = 'Zomplex precision'
 223       PATH( 2: 3 ) = 'GT'
 224       NRUN = 0
 225       NFAIL = 0
 226       NERRS = 0
 227       DO 10 I = 1, 4
 228          ISEED( I ) = ISEEDY( I )
 229    10 CONTINUE
 230 *
 231 *     Test the error exits
 232 *
 233       IF( TSTERR )
 234      $   CALL ZERRGE( PATH, NOUT )
 235       INFOT = 0
 236 *
 237       DO 110 IN = 1, NN
 238 *
 239 *        Do for each value of N in NVAL.
 240 *
 241          N = NVAL( IN )
 242          M = MAX( N-1, 0 )
 243          LDA = MAX( 1, N )
 244          NIMAT = NTYPES
 245          IF( N.LE.0 )
 246      $      NIMAT = 1
 247 *
 248          DO 100 IMAT = 1, NIMAT
 249 *
 250 *           Do the tests only if DOTYPE( IMAT ) is true.
 251 *
 252             IF( .NOT.DOTYPE( IMAT ) )
 253      $         GO TO 100
 254 *
 255 *           Set up parameters with ZLATB4.
 256 *
 257             CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
 258      $                   COND, DIST )
 259 *
 260             ZEROT = IMAT.GE.8 .AND. IMAT.LE.10
 261             IF( IMAT.LE.6 ) THEN
 262 *
 263 *              Types 1-6:  generate matrices of known condition number.
 264 *
 265                KOFF = MAX( 2-KU, 3-MAX( 1, N ) )
 266                SRNAMT = 'ZLATMS'
 267                CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND,
 268      $                      ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
 269      $                      INFO )
 270 *
 271 *              Check the error code from ZLATMS.
 272 *
 273                IF( INFO.NE.0 ) THEN
 274                   CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, KL,
 275      $                         KU, -1, IMAT, NFAIL, NERRS, NOUT )
 276                   GO TO 100
 277                END IF
 278                IZERO = 0
 279 *
 280                IF( N.GT.1 ) THEN
 281                   CALL ZCOPY( N-1, AF( 4 ), 3, A, 1 )
 282                   CALL ZCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 )
 283                END IF
 284                CALL ZCOPY( N, AF( 2 ), 3, A( M+1 ), 1 )
 285             ELSE
 286 *
 287 *              Types 7-12:  generate tridiagonal matrices with
 288 *              unknown condition numbers.
 289 *
 290                IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN
 291 *
 292 *                 Generate a matrix with elements whose real and
 293 *                 imaginary parts are from [-1,1].
 294 *
 295                   CALL ZLARNV( 2, ISEED, N+2*M, A )
 296                   IF( ANORM.NE.ONE )
 297      $               CALL ZDSCAL( N+2*M, ANORM, A, 1 )
 298                ELSE IF( IZERO.GT.0 ) THEN
 299 *
 300 *                 Reuse the last matrix by copying back the zeroed out
 301 *                 elements.
 302 *
 303                   IF( IZERO.EQ.1 ) THEN
 304                      A( N ) = Z( 2 )
 305                      IF( N.GT.1 )
 306      $                  A( 1 ) = Z( 3 )
 307                   ELSE IF( IZERO.EQ.N ) THEN
 308                      A( 3*N-2 ) = Z( 1 )
 309                      A( 2*N-1 ) = Z( 2 )
 310                   ELSE
 311                      A( 2*N-2+IZERO ) = Z( 1 )
 312                      A( N-1+IZERO ) = Z( 2 )
 313                      A( IZERO ) = Z( 3 )
 314                   END IF
 315                END IF
 316 *
 317 *              If IMAT > 7, set one column of the matrix to 0.
 318 *
 319                IF( .NOT.ZEROT ) THEN
 320                   IZERO = 0
 321                ELSE IF( IMAT.EQ.8 ) THEN
 322                   IZERO = 1
 323                   Z( 2 ) = A( N )
 324                   A( N ) = ZERO
 325                   IF( N.GT.1 ) THEN
 326                      Z( 3 ) = A( 1 )
 327                      A( 1 ) = ZERO
 328                   END IF
 329                ELSE IF( IMAT.EQ.9 ) THEN
 330                   IZERO = N
 331                   Z( 1 ) = A( 3*N-2 )
 332                   Z( 2 ) = A( 2*N-1 )
 333                   A( 3*N-2 ) = ZERO
 334                   A( 2*N-1 ) = ZERO
 335                ELSE
 336                   IZERO = ( N+1 ) / 2
 337                   DO 20 I = IZERO, N - 1
 338                      A( 2*N-2+I ) = ZERO
 339                      A( N-1+I ) = ZERO
 340                      A( I ) = ZERO
 341    20             CONTINUE
 342                   A( 3*N-2 ) = ZERO
 343                   A( 2*N-1 ) = ZERO
 344                END IF
 345             END IF
 346 *
 347 *+    TEST 1
 348 *           Factor A as L*U and compute the ratio
 349 *              norm(L*U - A) / (n * norm(A) * EPS )
 350 *
 351             CALL ZCOPY( N+2*M, A, 1, AF, 1 )
 352             SRNAMT = 'ZGTTRF'
 353             CALL ZGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
 354      $                   IWORK, INFO )
 355 *
 356 *           Check error code from ZGTTRF.
 357 *
 358             IF( INFO.NE.IZERO )
 359      $         CALL ALAERH( PATH, 'ZGTTRF', INFO, IZERO, ' ', N, N, 1,
 360      $                      1, -1, IMAT, NFAIL, NERRS, NOUT )
 361             TRFCON = INFO.NE.0
 362 *
 363             CALL ZGTT01( N, A, A( M+1 ), A( N+M+1 ), AF, AF( M+1 ),
 364      $                   AF( N+M+1 ), AF( N+2*M+1 ), IWORK, WORK, LDA,
 365      $                   RWORK, RESULT( 1 ) )
 366 *
 367 *           Print the test ratio if it is .GE. THRESH.
 368 *
 369             IF( RESULT( 1 ).GE.THRESH ) THEN
 370                IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 371      $            CALL ALAHD( NOUT, PATH )
 372                WRITE( NOUT, FMT = 9999 )N, IMAT, 1, RESULT( 1 )
 373                NFAIL = NFAIL + 1
 374             END IF
 375             NRUN = NRUN + 1
 376 *
 377             DO 50 ITRAN = 1, 2
 378                TRANS = TRANSS( ITRAN )
 379                IF( ITRAN.EQ.1 ) THEN
 380                   NORM = 'O'
 381                ELSE
 382                   NORM = 'I'
 383                END IF
 384                ANORM = ZLANGT( NORM, N, A, A( M+1 ), A( N+M+1 ) )
 385 *
 386                IF( .NOT.TRFCON ) THEN
 387 *
 388 *                 Use ZGTTRS 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 40 I = 1, N
 393                      DO 30 J = 1, N
 394                         X( J ) = ZERO
 395    30                CONTINUE
 396                      X( I ) = ONE
 397                      CALL ZGTTRS( TRANS, 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, DZASUM( N, X, 1 ) )
 401    40             CONTINUE
 402 *
 403 *                 Compute RCONDC = 1 / (norm(A) * norm(inv(A))
 404 *
 405                   IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
 406                      RCONDC = ONE
 407                   ELSE
 408                      RCONDC = ( ONE / ANORM ) / AINVNM
 409                   END IF
 410                   IF( ITRAN.EQ.1 ) THEN
 411                      RCONDO = RCONDC
 412                   ELSE
 413                      RCONDI = RCONDC
 414                   END IF
 415                ELSE
 416                   RCONDC = ZERO
 417                END IF
 418 *
 419 *+    TEST 7
 420 *              Estimate the reciprocal of the condition number of the
 421 *              matrix.
 422 *
 423                SRNAMT = 'ZGTCON'
 424                CALL ZGTCON( NORM, N, AF, AF( M+1 ), AF( N+M+1 ),
 425      $                      AF( N+2*M+1 ), IWORK, ANORM, RCOND, WORK,
 426      $                      INFO )
 427 *
 428 *              Check error code from ZGTCON.
 429 *
 430                IF( INFO.NE.0 )
 431      $            CALL ALAERH( PATH, 'ZGTCON', INFO, 0, NORM, N, N, -1,
 432      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
 433 *
 434                RESULT( 7 ) = DGET06( RCOND, RCONDC )
 435 *
 436 *              Print the test ratio if it is .GE. THRESH.
 437 *
 438                IF( RESULT( 7 ).GE.THRESH ) THEN
 439                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 440      $               CALL ALAHD( NOUT, PATH )
 441                   WRITE( NOUT, FMT = 9997 )NORM, N, IMAT, 7,
 442      $               RESULT( 7 )
 443                   NFAIL = NFAIL + 1
 444                END IF
 445                NRUN = NRUN + 1
 446    50       CONTINUE
 447 *
 448 *           Skip the remaining tests if the matrix is singular.
 449 *
 450             IF( TRFCON )
 451      $         GO TO 100
 452 *
 453             DO 90 IRHS = 1, NNS
 454                NRHS = NSVAL( IRHS )
 455 *
 456 *              Generate NRHS random solution vectors.
 457 *
 458                IX = 1
 459                DO 60 J = 1, NRHS
 460                   CALL ZLARNV( 2, ISEED, N, XACT( IX ) )
 461                   IX = IX + LDA
 462    60          CONTINUE
 463 *
 464                DO 80 ITRAN = 1, 3
 465                   TRANS = TRANSS( ITRAN )
 466                   IF( ITRAN.EQ.1 ) THEN
 467                      RCONDC = RCONDO
 468                   ELSE
 469                      RCONDC = RCONDI
 470                   END IF
 471 *
 472 *                 Set the right hand side.
 473 *
 474                   CALL ZLAGTM( TRANS, N, NRHS, ONE, A, A( M+1 ),
 475      $                         A( N+M+1 ), XACT, LDA, ZERO, B, LDA )
 476 *
 477 *+    TEST 2
 478 *              Solve op(A) * X = B and compute the residual.
 479 *
 480                   CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 481                   SRNAMT = 'ZGTTRS'
 482                   CALL ZGTTRS( TRANS, N, NRHS, AF, AF( M+1 ),
 483      $                         AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
 484      $                         LDA, INFO )
 485 *
 486 *              Check error code from ZGTTRS.
 487 *
 488                   IF( INFO.NE.0 )
 489      $               CALL ALAERH( PATH, 'ZGTTRS', INFO, 0, TRANS, N, N,
 490      $                            -1, -1, NRHS, IMAT, NFAIL, NERRS,
 491      $                            NOUT )
 492 *
 493                   CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
 494                   CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
 495      $                         X, LDA, WORK, LDA, RESULT( 2 ) )
 496 *
 497 *+    TEST 3
 498 *              Check solution from generated exact solution.
 499 *
 500                   CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 501      $                         RESULT( 3 ) )
 502 *
 503 *+    TESTS 4, 5, and 6
 504 *              Use iterative refinement to improve the solution.
 505 *
 506                   SRNAMT = 'ZGTRFS'
 507                   CALL ZGTRFS( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
 508      $                         AF, AF( M+1 ), AF( N+M+1 ),
 509      $                         AF( N+2*M+1 ), IWORK, B, LDA, X, LDA,
 510      $                         RWORK, RWORK( NRHS+1 ), WORK,
 511      $                         RWORK( 2*NRHS+1 ), INFO )
 512 *
 513 *              Check error code from ZGTRFS.
 514 *
 515                   IF( INFO.NE.0 )
 516      $               CALL ALAERH( PATH, 'ZGTRFS', INFO, 0, TRANS, N, N,
 517      $                            -1, -1, NRHS, IMAT, NFAIL, NERRS,
 518      $                            NOUT )
 519 *
 520                   CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
 521      $                         RESULT( 4 ) )
 522                   CALL ZGTT05( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
 523      $                         B, LDA, X, LDA, XACT, LDA, RWORK,
 524      $                         RWORK( NRHS+1 ), RESULT( 5 ) )
 525 *
 526 *              Print information about the tests that did not pass the
 527 *              threshold.
 528 *
 529                   DO 70 K = 2, 6
 530                      IF( RESULT( K ).GE.THRESH ) THEN
 531                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 532      $                     CALL ALAHD( NOUT, PATH )
 533                         WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS, IMAT,
 534      $                     K, RESULT( K )
 535                         NFAIL = NFAIL + 1
 536                      END IF
 537    70             CONTINUE
 538                   NRUN = NRUN + 5
 539    80          CONTINUE
 540    90       CONTINUE
 541   100    CONTINUE
 542   110 CONTINUE
 543 *
 544 *     Print a summary of the results.
 545 *
 546       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
 547 *
 548  9999 FORMAT( 12X, 'N =', I5, ',', 10X, ' type ', I2, ', test(', I2,
 549      $      ') = ', G12.5 )
 550  9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
 551      $      I2, ', test(', I2, ') = ', G12.5 )
 552  9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
 553      $      ', test(', I2, ') = ', G12.5 )
 554       RETURN
 555 *
 556 *     End of ZCHKGT
 557 *
 558       END