00001 SUBROUTINE SGET32( RMAX, LMAX, NINFO, KNT )
00002
00003
00004
00005
00006
00007
00008 INTEGER KNT, LMAX, NINFO
00009 REAL RMAX
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
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
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
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
00069 REAL SLAMCH
00070 EXTERNAL SLAMCH
00071
00072
00073 EXTERNAL SLABAD, SLASY2
00074
00075
00076 INTRINSIC ABS, MAX, MIN, SQRT
00077
00078
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
00084
00085
00086
00087 EPS = SLAMCH( 'P' )
00088 SMLNUM = SLAMCH( 'S' ) / EPS
00089 BIGNUM = ONE / SMLNUM
00090 CALL SLABAD( SMLNUM, BIGNUM )
00091
00092
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
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
00383
00384 END