![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DGET32 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 DGET32( RMAX, LMAX, NINFO, KNT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER KNT, LMAX, NINFO 00015 * DOUBLE PRECISION RMAX 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> DGET32 tests DLASY2, a routine for solving 00025 *> 00026 *> op(TL)*X + ISGN*X*op(TR) = SCALE*B 00027 *> 00028 *> where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only. 00029 *> X and B are N1 by N2, op() is an optional transpose, an 00030 *> ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to 00031 *> avoid overflow in X. 00032 *> 00033 *> The test condition is that the scaled residual 00034 *> 00035 *> norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B ) 00036 *> / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM ) 00037 *> 00038 *> should be on the order of 1. Here, ulp is the machine precision. 00039 *> Also, it is verified that SCALE is less than or equal to 1, and 00040 *> that XNORM = infinity-norm(X). 00041 *> \endverbatim 00042 * 00043 * Arguments: 00044 * ========== 00045 * 00046 *> \param[out] RMAX 00047 *> \verbatim 00048 *> RMAX is DOUBLE PRECISION 00049 *> Value of the largest test ratio. 00050 *> \endverbatim 00051 *> 00052 *> \param[out] LMAX 00053 *> \verbatim 00054 *> LMAX is INTEGER 00055 *> Example number where largest test ratio achieved. 00056 *> \endverbatim 00057 *> 00058 *> \param[out] NINFO 00059 *> \verbatim 00060 *> NINFO is INTEGER 00061 *> Number of examples returned with INFO.NE.0. 00062 *> \endverbatim 00063 *> 00064 *> \param[out] KNT 00065 *> \verbatim 00066 *> KNT is INTEGER 00067 *> Total number of examples tested. 00068 *> \endverbatim 00069 * 00070 * Authors: 00071 * ======== 00072 * 00073 *> \author Univ. of Tennessee 00074 *> \author Univ. of California Berkeley 00075 *> \author Univ. of Colorado Denver 00076 *> \author NAG Ltd. 00077 * 00078 *> \date November 2011 00079 * 00080 *> \ingroup double_eig 00081 * 00082 * ===================================================================== 00083 SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT ) 00084 * 00085 * -- LAPACK test routine (version 3.4.0) -- 00086 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00087 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00088 * November 2011 00089 * 00090 * .. Scalar Arguments .. 00091 INTEGER KNT, LMAX, NINFO 00092 DOUBLE PRECISION RMAX 00093 * .. 00094 * 00095 * ===================================================================== 00096 * 00097 * .. Parameters .. 00098 DOUBLE PRECISION ZERO, ONE 00099 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00100 DOUBLE PRECISION TWO, FOUR, EIGHT 00101 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0, EIGHT = 8.0D0 ) 00102 * .. 00103 * .. Local Scalars .. 00104 LOGICAL LTRANL, LTRANR 00105 INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL, 00106 $ ITR, ITRANL, ITRANR, ITRSCL, N1, N2 00107 DOUBLE PRECISION BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP, 00108 $ TNRM, XNORM, XNRM 00109 * .. 00110 * .. Local Arrays .. 00111 INTEGER ITVAL( 2, 2, 8 ) 00112 DOUBLE PRECISION B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ), 00113 $ X( 2, 2 ) 00114 * .. 00115 * .. External Functions .. 00116 DOUBLE PRECISION DLAMCH 00117 EXTERNAL DLAMCH 00118 * .. 00119 * .. External Subroutines .. 00120 EXTERNAL DLABAD, DLASY2 00121 * .. 00122 * .. Intrinsic Functions .. 00123 INTRINSIC ABS, MAX, MIN, SQRT 00124 * .. 00125 * .. Data statements .. 00126 DATA ITVAL / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1, 00127 $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1, 00128 $ 2, 4, 9 / 00129 * .. 00130 * .. Executable Statements .. 00131 * 00132 * Get machine parameters 00133 * 00134 EPS = DLAMCH( 'P' ) 00135 SMLNUM = DLAMCH( 'S' ) / EPS 00136 BIGNUM = ONE / SMLNUM 00137 CALL DLABAD( SMLNUM, BIGNUM ) 00138 * 00139 * Set up test case parameters 00140 * 00141 VAL( 1 ) = SQRT( SMLNUM ) 00142 VAL( 2 ) = ONE 00143 VAL( 3 ) = SQRT( BIGNUM ) 00144 * 00145 KNT = 0 00146 NINFO = 0 00147 LMAX = 0 00148 RMAX = ZERO 00149 * 00150 * Begin test loop 00151 * 00152 DO 230 ITRANL = 0, 1 00153 DO 220 ITRANR = 0, 1 00154 DO 210 ISGN = -1, 1, 2 00155 SGN = ISGN 00156 LTRANL = ITRANL.EQ.1 00157 LTRANR = ITRANR.EQ.1 00158 * 00159 N1 = 1 00160 N2 = 1 00161 DO 30 ITL = 1, 3 00162 DO 20 ITR = 1, 3 00163 DO 10 IB = 1, 3 00164 TL( 1, 1 ) = VAL( ITL ) 00165 TR( 1, 1 ) = VAL( ITR ) 00166 B( 1, 1 ) = VAL( IB ) 00167 KNT = KNT + 1 00168 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, 00169 $ 2, TR, 2, B, 2, SCALE, X, 2, XNORM, 00170 $ INFO ) 00171 IF( INFO.NE.0 ) 00172 $ NINFO = NINFO + 1 00173 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )* 00174 $ X( 1, 1 )-SCALE*B( 1, 1 ) ) 00175 IF( INFO.EQ.0 ) THEN 00176 DEN = MAX( EPS*( ( ABS( TR( 1, 00177 $ 1 ) )+ABS( TL( 1, 1 ) ) )*ABS( X( 1, 00178 $ 1 ) ) ), SMLNUM ) 00179 ELSE 00180 DEN = SMLNUM*MAX( ABS( X( 1, 1 ) ), ONE ) 00181 END IF 00182 RES = RES / DEN 00183 IF( SCALE.GT.ONE ) 00184 $ RES = RES + ONE / EPS 00185 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) / 00186 $ MAX( SMLNUM, XNORM ) / EPS 00187 IF( INFO.NE.0 .AND. INFO.NE.1 ) 00188 $ RES = RES + ONE / EPS 00189 IF( RES.GT.RMAX ) THEN 00190 LMAX = KNT 00191 RMAX = RES 00192 END IF 00193 10 CONTINUE 00194 20 CONTINUE 00195 30 CONTINUE 00196 * 00197 N1 = 2 00198 N2 = 1 00199 DO 80 ITL = 1, 8 00200 DO 70 ITLSCL = 1, 3 00201 DO 60 ITR = 1, 3 00202 DO 50 IB1 = 1, 3 00203 DO 40 IB2 = 1, 3 00204 B( 1, 1 ) = VAL( IB1 ) 00205 B( 2, 1 ) = -FOUR*VAL( IB2 ) 00206 TL( 1, 1 ) = ITVAL( 1, 1, ITL )* 00207 $ VAL( ITLSCL ) 00208 TL( 2, 1 ) = ITVAL( 2, 1, ITL )* 00209 $ VAL( ITLSCL ) 00210 TL( 1, 2 ) = ITVAL( 1, 2, ITL )* 00211 $ VAL( ITLSCL ) 00212 TL( 2, 2 ) = ITVAL( 2, 2, ITL )* 00213 $ VAL( ITLSCL ) 00214 TR( 1, 1 ) = VAL( ITR ) 00215 KNT = KNT + 1 00216 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, 00217 $ TL, 2, TR, 2, B, 2, SCALE, X, 00218 $ 2, XNORM, INFO ) 00219 IF( INFO.NE.0 ) 00220 $ NINFO = NINFO + 1 00221 IF( LTRANL ) THEN 00222 TMP = TL( 1, 2 ) 00223 TL( 1, 2 ) = TL( 2, 1 ) 00224 TL( 2, 1 ) = TMP 00225 END IF 00226 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )* 00227 $ X( 1, 1 )+TL( 1, 2 )*X( 2, 1 )- 00228 $ SCALE*B( 1, 1 ) ) 00229 RES = RES + ABS( ( TL( 2, 2 )+SGN*TR( 1, 00230 $ 1 ) )*X( 2, 1 )+TL( 2, 1 )* 00231 $ X( 1, 1 )-SCALE*B( 2, 1 ) ) 00232 TNRM = ABS( TR( 1, 1 ) ) + 00233 $ ABS( TL( 1, 1 ) ) + 00234 $ ABS( TL( 1, 2 ) ) + 00235 $ ABS( TL( 2, 1 ) ) + 00236 $ ABS( TL( 2, 2 ) ) 00237 XNRM = MAX( ABS( X( 1, 1 ) ), 00238 $ ABS( X( 2, 1 ) ) ) 00239 DEN = MAX( SMLNUM, SMLNUM*XNRM, 00240 $ ( TNRM*EPS )*XNRM ) 00241 RES = RES / DEN 00242 IF( SCALE.GT.ONE ) 00243 $ RES = RES + ONE / EPS 00244 RES = RES + ABS( XNORM-XNRM ) / 00245 $ MAX( SMLNUM, XNORM ) / EPS 00246 IF( RES.GT.RMAX ) THEN 00247 LMAX = KNT 00248 RMAX = RES 00249 END IF 00250 40 CONTINUE 00251 50 CONTINUE 00252 60 CONTINUE 00253 70 CONTINUE 00254 80 CONTINUE 00255 * 00256 N1 = 1 00257 N2 = 2 00258 DO 130 ITR = 1, 8 00259 DO 120 ITRSCL = 1, 3 00260 DO 110 ITL = 1, 3 00261 DO 100 IB1 = 1, 3 00262 DO 90 IB2 = 1, 3 00263 B( 1, 1 ) = VAL( IB1 ) 00264 B( 1, 2 ) = -TWO*VAL( IB2 ) 00265 TR( 1, 1 ) = ITVAL( 1, 1, ITR )* 00266 $ VAL( ITRSCL ) 00267 TR( 2, 1 ) = ITVAL( 2, 1, ITR )* 00268 $ VAL( ITRSCL ) 00269 TR( 1, 2 ) = ITVAL( 1, 2, ITR )* 00270 $ VAL( ITRSCL ) 00271 TR( 2, 2 ) = ITVAL( 2, 2, ITR )* 00272 $ VAL( ITRSCL ) 00273 TL( 1, 1 ) = VAL( ITL ) 00274 KNT = KNT + 1 00275 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, 00276 $ TL, 2, TR, 2, B, 2, SCALE, X, 00277 $ 2, XNORM, INFO ) 00278 IF( INFO.NE.0 ) 00279 $ NINFO = NINFO + 1 00280 IF( LTRANR ) THEN 00281 TMP = TR( 1, 2 ) 00282 TR( 1, 2 ) = TR( 2, 1 ) 00283 TR( 2, 1 ) = TMP 00284 END IF 00285 TNRM = ABS( TL( 1, 1 ) ) + 00286 $ ABS( TR( 1, 1 ) ) + 00287 $ ABS( TR( 1, 2 ) ) + 00288 $ ABS( TR( 2, 2 ) ) + 00289 $ ABS( TR( 2, 1 ) ) 00290 XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) ) 00291 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1, 00292 $ 1 ) ) )*( X( 1, 1 ) )+ 00293 $ ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )- 00294 $ ( SCALE*B( 1, 1 ) ) ) 00295 RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2, 00296 $ 2 ) ) )*( X( 1, 2 ) )+ 00297 $ ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )- 00298 $ ( SCALE*B( 1, 2 ) ) ) 00299 DEN = MAX( SMLNUM, SMLNUM*XNRM, 00300 $ ( TNRM*EPS )*XNRM ) 00301 RES = RES / DEN 00302 IF( SCALE.GT.ONE ) 00303 $ RES = RES + ONE / EPS 00304 RES = RES + ABS( XNORM-XNRM ) / 00305 $ MAX( SMLNUM, XNORM ) / EPS 00306 IF( RES.GT.RMAX ) THEN 00307 LMAX = KNT 00308 RMAX = RES 00309 END IF 00310 90 CONTINUE 00311 100 CONTINUE 00312 110 CONTINUE 00313 120 CONTINUE 00314 130 CONTINUE 00315 * 00316 N1 = 2 00317 N2 = 2 00318 DO 200 ITR = 1, 8 00319 DO 190 ITRSCL = 1, 3 00320 DO 180 ITL = 1, 8 00321 DO 170 ITLSCL = 1, 3 00322 DO 160 IB1 = 1, 3 00323 DO 150 IB2 = 1, 3 00324 DO 140 IB3 = 1, 3 00325 B( 1, 1 ) = VAL( IB1 ) 00326 B( 2, 1 ) = -FOUR*VAL( IB2 ) 00327 B( 1, 2 ) = -TWO*VAL( IB3 ) 00328 B( 2, 2 ) = EIGHT* 00329 $ MIN( VAL( IB1 ), VAL 00330 $ ( IB2 ), VAL( IB3 ) ) 00331 TR( 1, 1 ) = ITVAL( 1, 1, ITR )* 00332 $ VAL( ITRSCL ) 00333 TR( 2, 1 ) = ITVAL( 2, 1, ITR )* 00334 $ VAL( ITRSCL ) 00335 TR( 1, 2 ) = ITVAL( 1, 2, ITR )* 00336 $ VAL( ITRSCL ) 00337 TR( 2, 2 ) = ITVAL( 2, 2, ITR )* 00338 $ VAL( ITRSCL ) 00339 TL( 1, 1 ) = ITVAL( 1, 1, ITL )* 00340 $ VAL( ITLSCL ) 00341 TL( 2, 1 ) = ITVAL( 2, 1, ITL )* 00342 $ VAL( ITLSCL ) 00343 TL( 1, 2 ) = ITVAL( 1, 2, ITL )* 00344 $ VAL( ITLSCL ) 00345 TL( 2, 2 ) = ITVAL( 2, 2, ITL )* 00346 $ VAL( ITLSCL ) 00347 KNT = KNT + 1 00348 CALL DLASY2( LTRANL, LTRANR, ISGN, 00349 $ N1, N2, TL, 2, TR, 2, 00350 $ B, 2, SCALE, X, 2, 00351 $ XNORM, INFO ) 00352 IF( INFO.NE.0 ) 00353 $ NINFO = NINFO + 1 00354 IF( LTRANR ) THEN 00355 TMP = TR( 1, 2 ) 00356 TR( 1, 2 ) = TR( 2, 1 ) 00357 TR( 2, 1 ) = TMP 00358 END IF 00359 IF( LTRANL ) THEN 00360 TMP = TL( 1, 2 ) 00361 TL( 1, 2 ) = TL( 2, 1 ) 00362 TL( 2, 1 ) = TMP 00363 END IF 00364 TNRM = ABS( TR( 1, 1 ) ) + 00365 $ ABS( TR( 2, 1 ) ) + 00366 $ ABS( TR( 1, 2 ) ) + 00367 $ ABS( TR( 2, 2 ) ) + 00368 $ ABS( TL( 1, 1 ) ) + 00369 $ ABS( TL( 2, 1 ) ) + 00370 $ ABS( TL( 1, 2 ) ) + 00371 $ ABS( TL( 2, 2 ) ) 00372 XNRM = MAX( ABS( X( 1, 1 ) )+ 00373 $ ABS( X( 1, 2 ) ), 00374 $ ABS( X( 2, 1 ) )+ 00375 $ ABS( X( 2, 2 ) ) ) 00376 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1, 00377 $ 1 ) ) )*( X( 1, 1 ) )+ 00378 $ ( SGN*TR( 2, 1 ) )* 00379 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )* 00380 $ ( X( 2, 1 ) )- 00381 $ ( SCALE*B( 1, 1 ) ) ) 00382 RES = RES + ABS( ( TL( 1, 1 ) )* 00383 $ ( X( 1, 2 ) )+ 00384 $ ( SGN*TR( 1, 2 ) )* 00385 $ ( X( 1, 1 ) )+ 00386 $ ( SGN*TR( 2, 2 ) )* 00387 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )* 00388 $ ( X( 2, 2 ) )- 00389 $ ( SCALE*B( 1, 2 ) ) ) 00390 RES = RES + ABS( ( TL( 2, 1 ) )* 00391 $ ( X( 1, 1 ) )+ 00392 $ ( SGN*TR( 1, 1 ) )* 00393 $ ( X( 2, 1 ) )+ 00394 $ ( SGN*TR( 2, 1 ) )* 00395 $ ( X( 2, 2 ) )+( TL( 2, 2 ) )* 00396 $ ( X( 2, 1 ) )- 00397 $ ( SCALE*B( 2, 1 ) ) ) 00398 RES = RES + ABS( ( ( TL( 2, 00399 $ 2 )+SGN*TR( 2, 2 ) ) )* 00400 $ ( X( 2, 2 ) )+ 00401 $ ( SGN*TR( 1, 2 ) )* 00402 $ ( X( 2, 1 ) )+( TL( 2, 1 ) )* 00403 $ ( X( 1, 2 ) )- 00404 $ ( SCALE*B( 2, 2 ) ) ) 00405 DEN = MAX( SMLNUM, SMLNUM*XNRM, 00406 $ ( TNRM*EPS )*XNRM ) 00407 RES = RES / DEN 00408 IF( SCALE.GT.ONE ) 00409 $ RES = RES + ONE / EPS 00410 RES = RES + ABS( XNORM-XNRM ) / 00411 $ MAX( SMLNUM, XNORM ) / EPS 00412 IF( RES.GT.RMAX ) THEN 00413 LMAX = KNT 00414 RMAX = RES 00415 END IF 00416 140 CONTINUE 00417 150 CONTINUE 00418 160 CONTINUE 00419 170 CONTINUE 00420 180 CONTINUE 00421 190 CONTINUE 00422 200 CONTINUE 00423 210 CONTINUE 00424 220 CONTINUE 00425 230 CONTINUE 00426 * 00427 RETURN 00428 * 00429 * End of DGET32 00430 * 00431 END