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