LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zchkgt.f
Go to the documentation of this file.
00001 *> \brief \b ZCHKGT
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE ZCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00012 *                          A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       LOGICAL            TSTERR
00016 *       INTEGER            NN, NNS, NOUT
00017 *       DOUBLE PRECISION   THRESH
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       LOGICAL            DOTYPE( * )
00021 *       INTEGER            IWORK( * ), NSVAL( * ), NVAL( * )
00022 *       DOUBLE PRECISION   RWORK( * )
00023 *       COMPLEX*16         A( * ), AF( * ), B( * ), WORK( * ), X( * ),
00024 *      $                   XACT( * )
00025 *       ..
00026 *  
00027 *
00028 *> \par Purpose:
00029 *  =============
00030 *>
00031 *> \verbatim
00032 *>
00033 *> ZCHKGT tests ZGTTRF, -TRS, -RFS, and -CON
00034 *> \endverbatim
00035 *
00036 *  Arguments:
00037 *  ==========
00038 *
00039 *> \param[in] DOTYPE
00040 *> \verbatim
00041 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
00042 *>          The matrix types to be used for testing.  Matrices of type j
00043 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00044 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00045 *> \endverbatim
00046 *>
00047 *> \param[in] NN
00048 *> \verbatim
00049 *>          NN is INTEGER
00050 *>          The number of values of N contained in the vector NVAL.
00051 *> \endverbatim
00052 *>
00053 *> \param[in] NVAL
00054 *> \verbatim
00055 *>          NVAL is INTEGER array, dimension (NN)
00056 *>          The values of the matrix dimension N.
00057 *> \endverbatim
00058 *>
00059 *> \param[in] NNS
00060 *> \verbatim
00061 *>          NNS is INTEGER
00062 *>          The number of values of NRHS contained in the vector NSVAL.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] NSVAL
00066 *> \verbatim
00067 *>          NSVAL is INTEGER array, dimension (NNS)
00068 *>          The values of the number of right hand sides NRHS.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] THRESH
00072 *> \verbatim
00073 *>          THRESH is DOUBLE PRECISION
00074 *>          The threshold value for the test ratios.  A result is
00075 *>          included in the output file if RESULT >= THRESH.  To have
00076 *>          every test ratio printed, use THRESH = 0.
00077 *> \endverbatim
00078 *>
00079 *> \param[in] TSTERR
00080 *> \verbatim
00081 *>          TSTERR is LOGICAL
00082 *>          Flag that indicates whether error exits are to be tested.
00083 *> \endverbatim
00084 *>
00085 *> \param[out] A
00086 *> \verbatim
00087 *>          A is COMPLEX*16 array, dimension (NMAX*4)
00088 *> \endverbatim
00089 *>
00090 *> \param[out] AF
00091 *> \verbatim
00092 *>          AF is COMPLEX*16 array, dimension (NMAX*4)
00093 *> \endverbatim
00094 *>
00095 *> \param[out] B
00096 *> \verbatim
00097 *>          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
00098 *>          where NSMAX is the largest entry in NSVAL.
00099 *> \endverbatim
00100 *>
00101 *> \param[out] X
00102 *> \verbatim
00103 *>          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
00104 *> \endverbatim
00105 *>
00106 *> \param[out] XACT
00107 *> \verbatim
00108 *>          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
00109 *> \endverbatim
00110 *>
00111 *> \param[out] WORK
00112 *> \verbatim
00113 *>          WORK is COMPLEX*16 array, dimension
00114 *>                      (NMAX*max(3,NSMAX))
00115 *> \endverbatim
00116 *>
00117 *> \param[out] RWORK
00118 *> \verbatim
00119 *>          RWORK is DOUBLE PRECISION array, dimension
00120 *>                      (max(NMAX)+2*NSMAX)
00121 *> \endverbatim
00122 *>
00123 *> \param[out] IWORK
00124 *> \verbatim
00125 *>          IWORK is INTEGER array, dimension (NMAX)
00126 *> \endverbatim
00127 *>
00128 *> \param[in] NOUT
00129 *> \verbatim
00130 *>          NOUT is INTEGER
00131 *>          The unit number for output.
00132 *> \endverbatim
00133 *
00134 *  Authors:
00135 *  ========
00136 *
00137 *> \author Univ. of Tennessee 
00138 *> \author Univ. of California Berkeley 
00139 *> \author Univ. of Colorado Denver 
00140 *> \author NAG Ltd. 
00141 *
00142 *> \date November 2011
00143 *
00144 *> \ingroup complex16_lin
00145 *
00146 *  =====================================================================
00147       SUBROUTINE ZCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00148      $                   A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT )
00149 *
00150 *  -- LAPACK test routine (version 3.4.0) --
00151 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00152 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00153 *     November 2011
00154 *
00155 *     .. Scalar Arguments ..
00156       LOGICAL            TSTERR
00157       INTEGER            NN, NNS, NOUT
00158       DOUBLE PRECISION   THRESH
00159 *     ..
00160 *     .. Array Arguments ..
00161       LOGICAL            DOTYPE( * )
00162       INTEGER            IWORK( * ), NSVAL( * ), NVAL( * )
00163       DOUBLE PRECISION   RWORK( * )
00164       COMPLEX*16         A( * ), AF( * ), B( * ), WORK( * ), X( * ),
00165      $                   XACT( * )
00166 *     ..
00167 *
00168 *  =====================================================================
00169 *
00170 *     .. Parameters ..
00171       DOUBLE PRECISION   ONE, ZERO
00172       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00173       INTEGER            NTYPES
00174       PARAMETER          ( NTYPES = 12 )
00175       INTEGER            NTESTS
00176       PARAMETER          ( NTESTS = 7 )
00177 *     ..
00178 *     .. Local Scalars ..
00179       LOGICAL            TRFCON, ZEROT
00180       CHARACTER          DIST, NORM, TRANS, TYPE
00181       CHARACTER*3        PATH
00182       INTEGER            I, IMAT, IN, INFO, IRHS, ITRAN, IX, IZERO, J,
00183      $                   K, KL, KOFF, KU, LDA, M, MODE, N, NERRS, NFAIL,
00184      $                   NIMAT, NRHS, NRUN
00185       DOUBLE PRECISION   AINVNM, ANORM, COND, RCOND, RCONDC, RCONDI,
00186      $                   RCONDO
00187 *     ..
00188 *     .. Local Arrays ..
00189       CHARACTER          TRANSS( 3 )
00190       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00191       DOUBLE PRECISION   RESULT( NTESTS )
00192       COMPLEX*16         Z( 3 )
00193 *     ..
00194 *     .. External Functions ..
00195       DOUBLE PRECISION   DGET06, DZASUM, ZLANGT
00196       EXTERNAL           DGET06, DZASUM, ZLANGT
00197 *     ..
00198 *     .. External Subroutines ..
00199       EXTERNAL           ALAERH, ALAHD, ALASUM, ZCOPY, ZDSCAL, ZERRGE,
00200      $                   ZGET04, ZGTCON, ZGTRFS, ZGTT01, ZGTT02, ZGTT05,
00201      $                   ZGTTRF, ZGTTRS, ZLACPY, ZLAGTM, ZLARNV, ZLATB4,
00202      $                   ZLATMS
00203 *     ..
00204 *     .. Intrinsic Functions ..
00205       INTRINSIC          MAX
00206 *     ..
00207 *     .. Scalars in Common ..
00208       LOGICAL            LERR, OK
00209       CHARACTER*32       SRNAMT
00210       INTEGER            INFOT, NUNIT
00211 *     ..
00212 *     .. Common blocks ..
00213       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00214       COMMON             / SRNAMC / SRNAMT
00215 *     ..
00216 *     .. Data statements ..
00217       DATA               ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T',
00218      $                   'C' /
00219 *     ..
00220 *     .. Executable Statements ..
00221 *
00222       PATH( 1: 1 ) = 'Zomplex precision'
00223       PATH( 2: 3 ) = 'GT'
00224       NRUN = 0
00225       NFAIL = 0
00226       NERRS = 0
00227       DO 10 I = 1, 4
00228          ISEED( I ) = ISEEDY( I )
00229    10 CONTINUE
00230 *
00231 *     Test the error exits
00232 *
00233       IF( TSTERR )
00234      $   CALL ZERRGE( PATH, NOUT )
00235       INFOT = 0
00236 *
00237       DO 110 IN = 1, NN
00238 *
00239 *        Do for each value of N in NVAL.
00240 *
00241          N = NVAL( IN )
00242          M = MAX( N-1, 0 )
00243          LDA = MAX( 1, N )
00244          NIMAT = NTYPES
00245          IF( N.LE.0 )
00246      $      NIMAT = 1
00247 *
00248          DO 100 IMAT = 1, NIMAT
00249 *
00250 *           Do the tests only if DOTYPE( IMAT ) is true.
00251 *
00252             IF( .NOT.DOTYPE( IMAT ) )
00253      $         GO TO 100
00254 *
00255 *           Set up parameters with ZLATB4.
00256 *
00257             CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00258      $                   COND, DIST )
00259 *
00260             ZEROT = IMAT.GE.8 .AND. IMAT.LE.10
00261             IF( IMAT.LE.6 ) THEN
00262 *
00263 *              Types 1-6:  generate matrices of known condition number.
00264 *
00265                KOFF = MAX( 2-KU, 3-MAX( 1, N ) )
00266                SRNAMT = 'ZLATMS'
00267                CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND,
00268      $                      ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
00269      $                      INFO )
00270 *
00271 *              Check the error code from ZLATMS.
00272 *
00273                IF( INFO.NE.0 ) THEN
00274                   CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, KL,
00275      $                         KU, -1, IMAT, NFAIL, NERRS, NOUT )
00276                   GO TO 100
00277                END IF
00278                IZERO = 0
00279 *
00280                IF( N.GT.1 ) THEN
00281                   CALL ZCOPY( N-1, AF( 4 ), 3, A, 1 )
00282                   CALL ZCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 )
00283                END IF
00284                CALL ZCOPY( N, AF( 2 ), 3, A( M+1 ), 1 )
00285             ELSE
00286 *
00287 *              Types 7-12:  generate tridiagonal matrices with
00288 *              unknown condition numbers.
00289 *
00290                IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN
00291 *
00292 *                 Generate a matrix with elements whose real and
00293 *                 imaginary parts are from [-1,1].
00294 *
00295                   CALL ZLARNV( 2, ISEED, N+2*M, A )
00296                   IF( ANORM.NE.ONE )
00297      $               CALL ZDSCAL( N+2*M, ANORM, A, 1 )
00298                ELSE IF( IZERO.GT.0 ) THEN
00299 *
00300 *                 Reuse the last matrix by copying back the zeroed out
00301 *                 elements.
00302 *
00303                   IF( IZERO.EQ.1 ) THEN
00304                      A( N ) = Z( 2 )
00305                      IF( N.GT.1 )
00306      $                  A( 1 ) = Z( 3 )
00307                   ELSE IF( IZERO.EQ.N ) THEN
00308                      A( 3*N-2 ) = Z( 1 )
00309                      A( 2*N-1 ) = Z( 2 )
00310                   ELSE
00311                      A( 2*N-2+IZERO ) = Z( 1 )
00312                      A( N-1+IZERO ) = Z( 2 )
00313                      A( IZERO ) = Z( 3 )
00314                   END IF
00315                END IF
00316 *
00317 *              If IMAT > 7, set one column of the matrix to 0.
00318 *
00319                IF( .NOT.ZEROT ) THEN
00320                   IZERO = 0
00321                ELSE IF( IMAT.EQ.8 ) THEN
00322                   IZERO = 1
00323                   Z( 2 ) = A( N )
00324                   A( N ) = ZERO
00325                   IF( N.GT.1 ) THEN
00326                      Z( 3 ) = A( 1 )
00327                      A( 1 ) = ZERO
00328                   END IF
00329                ELSE IF( IMAT.EQ.9 ) THEN
00330                   IZERO = N
00331                   Z( 1 ) = A( 3*N-2 )
00332                   Z( 2 ) = A( 2*N-1 )
00333                   A( 3*N-2 ) = ZERO
00334                   A( 2*N-1 ) = ZERO
00335                ELSE
00336                   IZERO = ( N+1 ) / 2
00337                   DO 20 I = IZERO, N - 1
00338                      A( 2*N-2+I ) = ZERO
00339                      A( N-1+I ) = ZERO
00340                      A( I ) = ZERO
00341    20             CONTINUE
00342                   A( 3*N-2 ) = ZERO
00343                   A( 2*N-1 ) = ZERO
00344                END IF
00345             END IF
00346 *
00347 *+    TEST 1
00348 *           Factor A as L*U and compute the ratio
00349 *              norm(L*U - A) / (n * norm(A) * EPS )
00350 *
00351             CALL ZCOPY( N+2*M, A, 1, AF, 1 )
00352             SRNAMT = 'ZGTTRF'
00353             CALL ZGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
00354      $                   IWORK, INFO )
00355 *
00356 *           Check error code from ZGTTRF.
00357 *
00358             IF( INFO.NE.IZERO )
00359      $         CALL ALAERH( PATH, 'ZGTTRF', INFO, IZERO, ' ', N, N, 1,
00360      $                      1, -1, IMAT, NFAIL, NERRS, NOUT )
00361             TRFCON = INFO.NE.0
00362 *
00363             CALL ZGTT01( N, A, A( M+1 ), A( N+M+1 ), AF, AF( M+1 ),
00364      $                   AF( N+M+1 ), AF( N+2*M+1 ), IWORK, WORK, LDA,
00365      $                   RWORK, RESULT( 1 ) )
00366 *
00367 *           Print the test ratio if it is .GE. THRESH.
00368 *
00369             IF( RESULT( 1 ).GE.THRESH ) THEN
00370                IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00371      $            CALL ALAHD( NOUT, PATH )
00372                WRITE( NOUT, FMT = 9999 )N, IMAT, 1, RESULT( 1 )
00373                NFAIL = NFAIL + 1
00374             END IF
00375             NRUN = NRUN + 1
00376 *
00377             DO 50 ITRAN = 1, 2
00378                TRANS = TRANSS( ITRAN )
00379                IF( ITRAN.EQ.1 ) THEN
00380                   NORM = 'O'
00381                ELSE
00382                   NORM = 'I'
00383                END IF
00384                ANORM = ZLANGT( NORM, N, A, A( M+1 ), A( N+M+1 ) )
00385 *
00386                IF( .NOT.TRFCON ) THEN
00387 *
00388 *                 Use ZGTTRS to solve for one column at a time of
00389 *                 inv(A), computing the maximum column sum as we go.
00390 *
00391                   AINVNM = ZERO
00392                   DO 40 I = 1, N
00393                      DO 30 J = 1, N
00394                         X( J ) = ZERO
00395    30                CONTINUE
00396                      X( I ) = ONE
00397                      CALL ZGTTRS( TRANS, N, 1, AF, AF( M+1 ),
00398      $                            AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
00399      $                            LDA, INFO )
00400                      AINVNM = MAX( AINVNM, DZASUM( N, X, 1 ) )
00401    40             CONTINUE
00402 *
00403 *                 Compute RCONDC = 1 / (norm(A) * norm(inv(A))
00404 *
00405                   IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00406                      RCONDC = ONE
00407                   ELSE
00408                      RCONDC = ( ONE / ANORM ) / AINVNM
00409                   END IF
00410                   IF( ITRAN.EQ.1 ) THEN
00411                      RCONDO = RCONDC
00412                   ELSE
00413                      RCONDI = RCONDC
00414                   END IF
00415                ELSE
00416                   RCONDC = ZERO
00417                END IF
00418 *
00419 *+    TEST 7
00420 *              Estimate the reciprocal of the condition number of the
00421 *              matrix.
00422 *
00423                SRNAMT = 'ZGTCON'
00424                CALL ZGTCON( NORM, N, AF, AF( M+1 ), AF( N+M+1 ),
00425      $                      AF( N+2*M+1 ), IWORK, ANORM, RCOND, WORK,
00426      $                      INFO )
00427 *
00428 *              Check error code from ZGTCON.
00429 *
00430                IF( INFO.NE.0 )
00431      $            CALL ALAERH( PATH, 'ZGTCON', INFO, 0, NORM, N, N, -1,
00432      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00433 *
00434                RESULT( 7 ) = DGET06( RCOND, RCONDC )
00435 *
00436 *              Print the test ratio if it is .GE. THRESH.
00437 *
00438                IF( RESULT( 7 ).GE.THRESH ) THEN
00439                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00440      $               CALL ALAHD( NOUT, PATH )
00441                   WRITE( NOUT, FMT = 9997 )NORM, N, IMAT, 7,
00442      $               RESULT( 7 )
00443                   NFAIL = NFAIL + 1
00444                END IF
00445                NRUN = NRUN + 1
00446    50       CONTINUE
00447 *
00448 *           Skip the remaining tests if the matrix is singular.
00449 *
00450             IF( TRFCON )
00451      $         GO TO 100
00452 *
00453             DO 90 IRHS = 1, NNS
00454                NRHS = NSVAL( IRHS )
00455 *
00456 *              Generate NRHS random solution vectors.
00457 *
00458                IX = 1
00459                DO 60 J = 1, NRHS
00460                   CALL ZLARNV( 2, ISEED, N, XACT( IX ) )
00461                   IX = IX + LDA
00462    60          CONTINUE
00463 *
00464                DO 80 ITRAN = 1, 3
00465                   TRANS = TRANSS( ITRAN )
00466                   IF( ITRAN.EQ.1 ) THEN
00467                      RCONDC = RCONDO
00468                   ELSE
00469                      RCONDC = RCONDI
00470                   END IF
00471 *
00472 *                 Set the right hand side.
00473 *
00474                   CALL ZLAGTM( TRANS, N, NRHS, ONE, A, A( M+1 ),
00475      $                         A( N+M+1 ), XACT, LDA, ZERO, B, LDA )
00476 *
00477 *+    TEST 2
00478 *              Solve op(A) * X = B and compute the residual.
00479 *
00480                   CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00481                   SRNAMT = 'ZGTTRS'
00482                   CALL ZGTTRS( TRANS, N, NRHS, AF, AF( M+1 ),
00483      $                         AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
00484      $                         LDA, INFO )
00485 *
00486 *              Check error code from ZGTTRS.
00487 *
00488                   IF( INFO.NE.0 )
00489      $               CALL ALAERH( PATH, 'ZGTTRS', INFO, 0, TRANS, N, N,
00490      $                            -1, -1, NRHS, IMAT, NFAIL, NERRS,
00491      $                            NOUT )
00492 *
00493                   CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00494                   CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
00495      $                         X, LDA, WORK, LDA, RESULT( 2 ) )
00496 *
00497 *+    TEST 3
00498 *              Check solution from generated exact solution.
00499 *
00500                   CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00501      $                         RESULT( 3 ) )
00502 *
00503 *+    TESTS 4, 5, and 6
00504 *              Use iterative refinement to improve the solution.
00505 *
00506                   SRNAMT = 'ZGTRFS'
00507                   CALL ZGTRFS( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
00508      $                         AF, AF( M+1 ), AF( N+M+1 ),
00509      $                         AF( N+2*M+1 ), IWORK, B, LDA, X, LDA,
00510      $                         RWORK, RWORK( NRHS+1 ), WORK,
00511      $                         RWORK( 2*NRHS+1 ), INFO )
00512 *
00513 *              Check error code from ZGTRFS.
00514 *
00515                   IF( INFO.NE.0 )
00516      $               CALL ALAERH( PATH, 'ZGTRFS', INFO, 0, TRANS, N, N,
00517      $                            -1, -1, NRHS, IMAT, NFAIL, NERRS,
00518      $                            NOUT )
00519 *
00520                   CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00521      $                         RESULT( 4 ) )
00522                   CALL ZGTT05( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ),
00523      $                         B, LDA, X, LDA, XACT, LDA, RWORK,
00524      $                         RWORK( NRHS+1 ), RESULT( 5 ) )
00525 *
00526 *              Print information about the tests that did not pass the
00527 *              threshold.
00528 *
00529                   DO 70 K = 2, 6
00530                      IF( RESULT( K ).GE.THRESH ) THEN
00531                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00532      $                     CALL ALAHD( NOUT, PATH )
00533                         WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS, IMAT,
00534      $                     K, RESULT( K )
00535                         NFAIL = NFAIL + 1
00536                      END IF
00537    70             CONTINUE
00538                   NRUN = NRUN + 5
00539    80          CONTINUE
00540    90       CONTINUE
00541   100    CONTINUE
00542   110 CONTINUE
00543 *
00544 *     Print a summary of the results.
00545 *
00546       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00547 *
00548  9999 FORMAT( 12X, 'N =', I5, ',', 10X, ' type ', I2, ', test(', I2,
00549      $      ') = ', G12.5 )
00550  9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
00551      $      I2, ', test(', I2, ') = ', G12.5 )
00552  9997 FORMAT( ' NORM =''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
00553      $      ', test(', I2, ') = ', G12.5 )
00554       RETURN
00555 *
00556 *     End of ZCHKGT
00557 *
00558       END
 All Files Functions