 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DGET31( RMAX, LMAX, NINFO, KNT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 INTEGER KNT, LMAX 00009 DOUBLE PRECISION RMAX 00010 * .. 00011 * .. Array Arguments .. 00012 INTEGER NINFO( 2 ) 00013 * .. 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * DGET31 tests DLALN2, a routine for solving 00019 * 00020 * (ca A - w D)X = sB 00021 * 00022 * where A is an NA by NA matrix (NA=1 or 2 only), w is a real (NW=1) or 00023 * complex (NW=2) constant, ca is a real constant, D is an NA by NA real 00024 * diagonal matrix, and B is an NA by NW matrix (when NW=2 the second 00025 * column of B contains the imaginary part of the solution). The code 00026 * returns X and s, where s is a scale factor, less than or equal to 1, 00027 * which is chosen to avoid overflow in X. 00028 * 00029 * If any singular values of ca A-w D are less than another input 00030 * parameter SMIN, they are perturbed up to SMIN. 00031 * 00032 * The test condition is that the scaled residual 00033 * 00034 * norm( (ca A-w D)*X - s*B ) / 00035 * ( max( ulp*norm(ca A-w D), SMIN )*norm(X) ) 00036 * 00037 * should be on the order of 1. Here, ulp is the machine precision. 00038 * Also, it is verified that SCALE is less than or equal to 1, and that 00039 * XNORM = infinity-norm(X). 00040 * 00041 * Arguments 00042 * ========== 00043 * 00044 * RMAX (output) DOUBLE PRECISION 00045 * Value of the largest test ratio. 00046 * 00047 * LMAX (output) INTEGER 00048 * Example number where largest test ratio achieved. 00049 * 00050 * NINFO (output) INTEGER array, dimension (3) 00051 * NINFO(1) = number of examples with INFO less than 0 00052 * NINFO(2) = number of examples with INFO greater than 0 00053 * 00054 * KNT (output) INTEGER 00055 * Total number of examples tested. 00056 * 00057 * ===================================================================== 00058 * 00059 * .. Parameters .. 00060 DOUBLE PRECISION ZERO, HALF, ONE 00061 PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 ) 00062 DOUBLE PRECISION TWO, THREE, FOUR 00063 PARAMETER ( TWO = 2.0D0, THREE = 3.0D0, FOUR = 4.0D0 ) 00064 DOUBLE PRECISION SEVEN, TEN 00065 PARAMETER ( SEVEN = 7.0D0, TEN = 10.0D0 ) 00066 DOUBLE PRECISION TWNONE 00067 PARAMETER ( TWNONE = 21.0D0 ) 00068 * .. 00069 * .. Local Scalars .. 00070 INTEGER IA, IB, ICA, ID1, ID2, INFO, ISMIN, ITRANS, 00071 $ IWI, IWR, NA, NW 00072 DOUBLE PRECISION BIGNUM, CA, D1, D2, DEN, EPS, RES, SCALE, SMIN, 00073 $ SMLNUM, TMP, UNFL, WI, WR, XNORM 00074 * .. 00075 * .. Local Arrays .. 00076 LOGICAL LTRANS( 0: 1 ) 00077 DOUBLE PRECISION A( 2, 2 ), B( 2, 2 ), VAB( 3 ), VCA( 5 ), 00078 $ VDD( 4 ), VSMIN( 4 ), VWI( 4 ), VWR( 4 ), 00079 $ X( 2, 2 ) 00080 * .. 00081 * .. External Functions .. 00082 DOUBLE PRECISION DLAMCH 00083 EXTERNAL DLAMCH 00084 * .. 00085 * .. External Subroutines .. 00086 EXTERNAL DLABAD, DLALN2 00087 * .. 00088 * .. Intrinsic Functions .. 00089 INTRINSIC ABS, MAX, SQRT 00090 * .. 00091 * .. Data statements .. 00092 DATA LTRANS / .FALSE., .TRUE. / 00093 * .. 00094 * .. Executable Statements .. 00095 * 00096 * Get machine parameters 00097 * 00098 EPS = DLAMCH( 'P' ) 00099 UNFL = DLAMCH( 'U' ) 00100 SMLNUM = DLAMCH( 'S' ) / EPS 00101 BIGNUM = ONE / SMLNUM 00102 CALL DLABAD( SMLNUM, BIGNUM ) 00103 * 00104 * Set up test case parameters 00105 * 00106 VSMIN( 1 ) = SMLNUM 00107 VSMIN( 2 ) = EPS 00108 VSMIN( 3 ) = ONE / ( TEN*TEN ) 00109 VSMIN( 4 ) = ONE / EPS 00110 VAB( 1 ) = SQRT( SMLNUM ) 00111 VAB( 2 ) = ONE 00112 VAB( 3 ) = SQRT( BIGNUM ) 00113 VWR( 1 ) = ZERO 00114 VWR( 2 ) = HALF 00115 VWR( 3 ) = TWO 00116 VWR( 4 ) = ONE 00117 VWI( 1 ) = SMLNUM 00118 VWI( 2 ) = EPS 00119 VWI( 3 ) = ONE 00120 VWI( 4 ) = TWO 00121 VDD( 1 ) = SQRT( SMLNUM ) 00122 VDD( 2 ) = ONE 00123 VDD( 3 ) = TWO 00124 VDD( 4 ) = SQRT( BIGNUM ) 00125 VCA( 1 ) = ZERO 00126 VCA( 2 ) = SQRT( SMLNUM ) 00127 VCA( 3 ) = EPS 00128 VCA( 4 ) = HALF 00129 VCA( 5 ) = ONE 00130 * 00131 KNT = 0 00132 NINFO( 1 ) = 0 00133 NINFO( 2 ) = 0 00134 LMAX = 0 00135 RMAX = ZERO 00136 * 00137 * Begin test loop 00138 * 00139 DO 190 ID1 = 1, 4 00140 D1 = VDD( ID1 ) 00141 DO 180 ID2 = 1, 4 00142 D2 = VDD( ID2 ) 00143 DO 170 ICA = 1, 5 00144 CA = VCA( ICA ) 00145 DO 160 ITRANS = 0, 1 00146 DO 150 ISMIN = 1, 4 00147 SMIN = VSMIN( ISMIN ) 00148 * 00149 NA = 1 00150 NW = 1 00151 DO 30 IA = 1, 3 00152 A( 1, 1 ) = VAB( IA ) 00153 DO 20 IB = 1, 3 00154 B( 1, 1 ) = VAB( IB ) 00155 DO 10 IWR = 1, 4 00156 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ. 00157 $ ONE ) THEN 00158 WR = VWR( IWR )*A( 1, 1 ) 00159 ELSE 00160 WR = VWR( IWR ) 00161 END IF 00162 WI = ZERO 00163 CALL DLALN2( LTRANS( ITRANS ), NA, NW, 00164 $ SMIN, CA, A, 2, D1, D2, B, 2, 00165 $ WR, WI, X, 2, SCALE, XNORM, 00166 $ INFO ) 00167 IF( INFO.LT.0 ) 00168 $ NINFO( 1 ) = NINFO( 1 ) + 1 00169 IF( INFO.GT.0 ) 00170 $ NINFO( 2 ) = NINFO( 2 ) + 1 00171 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )* 00172 $ X( 1, 1 )-SCALE*B( 1, 1 ) ) 00173 IF( INFO.EQ.0 ) THEN 00174 DEN = MAX( EPS*( ABS( ( CA*A( 1, 00175 $ 1 )-WR*D1 )*X( 1, 1 ) ) ), 00176 $ SMLNUM ) 00177 ELSE 00178 DEN = MAX( SMIN*ABS( X( 1, 1 ) ), 00179 $ SMLNUM ) 00180 END IF 00181 RES = RES / DEN 00182 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND. 00183 $ ABS( B( 1, 1 ) ).LE.SMLNUM* 00184 $ ABS( CA*A( 1, 1 )-WR*D1 ) )RES = ZERO 00185 IF( SCALE.GT.ONE ) 00186 $ RES = RES + ONE / EPS 00187 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) 00188 $ / MAX( SMLNUM, XNORM ) / EPS 00189 IF( INFO.NE.0 .AND. INFO.NE.1 ) 00190 $ RES = RES + ONE / EPS 00191 KNT = KNT + 1 00192 IF( RES.GT.RMAX ) THEN 00193 LMAX = KNT 00194 RMAX = RES 00195 END IF 00196 10 CONTINUE 00197 20 CONTINUE 00198 30 CONTINUE 00199 * 00200 NA = 1 00201 NW = 2 00202 DO 70 IA = 1, 3 00203 A( 1, 1 ) = VAB( IA ) 00204 DO 60 IB = 1, 3 00205 B( 1, 1 ) = VAB( IB ) 00206 B( 1, 2 ) = -HALF*VAB( IB ) 00207 DO 50 IWR = 1, 4 00208 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ. 00209 $ ONE ) THEN 00210 WR = VWR( IWR )*A( 1, 1 ) 00211 ELSE 00212 WR = VWR( IWR ) 00213 END IF 00214 DO 40 IWI = 1, 4 00215 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. 00216 $ CA.EQ.ONE ) THEN 00217 WI = VWI( IWI )*A( 1, 1 ) 00218 ELSE 00219 WI = VWI( IWI ) 00220 END IF 00221 CALL DLALN2( LTRANS( ITRANS ), NA, NW, 00222 $ SMIN, CA, A, 2, D1, D2, B, 00223 $ 2, WR, WI, X, 2, SCALE, 00224 $ XNORM, INFO ) 00225 IF( INFO.LT.0 ) 00226 $ NINFO( 1 ) = NINFO( 1 ) + 1 00227 IF( INFO.GT.0 ) 00228 $ NINFO( 2 ) = NINFO( 2 ) + 1 00229 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )* 00230 $ X( 1, 1 )+( WI*D1 )*X( 1, 2 )- 00231 $ SCALE*B( 1, 1 ) ) 00232 RES = RES + ABS( ( -WI*D1 )*X( 1, 1 )+ 00233 $ ( CA*A( 1, 1 )-WR*D1 )*X( 1, 2 )- 00234 $ SCALE*B( 1, 2 ) ) 00235 IF( INFO.EQ.0 ) THEN 00236 DEN = MAX( EPS*( MAX( ABS( CA*A( 1, 00237 $ 1 )-WR*D1 ), ABS( D1*WI ) )* 00238 $ ( ABS( X( 1, 1 ) )+ABS( X( 1, 00239 $ 2 ) ) ) ), SMLNUM ) 00240 ELSE 00241 DEN = MAX( SMIN*( ABS( X( 1, 00242 $ 1 ) )+ABS( X( 1, 2 ) ) ), 00243 $ SMLNUM ) 00244 END IF 00245 RES = RES / DEN 00246 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND. 00247 $ ABS( X( 1, 2 ) ).LT.UNFL .AND. 00248 $ ABS( B( 1, 1 ) ).LE.SMLNUM* 00249 $ ABS( CA*A( 1, 1 )-WR*D1 ) ) 00250 $ RES = ZERO 00251 IF( SCALE.GT.ONE ) 00252 $ RES = RES + ONE / EPS 00253 RES = RES + ABS( XNORM- 00254 $ ABS( X( 1, 1 ) )- 00255 $ ABS( X( 1, 2 ) ) ) / 00256 $ MAX( SMLNUM, XNORM ) / EPS 00257 IF( INFO.NE.0 .AND. INFO.NE.1 ) 00258 $ RES = RES + ONE / EPS 00259 KNT = KNT + 1 00260 IF( RES.GT.RMAX ) THEN 00261 LMAX = KNT 00262 RMAX = RES 00263 END IF 00264 40 CONTINUE 00265 50 CONTINUE 00266 60 CONTINUE 00267 70 CONTINUE 00268 * 00269 NA = 2 00270 NW = 1 00271 DO 100 IA = 1, 3 00272 A( 1, 1 ) = VAB( IA ) 00273 A( 1, 2 ) = -THREE*VAB( IA ) 00274 A( 2, 1 ) = -SEVEN*VAB( IA ) 00275 A( 2, 2 ) = TWNONE*VAB( IA ) 00276 DO 90 IB = 1, 3 00277 B( 1, 1 ) = VAB( IB ) 00278 B( 2, 1 ) = -TWO*VAB( IB ) 00279 DO 80 IWR = 1, 4 00280 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ. 00281 $ ONE ) THEN 00282 WR = VWR( IWR )*A( 1, 1 ) 00283 ELSE 00284 WR = VWR( IWR ) 00285 END IF 00286 WI = ZERO 00287 CALL DLALN2( LTRANS( ITRANS ), NA, NW, 00288 $ SMIN, CA, A, 2, D1, D2, B, 2, 00289 $ WR, WI, X, 2, SCALE, XNORM, 00290 $ INFO ) 00291 IF( INFO.LT.0 ) 00292 $ NINFO( 1 ) = NINFO( 1 ) + 1 00293 IF( INFO.GT.0 ) 00294 $ NINFO( 2 ) = NINFO( 2 ) + 1 00295 IF( ITRANS.EQ.1 ) THEN 00296 TMP = A( 1, 2 ) 00297 A( 1, 2 ) = A( 2, 1 ) 00298 A( 2, 1 ) = TMP 00299 END IF 00300 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )* 00301 $ X( 1, 1 )+( CA*A( 1, 2 ) )* 00302 $ X( 2, 1 )-SCALE*B( 1, 1 ) ) 00303 RES = RES + ABS( ( CA*A( 2, 1 ) )* 00304 $ X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )* 00305 $ X( 2, 1 )-SCALE*B( 2, 1 ) ) 00306 IF( INFO.EQ.0 ) THEN 00307 DEN = MAX( EPS*( MAX( ABS( CA*A( 1, 00308 $ 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ), 00309 $ ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2, 00310 $ 2 )-WR*D2 ) )*MAX( ABS( X( 1, 00311 $ 1 ) ), ABS( X( 2, 1 ) ) ) ), 00312 $ SMLNUM ) 00313 ELSE 00314 DEN = MAX( EPS*( MAX( SMIN / EPS, 00315 $ MAX( ABS( CA*A( 1, 00316 $ 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ), 00317 $ ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2, 00318 $ 2 )-WR*D2 ) ) )*MAX( ABS( X( 1, 00319 $ 1 ) ), ABS( X( 2, 1 ) ) ) ), 00320 $ SMLNUM ) 00321 END IF 00322 RES = RES / DEN 00323 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND. 00324 $ ABS( X( 2, 1 ) ).LT.UNFL .AND. 00325 $ ABS( B( 1, 1 ) )+ABS( B( 2, 1 ) ).LE. 00326 $ SMLNUM*( ABS( CA*A( 1, 00327 $ 1 )-WR*D1 )+ABS( CA*A( 1, 00328 $ 2 ) )+ABS( CA*A( 2, 00329 $ 1 ) )+ABS( CA*A( 2, 2 )-WR*D2 ) ) ) 00330 $ RES = ZERO 00331 IF( SCALE.GT.ONE ) 00332 $ RES = RES + ONE / EPS 00333 RES = RES + ABS( XNORM- 00334 $ MAX( ABS( X( 1, 1 ) ), ABS( X( 2, 00335 $ 1 ) ) ) ) / MAX( SMLNUM, XNORM ) / 00336 $ EPS 00337 IF( INFO.NE.0 .AND. INFO.NE.1 ) 00338 $ RES = RES + ONE / EPS 00339 KNT = KNT + 1 00340 IF( RES.GT.RMAX ) THEN 00341 LMAX = KNT 00342 RMAX = RES 00343 END IF 00344 80 CONTINUE 00345 90 CONTINUE 00346 100 CONTINUE 00347 * 00348 NA = 2 00349 NW = 2 00350 DO 140 IA = 1, 3 00351 A( 1, 1 ) = VAB( IA )*TWO 00352 A( 1, 2 ) = -THREE*VAB( IA ) 00353 A( 2, 1 ) = -SEVEN*VAB( IA ) 00354 A( 2, 2 ) = TWNONE*VAB( IA ) 00355 DO 130 IB = 1, 3 00356 B( 1, 1 ) = VAB( IB ) 00357 B( 2, 1 ) = -TWO*VAB( IB ) 00358 B( 1, 2 ) = FOUR*VAB( IB ) 00359 B( 2, 2 ) = -SEVEN*VAB( IB ) 00360 DO 120 IWR = 1, 4 00361 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ. 00362 $ ONE ) THEN 00363 WR = VWR( IWR )*A( 1, 1 ) 00364 ELSE 00365 WR = VWR( IWR ) 00366 END IF 00367 DO 110 IWI = 1, 4 00368 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. 00369 $ CA.EQ.ONE ) THEN 00370 WI = VWI( IWI )*A( 1, 1 ) 00371 ELSE 00372 WI = VWI( IWI ) 00373 END IF 00374 CALL DLALN2( LTRANS( ITRANS ), NA, NW, 00375 $ SMIN, CA, A, 2, D1, D2, B, 00376 $ 2, WR, WI, X, 2, SCALE, 00377 $ XNORM, INFO ) 00378 IF( INFO.LT.0 ) 00379 $ NINFO( 1 ) = NINFO( 1 ) + 1 00380 IF( INFO.GT.0 ) 00381 $ NINFO( 2 ) = NINFO( 2 ) + 1 00382 IF( ITRANS.EQ.1 ) THEN 00383 TMP = A( 1, 2 ) 00384 A( 1, 2 ) = A( 2, 1 ) 00385 A( 2, 1 ) = TMP 00386 END IF 00387 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )* 00388 $ X( 1, 1 )+( CA*A( 1, 2 ) )* 00389 $ X( 2, 1 )+( WI*D1 )*X( 1, 2 )- 00390 $ SCALE*B( 1, 1 ) ) 00391 RES = RES + ABS( ( CA*A( 1, 00392 $ 1 )-WR*D1 )*X( 1, 2 )+ 00393 $ ( CA*A( 1, 2 ) )*X( 2, 2 )- 00394 $ ( WI*D1 )*X( 1, 1 )-SCALE* 00395 $ B( 1, 2 ) ) 00396 RES = RES + ABS( ( CA*A( 2, 1 ) )* 00397 $ X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )* 00398 $ X( 2, 1 )+( WI*D2 )*X( 2, 2 )- 00399 $ SCALE*B( 2, 1 ) ) 00400 RES = RES + ABS( ( CA*A( 2, 1 ) )* 00401 $ X( 1, 2 )+( CA*A( 2, 2 )-WR*D2 )* 00402 $ X( 2, 2 )-( WI*D2 )*X( 2, 1 )- 00403 $ SCALE*B( 2, 2 ) ) 00404 IF( INFO.EQ.0 ) THEN 00405 DEN = MAX( EPS*( MAX( ABS( CA*A( 1, 00406 $ 1 )-WR*D1 )+ABS( CA*A( 1, 00407 $ 2 ) )+ABS( WI*D1 ), 00408 $ ABS( CA*A( 2, 00409 $ 1 ) )+ABS( CA*A( 2, 00410 $ 2 )-WR*D2 )+ABS( WI*D2 ) )* 00411 $ MAX( ABS( X( 1, 00412 $ 1 ) )+ABS( X( 2, 1 ) ), 00413 $ ABS( X( 1, 2 ) )+ABS( X( 2, 00414 $ 2 ) ) ) ), SMLNUM ) 00415 ELSE 00416 DEN = MAX( EPS*( MAX( SMIN / EPS, 00417 $ MAX( ABS( CA*A( 1, 00418 $ 1 )-WR*D1 )+ABS( CA*A( 1, 00419 $ 2 ) )+ABS( WI*D1 ), 00420 $ ABS( CA*A( 2, 00421 $ 1 ) )+ABS( CA*A( 2, 00422 $ 2 )-WR*D2 )+ABS( WI*D2 ) ) )* 00423 $ MAX( ABS( X( 1, 00424 $ 1 ) )+ABS( X( 2, 1 ) ), 00425 $ ABS( X( 1, 2 ) )+ABS( X( 2, 00426 $ 2 ) ) ) ), SMLNUM ) 00427 END IF 00428 RES = RES / DEN 00429 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND. 00430 $ ABS( X( 2, 1 ) ).LT.UNFL .AND. 00431 $ ABS( X( 1, 2 ) ).LT.UNFL .AND. 00432 $ ABS( X( 2, 2 ) ).LT.UNFL .AND. 00433 $ ABS( B( 1, 1 ) )+ 00434 $ ABS( B( 2, 1 ) ).LE.SMLNUM* 00435 $ ( ABS( CA*A( 1, 1 )-WR*D1 )+ 00436 $ ABS( CA*A( 1, 2 ) )+ABS( CA*A( 2, 00437 $ 1 ) )+ABS( CA*A( 2, 00438 $ 2 )-WR*D2 )+ABS( WI*D2 )+ABS( WI* 00439 $ D1 ) ) )RES = ZERO 00440 IF( SCALE.GT.ONE ) 00441 $ RES = RES + ONE / EPS 00442 RES = RES + ABS( XNORM- 00443 $ MAX( ABS( X( 1, 1 ) )+ABS( X( 1, 00444 $ 2 ) ), ABS( X( 2, 00445 $ 1 ) )+ABS( X( 2, 2 ) ) ) ) / 00446 $ MAX( SMLNUM, XNORM ) / EPS 00447 IF( INFO.NE.0 .AND. INFO.NE.1 ) 00448 $ RES = RES + ONE / EPS 00449 KNT = KNT + 1 00450 IF( RES.GT.RMAX ) THEN 00451 LMAX = KNT 00452 RMAX = RES 00453 END IF 00454 110 CONTINUE 00455 120 CONTINUE 00456 130 CONTINUE 00457 140 CONTINUE 00458 150 CONTINUE 00459 160 CONTINUE 00460 170 CONTINUE 00461 180 CONTINUE 00462 190 CONTINUE 00463 * 00464 RETURN 00465 * 00466 * End of DGET31 00467 * 00468 END
1.7.3 
