LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zdrvac.f
Go to the documentation of this file.
00001 *> \brief \b ZDRVAC
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 ZDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX,
00012 *                          A, AFAC, B, X, WORK,
00013 *                          RWORK, SWORK, NOUT )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       INTEGER            NMAX, NM, NNS, NOUT
00017 *       DOUBLE PRECISION   THRESH
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       LOGICAL            DOTYPE( * )
00021 *       INTEGER            MVAL( * ), NSVAL( * )
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 *> ZDRVAC tests ZCPOSV.
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 N 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 dimension N.
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 N, used in dimensioning the
00084 *>          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 *> \endverbatim
00101 *>
00102 *> \param[out] X
00103 *> \verbatim
00104 *>          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
00105 *> \endverbatim
00106 *>
00107 *> \param[out] WORK
00108 *> \verbatim
00109 *>          WORK is COMPLEX*16 array, dimension
00110 *>                      (NMAX*max(3,NSMAX))
00111 *> \endverbatim
00112 *>
00113 *> \param[out] RWORK
00114 *> \verbatim
00115 *>          RWORK is DOUBLE PRECISION array, dimension
00116 *>                      (max(2*NMAX,2*NSMAX+NWORK))
00117 *> \endverbatim
00118 *>
00119 *> \param[out] SWORK
00120 *> \verbatim
00121 *>          SWORK is COMPLEX array, dimension
00122 *>                      (NMAX*(NSMAX+NMAX))
00123 *> \endverbatim
00124 *>
00125 *> \param[in] NOUT
00126 *> \verbatim
00127 *>          NOUT is INTEGER
00128 *>          The unit number for output.
00129 *> \endverbatim
00130 *
00131 *  Authors:
00132 *  ========
00133 *
00134 *> \author Univ. of Tennessee 
00135 *> \author Univ. of California Berkeley 
00136 *> \author Univ. of Colorado Denver 
00137 *> \author NAG Ltd. 
00138 *
00139 *> \date November 2011
00140 *
00141 *> \ingroup complex16_lin
00142 *
00143 *  =====================================================================
00144       SUBROUTINE ZDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX,
00145      $                   A, AFAC, B, X, WORK,
00146      $                   RWORK, SWORK, NOUT )
00147 *
00148 *  -- LAPACK test routine (version 3.4.0) --
00149 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00150 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00151 *     November 2011
00152 *
00153 *     .. Scalar Arguments ..
00154       INTEGER            NMAX, NM, NNS, NOUT
00155       DOUBLE PRECISION   THRESH
00156 *     ..
00157 *     .. Array Arguments ..
00158       LOGICAL            DOTYPE( * )
00159       INTEGER            MVAL( * ), NSVAL( * )
00160       DOUBLE PRECISION   RWORK( * )
00161       COMPLEX            SWORK(*)
00162       COMPLEX*16         A( * ), AFAC( * ), B( * ),
00163      $                   WORK( * ), X( * )
00164 *     ..
00165 *
00166 *  =====================================================================
00167 *
00168 *     .. Parameters ..
00169       DOUBLE PRECISION   ZERO
00170       PARAMETER          ( ZERO = 0.0D+0 )
00171       INTEGER            NTYPES
00172       PARAMETER          ( NTYPES = 9 )
00173       INTEGER            NTESTS
00174       PARAMETER          ( NTESTS = 1 )
00175 *     ..
00176 *     .. Local Scalars ..
00177       LOGICAL            ZEROT
00178       CHARACTER          DIST, TYPE, UPLO, XTYPE
00179       CHARACTER*3        PATH
00180       INTEGER            I, IM, IMAT, INFO, IOFF, IRHS, IUPLO,
00181      $                   IZERO, KL, KU, LDA, MODE, N, 
00182      $                   NERRS, NFAIL, NIMAT, NRHS, NRUN
00183       DOUBLE PRECISION   ANORM, CNDNUM
00184 *     ..
00185 *     .. Local Arrays ..
00186       CHARACTER          UPLOS( 2 )
00187       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00188       DOUBLE PRECISION   RESULT( NTESTS )
00189 *     ..
00190 *     .. Local Variables ..
00191       INTEGER            ITER, KASE
00192 *     ..
00193 *     .. External Subroutines ..
00194       EXTERNAL           ALAERH, ZLACPY, ZLAIPD,
00195      $                   ZLARHS, ZLATB4, ZLATMS, 
00196      $                   ZPOT06, ZCPOSV
00197 *     ..
00198 *     .. Intrinsic Functions ..
00199       INTRINSIC          DBLE, MAX, SQRT
00200 *     ..
00201 *     .. Scalars in Common ..
00202       LOGICAL            LERR, OK
00203       CHARACTER*32       SRNAMT
00204       INTEGER            INFOT, NUNIT
00205 *     ..
00206 *     .. Common blocks ..
00207       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00208       COMMON             / SRNAMC / SRNAMT
00209 *     ..
00210 *     .. Data statements ..
00211       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00212       DATA               UPLOS / 'U', 'L' /
00213 *     ..
00214 *     .. Executable Statements ..
00215 *
00216 *     Initialize constants and the random number seed.
00217 *
00218       KASE = 0
00219       PATH( 1: 1 ) = 'Zomplex precision'
00220       PATH( 2: 3 ) = 'PO'
00221       NRUN = 0
00222       NFAIL = 0
00223       NERRS = 0
00224       DO 10 I = 1, 4
00225          ISEED( I ) = ISEEDY( I )
00226    10 CONTINUE
00227 *
00228       INFOT = 0
00229 *
00230 *     Do for each value of N in MVAL
00231 *
00232       DO 120 IM = 1, NM
00233          N = MVAL( IM )
00234          LDA = MAX( N, 1 )
00235          NIMAT = NTYPES
00236          IF( N.LE.0 )
00237      $      NIMAT = 1
00238 *
00239          DO 110 IMAT = 1, NIMAT
00240 *
00241 *           Do the tests only if DOTYPE( IMAT ) is true.
00242 *
00243             IF( .NOT.DOTYPE( IMAT ) )
00244      $         GO TO 110
00245 *
00246 *           Skip types 3, 4, or 5 if the matrix size is too small.
00247 *
00248             ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
00249             IF( ZEROT .AND. N.LT.IMAT-2 )
00250      $         GO TO 110
00251 *
00252 *           Do first for UPLO = 'U', then for UPLO = 'L'
00253 *
00254             DO 100 IUPLO = 1, 2
00255                UPLO = UPLOS( IUPLO )
00256 *
00257 *              Set up parameters with ZLATB4 and generate a test matrix
00258 *              with ZLATMS.
00259 *
00260                CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00261      $                      CNDNUM, DIST )
00262 *
00263                SRNAMT = 'ZLATMS'
00264                CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00265      $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
00266      $                      INFO )
00267 *
00268 *              Check error code from ZLATMS.
00269 *
00270                IF( INFO.NE.0 ) THEN
00271                   CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
00272      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00273                   GO TO 100
00274                END IF
00275 *
00276 *              For types 3-5, zero one row and column of the matrix to
00277 *              test that INFO is returned correctly.
00278 *
00279                IF( ZEROT ) THEN
00280                   IF( IMAT.EQ.3 ) THEN
00281                      IZERO = 1
00282                   ELSE IF( IMAT.EQ.4 ) THEN
00283                      IZERO = N
00284                   ELSE
00285                      IZERO = N / 2 + 1
00286                   END IF
00287                   IOFF = ( IZERO-1 )*LDA
00288 *
00289 *                 Set row and column IZERO of A to 0.
00290 *
00291                   IF( IUPLO.EQ.1 ) THEN
00292                      DO 20 I = 1, IZERO - 1
00293                         A( IOFF+I ) = ZERO
00294    20                CONTINUE
00295                      IOFF = IOFF + IZERO
00296                      DO 30 I = IZERO, N
00297                         A( IOFF ) = ZERO
00298                         IOFF = IOFF + LDA
00299    30                CONTINUE
00300                   ELSE
00301                      IOFF = IZERO
00302                      DO 40 I = 1, IZERO - 1
00303                         A( IOFF ) = ZERO
00304                         IOFF = IOFF + LDA
00305    40                CONTINUE
00306                      IOFF = IOFF - IZERO
00307                      DO 50 I = IZERO, N
00308                         A( IOFF+I ) = ZERO
00309    50                CONTINUE
00310                   END IF
00311                ELSE
00312                   IZERO = 0
00313                END IF
00314 *
00315 *              Set the imaginary part of the diagonals.
00316 *
00317                CALL ZLAIPD( N, A, LDA+1, 0 )
00318 *
00319                DO 60 IRHS = 1, NNS
00320                   NRHS = NSVAL( IRHS )
00321                   XTYPE = 'N'
00322 *
00323 *                 Form an exact solution and set the right hand side.
00324 *
00325                   SRNAMT = 'ZLARHS'
00326                   CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
00327      $                         NRHS, A, LDA, X, LDA, B, LDA,
00328      $                         ISEED, INFO )
00329 *
00330 *                 Compute the L*L' or U'*U factorization of the
00331 *                 matrix and solve the system.
00332 *
00333                   SRNAMT = 'ZCPOSV '
00334                   KASE = KASE + 1
00335 *
00336                   CALL ZLACPY( 'All', N, N, A, LDA, AFAC, LDA) 
00337 *
00338                   CALL ZCPOSV( UPLO, N, NRHS, AFAC, LDA, B, LDA, X, LDA,
00339      $                         WORK, SWORK, RWORK, ITER, INFO )
00340 *
00341                   IF (ITER.LT.0) THEN
00342                      CALL ZLACPY( 'All', N, N, A, LDA, AFAC, LDA )
00343                   ENDIF
00344 *
00345 *                 Check error code from ZCPOSV .
00346 *
00347                   IF( INFO.NE.IZERO ) THEN
00348 *
00349                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00350      $                  CALL ALAHD( NOUT, PATH )
00351                      NERRS = NERRS + 1
00352 *
00353                      IF( INFO.NE.IZERO .AND. IZERO.NE.0 ) THEN
00354                         WRITE( NOUT, FMT = 9988 )'ZCPOSV',INFO,IZERO,N,
00355      $                     IMAT
00356                      ELSE
00357                         WRITE( NOUT, FMT = 9975 )'ZCPOSV',INFO,N,IMAT
00358                      END IF
00359                   END IF
00360 *
00361 *                 Skip the remaining test if the matrix is singular.
00362 *
00363                   IF( INFO.NE.0 )
00364      $               GO TO 110
00365 *
00366 *                 Check the quality of the solution
00367 *
00368                   CALL ZLACPY( 'All', N, NRHS, B, LDA, WORK, LDA )
00369 *
00370                   CALL ZPOT06( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
00371      $               LDA, RWORK, RESULT( 1 ) )
00372 *
00373 *                 Check if the test passes the tesing.
00374 *                 Print information about the tests that did not
00375 *                 pass the testing.
00376 *
00377 *                 If iterative refinement has been used and claimed to 
00378 *                 be successful (ITER>0), we want
00379 *                 NORM1(B - A*X)/(NORM1(A)*NORM1(X)*EPS*SRQT(N)) < 1
00380 *
00381 *                 If double precision has been used (ITER<0), we want
00382 *                 NORM1(B - A*X)/(NORM1(A)*NORM1(X)*EPS) < THRES
00383 *                 (Cf. the linear solver testing routines)
00384 *
00385                   IF ((THRESH.LE.0.0E+00)
00386      $               .OR.((ITER.GE.0).AND.(N.GT.0)
00387      $               .AND.(RESULT(1).GE.SQRT(DBLE(N))))
00388      $               .OR.((ITER.LT.0).AND.(RESULT(1).GE.THRESH))) THEN
00389 *
00390                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
00391                         WRITE( NOUT, FMT = 8999 )'ZPO'
00392                         WRITE( NOUT, FMT = '( '' Matrix types:'' )' )
00393                         WRITE( NOUT, FMT = 8979 )
00394                         WRITE( NOUT, FMT = '( '' Test ratios:'' )' )
00395                         WRITE( NOUT, FMT = 8960 )1
00396                         WRITE( NOUT, FMT = '( '' Messages:'' )' )
00397                      END IF
00398 *
00399                      WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, IMAT, 1,
00400      $                  RESULT( 1 )
00401 *
00402                      NFAIL = NFAIL + 1
00403 *
00404                   END IF
00405 *
00406                   NRUN = NRUN + 1
00407 *
00408    60          CONTINUE
00409   100       CONTINUE
00410   110    CONTINUE
00411   120 CONTINUE
00412 *
00413 *     Print a summary of the results.
00414 *
00415       IF( NFAIL.GT.0 ) THEN
00416          WRITE( NOUT, FMT = 9996 )'ZCPOSV', NFAIL, NRUN
00417       ELSE
00418          WRITE( NOUT, FMT = 9995 )'ZCPOSV', NRUN
00419       END IF
00420       IF( NERRS.GT.0 ) THEN
00421          WRITE( NOUT, FMT = 9994 )NERRS
00422       END IF
00423 *
00424  9998 FORMAT( ' UPLO=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
00425      $      I2, ', test(', I2, ') =', G12.5 )
00426  9996 FORMAT( 1X, A6, ': ', I6, ' out of ', I6,
00427      $      ' tests failed to pass the threshold' )
00428  9995 FORMAT( /1X, 'All tests for ', A6,
00429      $      ' routines passed the threshold ( ', I6, ' tests run)' )
00430  9994 FORMAT( 6X, I6, ' error messages recorded' )
00431 *
00432 *     SUBNAM, INFO, INFOE, N, IMAT
00433 *
00434  9988 FORMAT( ' *** ', A6, ' returned with INFO =', I5, ' instead of ',
00435      $      I5, / ' ==> N =', I5, ', type ',
00436      $      I2 )
00437 *
00438 *     SUBNAM, INFO, N, IMAT
00439 *
00440  9975 FORMAT( ' *** Error code from ', A6, '=', I5, ' for M=', I5,
00441      $      ', type ', I2 )
00442  8999 FORMAT( / 1X, A3, ':  positive definite dense matrices' )
00443  8979 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X,
00444      $      '2. Upper triangular', 16X,
00445      $      '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
00446      $      '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS',
00447      $      / 4X, '4. Random, CNDNUM = 2', 13X,
00448      $      '10. Scaled near underflow', / 4X, '5. First column zero',
00449      $      14X, '11. Scaled near overflow', / 4X,
00450      $      '6. Last column zero' )
00451  8960 FORMAT( 3X, I2, ': norm_1( B - A * X )  / ',
00452      $      '( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF',
00453      $      / 4x, 'or norm_1( B - A * X )  / ',
00454      $      '( norm_1(A) * norm_1(X) * EPS ) > THRES if ZPOTRF' )
00455       
00456       RETURN
00457 *
00458 *     End of ZDRVAC
00459 *
00460       END
 All Files Functions