LAPACK: TESTING/LIN/zdrvab.f Source File

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