LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zdrvab.f
Go to the documentation of this file.
00001 *> \brief \b ZDRVAB
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 ZDRVAB( DOTYPE, NM, MVAL, NNS,
00012 *                          NSVAL, THRESH, NMAX, A, AFAC, B,
00013 *                          X, WORK, RWORK, SWORK, IWORK, NOUT )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       INTEGER            NM, NMAX, NNS, NOUT
00017 *       DOUBLE PRECISION   THRESH
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       LOGICAL            DOTYPE( * )
00021 *       INTEGER            MVAL( * ), NSVAL( * ), IWORK( * )
00022 *       DOUBLE PRECISION   RWORK( * )
00023 *       COMPLEX            SWORK( * )
00024 *       COMPLEX*16         A( * ), AFAC( * ), B( * ),
00025 *      $                   WORK( * ), X( * )
00026 *       ..
00027 *  
00028 *
00029 *> \par Purpose:
00030 *  =============
00031 *>
00032 *> \verbatim
00033 *>
00034 *> ZDRVAB tests ZCGESV
00035 *> \endverbatim
00036 *
00037 *  Arguments:
00038 *  ==========
00039 *
00040 *> \param[in] DOTYPE
00041 *> \verbatim
00042 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
00043 *>          The matrix types to be used for testing.  Matrices of type j
00044 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00045 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00046 *> \endverbatim
00047 *>
00048 *> \param[in] NM
00049 *> \verbatim
00050 *>          NM is INTEGER
00051 *>          The number of values of M contained in the vector MVAL.
00052 *> \endverbatim
00053 *>
00054 *> \param[in] MVAL
00055 *> \verbatim
00056 *>          MVAL is INTEGER array, dimension (NM)
00057 *>          The values of the matrix row dimension M.
00058 *> \endverbatim
00059 *>
00060 *> \param[in] NNS
00061 *> \verbatim
00062 *>          NNS is INTEGER
00063 *>          The number of values of NRHS contained in the vector NSVAL.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] NSVAL
00067 *> \verbatim
00068 *>          NSVAL is INTEGER array, dimension (NNS)
00069 *>          The values of the number of right hand sides NRHS.
00070 *> \endverbatim
00071 *>
00072 *> \param[in] THRESH
00073 *> \verbatim
00074 *>          THRESH is DOUBLE PRECISION
00075 *>          The threshold value for the test ratios.  A result is
00076 *>          included in the output file if RESULT >= THRESH.  To have
00077 *>          every test ratio printed, use THRESH = 0.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] NMAX
00081 *> \verbatim
00082 *>          NMAX is INTEGER
00083 *>          The maximum value permitted for M or N, used in dimensioning
00084 *>          the work arrays.
00085 *> \endverbatim
00086 *>
00087 *> \param[out] A
00088 *> \verbatim
00089 *>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
00090 *> \endverbatim
00091 *>
00092 *> \param[out] AFAC
00093 *> \verbatim
00094 *>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
00095 *> \endverbatim
00096 *>
00097 *> \param[out] B
00098 *> \verbatim
00099 *>          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
00100 *>          where NSMAX is the largest entry in NSVAL.
00101 *> \endverbatim
00102 *>
00103 *> \param[out] X
00104 *> \verbatim
00105 *>          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
00106 *> \endverbatim
00107 *>
00108 *> \param[out] WORK
00109 *> \verbatim
00110 *>          WORK is COMPLEX*16 array, dimension
00111 *>                      (NMAX*max(3,NSMAX*2))
00112 *> \endverbatim
00113 *>
00114 *> \param[out] RWORK
00115 *> \verbatim
00116 *>          RWORK is DOUBLE PRECISION array, dimension
00117 *>                      NMAX
00118 *> \endverbatim
00119 *>
00120 *> \param[out] SWORK
00121 *> \verbatim
00122 *>          SWORK is COMPLEX array, dimension
00123 *>                      (NMAX*(NSMAX+NMAX))
00124 *> \endverbatim
00125 *>
00126 *> \param[out] IWORK
00127 *> \verbatim
00128 *>          IWORK is INTEGER array, dimension
00129 *>                      NMAX
00130 *> \endverbatim
00131 *>
00132 *> \param[in] NOUT
00133 *> \verbatim
00134 *>          NOUT is INTEGER
00135 *>          The unit number for output.
00136 *> \endverbatim
00137 *
00138 *  Authors:
00139 *  ========
00140 *
00141 *> \author Univ. of Tennessee 
00142 *> \author Univ. of California Berkeley 
00143 *> \author Univ. of Colorado Denver 
00144 *> \author NAG Ltd. 
00145 *
00146 *> \date November 2011
00147 *
00148 *> \ingroup complex16_lin
00149 *
00150 *  =====================================================================
00151       SUBROUTINE ZDRVAB( DOTYPE, NM, MVAL, NNS,
00152      $                   NSVAL, THRESH, NMAX, A, AFAC, B,
00153      $                   X, WORK, RWORK, SWORK, IWORK, NOUT )
00154 *
00155 *  -- LAPACK test routine (version 3.4.0) --
00156 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00157 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00158 *     November 2011
00159 *
00160 *     .. Scalar Arguments ..
00161       INTEGER            NM, NMAX, NNS, NOUT
00162       DOUBLE PRECISION   THRESH
00163 *     ..
00164 *     .. Array Arguments ..
00165       LOGICAL            DOTYPE( * )
00166       INTEGER            MVAL( * ), NSVAL( * ), IWORK( * )
00167       DOUBLE PRECISION   RWORK( * )
00168       COMPLEX            SWORK( * )
00169       COMPLEX*16         A( * ), AFAC( * ), B( * ),
00170      $                   WORK( * ), X( * )
00171 *     ..
00172 *
00173 *  =====================================================================
00174 *
00175 *     .. Parameters ..
00176       DOUBLE PRECISION   ZERO
00177       PARAMETER          ( ZERO = 0.0D+0 )
00178       INTEGER            NTYPES
00179       PARAMETER          ( NTYPES = 11 )
00180       INTEGER            NTESTS
00181       PARAMETER          ( NTESTS = 1 )
00182 *     ..
00183 *     .. Local Scalars ..
00184       LOGICAL            ZEROT
00185       CHARACTER          DIST, TRANS, TYPE, XTYPE
00186       CHARACTER*3        PATH
00187       INTEGER            I, IM, IMAT, INFO, IOFF, IRHS,
00188      $                   IZERO, KL, KU, LDA, M, MODE, N,
00189      $                   NERRS, NFAIL, NIMAT, NRHS, NRUN
00190       DOUBLE PRECISION   ANORM, CNDNUM
00191 *     ..
00192 *     .. Local Arrays ..
00193       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00194       DOUBLE PRECISION   RESULT( NTESTS )
00195 *     ..
00196 *     .. Local Variables ..
00197       INTEGER            ITER, KASE
00198 *     ..
00199 *     .. External Subroutines ..
00200       EXTERNAL           ALAERH, ALAHD, ZGET08, ZLACPY, ZLARHS, ZLASET,
00201      $                   ZLATB4, ZLATMS
00202 *     ..
00203 *     .. Intrinsic Functions ..
00204       INTRINSIC          DCMPLX, DBLE, MAX, MIN, SQRT
00205 *     ..
00206 *     .. Scalars in Common ..
00207       LOGICAL            LERR, OK
00208       CHARACTER*32       SRNAMT
00209       INTEGER            INFOT, NUNIT
00210 *     ..
00211 *     .. Common blocks ..
00212       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00213       COMMON             / SRNAMC / SRNAMT
00214 *     ..
00215 *     .. Data statements ..
00216       DATA               ISEEDY / 2006, 2007, 2008, 2009 / 
00217 *     ..
00218 *     .. Executable Statements ..
00219 *
00220 *     Initialize constants and the random number seed.
00221 *
00222       KASE = 0
00223       PATH( 1: 1 ) = 'Zomplex precision'
00224       PATH( 2: 3 ) = 'GE'
00225       NRUN = 0
00226       NFAIL = 0
00227       NERRS = 0
00228       DO 10 I = 1, 4
00229          ISEED( I ) = ISEEDY( I )
00230    10 CONTINUE
00231 *
00232       INFOT = 0
00233 *
00234 *     Do for each value of M in MVAL
00235 *
00236       DO 120 IM = 1, NM
00237          M = MVAL( IM )
00238          LDA = MAX( 1, M )
00239 *
00240          N = M
00241          NIMAT = NTYPES
00242          IF( M.LE.0 .OR. N.LE.0 )
00243      $      NIMAT = 1
00244 *
00245          DO 100 IMAT = 1, NIMAT
00246 *
00247 *           Do the tests only if DOTYPE( IMAT ) is true.
00248 *
00249             IF( .NOT.DOTYPE( IMAT ) )
00250      $         GO TO 100
00251 *
00252 *           Skip types 5, 6, or 7 if the matrix size is too small.
00253 *
00254             ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
00255             IF( ZEROT .AND. N.LT.IMAT-4 )
00256      $         GO TO 100
00257 *
00258 *           Set up parameters with ZLATB4 and generate a test matrix
00259 *           with ZLATMS.
00260 *
00261             CALL ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
00262      $                   CNDNUM, DIST )
00263 *
00264             SRNAMT = 'ZLATMS'
00265             CALL ZLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
00266      $                   CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
00267      $                   WORK, INFO )
00268 *
00269 *           Check error code from ZLATMS.
00270 *
00271             IF( INFO.NE.0 ) THEN
00272                CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', M, N, -1,
00273      $                      -1, -1, IMAT, NFAIL, NERRS, NOUT )
00274                GO TO 100
00275             END IF
00276 *
00277 *           For types 5-7, zero one or more columns of the matrix to
00278 *           test that INFO is returned correctly.
00279 *
00280             IF( ZEROT ) THEN
00281                IF( IMAT.EQ.5 ) THEN
00282                   IZERO = 1
00283                ELSE IF( IMAT.EQ.6 ) THEN
00284                   IZERO = MIN( M, N )
00285                ELSE
00286                   IZERO = MIN( M, N ) / 2 + 1
00287                END IF
00288                IOFF = ( IZERO-1 )*LDA
00289                IF( IMAT.LT.7 ) THEN
00290                   DO 20 I = 1, M
00291                      A( IOFF+I ) = ZERO
00292    20             CONTINUE
00293                ELSE
00294                   CALL ZLASET( 'Full', M, N-IZERO+1, DCMPLX(ZERO),
00295      $                         DCMPLX(ZERO), A( IOFF+1 ), LDA )
00296                END IF
00297             ELSE
00298                IZERO = 0
00299             END IF
00300 *
00301             DO 60 IRHS = 1, NNS
00302                NRHS = NSVAL( IRHS )
00303                XTYPE = 'N'
00304                TRANS = 'N'
00305 *
00306                SRNAMT = 'ZLARHS'
00307                CALL ZLARHS( PATH, XTYPE, ' ', TRANS, N, N, KL,
00308      $                      KU, NRHS, A, LDA, X, LDA, B,
00309      $                      LDA, ISEED, INFO )
00310 *
00311                SRNAMT = 'ZCGESV'
00312 *
00313                KASE = KASE + 1
00314 *
00315                CALL ZLACPY( 'Full', M, N, A, LDA, AFAC, LDA )
00316 *
00317                CALL ZCGESV( N, NRHS, A, LDA, IWORK, B, LDA, X, LDA,
00318      $                      WORK, SWORK, RWORK, ITER, INFO)
00319 *
00320                IF (ITER.LT.0) THEN
00321                    CALL ZLACPY( 'Full', M, N, AFAC, LDA, A, LDA )
00322                ENDIF
00323 *
00324 *              Check error code from ZCGESV. This should be the same as 
00325 *              the one of DGETRF.
00326 *
00327                IF( INFO.NE.IZERO ) THEN
00328 *
00329                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00330      $               CALL ALAHD( NOUT, PATH )
00331                   NERRS = NERRS + 1
00332 *
00333                   IF( INFO.NE.IZERO .AND. IZERO.NE.0 ) THEN
00334                      WRITE( NOUT, FMT = 9988 )'ZCGESV',INFO,
00335      $                         IZERO,M,IMAT
00336                   ELSE
00337                      WRITE( NOUT, FMT = 9975 )'ZCGESV',INFO,
00338      $                         M, IMAT
00339                   END IF
00340                END IF
00341 *
00342 *              Skip the remaining test if the matrix is singular.
00343 *
00344                IF( INFO.NE.0 )
00345      $            GO TO 100
00346 *
00347 *              Check the quality of the solution
00348 *
00349                CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00350 *
00351                CALL ZGET08( TRANS, N, N, NRHS, A, LDA, X, LDA, WORK,
00352      $                      LDA, RWORK, RESULT( 1 ) )
00353 *
00354 *              Check if the test passes the tesing.
00355 *              Print information about the tests that did not
00356 *              pass the testing.
00357 *
00358 *              If iterative refinement has been used and claimed to 
00359 *              be successful (ITER>0), we want
00360 *                NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS*SRQT(N)) < 1
00361 *
00362 *              If double precision has been used (ITER<0), we want
00363 *                NORMI(B - A*X)/(NORMI(A)*NORMI(X)*EPS) < THRES
00364 *              (Cf. the linear solver testing routines)
00365 *
00366                IF ((THRESH.LE.0.0E+00)
00367      $            .OR.((ITER.GE.0).AND.(N.GT.0)
00368      $                 .AND.(RESULT(1).GE.SQRT(DBLE(N))))
00369      $            .OR.((ITER.LT.0).AND.(RESULT(1).GE.THRESH))) THEN
00370 *
00371                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
00372                      WRITE( NOUT, FMT = 8999 )'DGE'
00373                      WRITE( NOUT, FMT = '( '' Matrix types:'' )' )
00374                      WRITE( NOUT, FMT = 8979 )
00375                      WRITE( NOUT, FMT = '( '' Test ratios:'' )' )
00376                      WRITE( NOUT, FMT = 8960 )1
00377                      WRITE( NOUT, FMT = '( '' Messages:'' )' )
00378                   END IF
00379 *
00380                   WRITE( NOUT, FMT = 9998 )TRANS, N, NRHS,
00381      $               IMAT, 1, RESULT( 1 )
00382                   NFAIL = NFAIL + 1
00383                END IF
00384                NRUN = NRUN + 1
00385    60       CONTINUE
00386   100    CONTINUE
00387   120 CONTINUE
00388 *
00389 *     Print a summary of the results.
00390 *
00391       IF( NFAIL.GT.0 ) THEN
00392          WRITE( NOUT, FMT = 9996 )'ZCGESV', NFAIL, NRUN
00393       ELSE
00394          WRITE( NOUT, FMT = 9995 )'ZCGESV', NRUN
00395       END IF
00396       IF( NERRS.GT.0 ) THEN
00397          WRITE( NOUT, FMT = 9994 )NERRS
00398       END IF
00399 *
00400  9998 FORMAT( ' TRANS=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
00401      $      I2, ', test(', I2, ') =', G12.5 )
00402  9996 FORMAT( 1X, A6, ': ', I6, ' out of ', I6,
00403      $      ' tests failed to pass the threshold' )
00404  9995 FORMAT( /1X, 'All tests for ', A6,
00405      $      ' routines passed the threshold ( ', I6, ' tests run)' )
00406  9994 FORMAT( 6X, I6, ' error messages recorded' )
00407 *
00408 *     SUBNAM, INFO, INFOE, M, IMAT
00409 *
00410  9988 FORMAT( ' *** ', A6, ' returned with INFO =', I5, ' instead of ',
00411      $      I5, / ' ==> M =', I5, ', type ',
00412      $      I2 )
00413 *
00414 *     SUBNAM, INFO, M, IMAT
00415 *
00416  9975 FORMAT( ' *** Error code from ', A6, '=', I5, ' for M=', I5,
00417      $      ', type ', I2 )
00418  8999 FORMAT( / 1X, A3, ':  General dense matrices' )
00419  8979 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X,
00420      $      '2. Upper triangular', 16X,
00421      $      '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
00422      $      '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS',
00423      $      / 4X, '4. Random, CNDNUM = 2', 13X,
00424      $      '10. Scaled near underflow', / 4X, '5. First column zero',
00425      $      14X, '11. Scaled near overflow', / 4X,
00426      $      '6. Last column zero' )
00427  8960 FORMAT( 3X, I2, ': norm_1( B - A * X )  / ',
00428      $      '( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF', 
00429      $      / 4x, 'or norm_1( B - A * X )  / ',
00430      $      '( norm_1(A) * norm_1(X) * EPS ) > THRES if DGETRF' )
00431       RETURN
00432 *
00433 *     End of ZDRVAB
00434 *
00435       END
 All Files Functions