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