![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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