1*> \brief \b DGET32 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT ) 12* 13* .. Scalar Arguments .. 14* INTEGER KNT, LMAX, NINFO 15* DOUBLE PRECISION RMAX 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> DGET32 tests DLASY2, a routine for solving 25*> 26*> op(TL)*X + ISGN*X*op(TR) = SCALE*B 27*> 28*> where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only. 29*> X and B are N1 by N2, op() is an optional transpose, an 30*> ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to 31*> avoid overflow in X. 32*> 33*> The test condition is that the scaled residual 34*> 35*> norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B ) 36*> / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM ) 37*> 38*> should be on the order of 1. Here, ulp is the machine precision. 39*> Also, it is verified that SCALE is less than or equal to 1, and 40*> that XNORM = infinity-norm(X). 41*> \endverbatim 42* 43* Arguments: 44* ========== 45* 46*> \param[out] RMAX 47*> \verbatim 48*> RMAX is DOUBLE PRECISION 49*> Value of the largest test ratio. 50*> \endverbatim 51*> 52*> \param[out] LMAX 53*> \verbatim 54*> LMAX is INTEGER 55*> Example number where largest test ratio achieved. 56*> \endverbatim 57*> 58*> \param[out] NINFO 59*> \verbatim 60*> NINFO is INTEGER 61*> Number of examples returned with INFO.NE.0. 62*> \endverbatim 63*> 64*> \param[out] KNT 65*> \verbatim 66*> KNT is INTEGER 67*> Total number of examples tested. 68*> \endverbatim 69* 70* Authors: 71* ======== 72* 73*> \author Univ. of Tennessee 74*> \author Univ. of California Berkeley 75*> \author Univ. of Colorado Denver 76*> \author NAG Ltd. 77* 78*> \ingroup double_eig 79* 80* ===================================================================== 81 SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT ) 82* 83* -- LAPACK test routine -- 84* -- LAPACK is a software package provided by Univ. of Tennessee, -- 85* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 86* 87* .. Scalar Arguments .. 88 INTEGER KNT, LMAX, NINFO 89 DOUBLE PRECISION RMAX 90* .. 91* 92* ===================================================================== 93* 94* .. Parameters .. 95 DOUBLE PRECISION ZERO, ONE 96 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 97 DOUBLE PRECISION TWO, FOUR, EIGHT 98 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0, EIGHT = 8.0D0 ) 99* .. 100* .. Local Scalars .. 101 LOGICAL LTRANL, LTRANR 102 INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL, 103 $ ITR, ITRANL, ITRANR, ITRSCL, N1, N2 104 DOUBLE PRECISION BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP, 105 $ TNRM, XNORM, XNRM 106* .. 107* .. Local Arrays .. 108 INTEGER ITVAL( 2, 2, 8 ) 109 DOUBLE PRECISION B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ), 110 $ X( 2, 2 ) 111* .. 112* .. External Functions .. 113 DOUBLE PRECISION DLAMCH 114 EXTERNAL DLAMCH 115* .. 116* .. External Subroutines .. 117 EXTERNAL DLABAD, DLASY2 118* .. 119* .. Intrinsic Functions .. 120 INTRINSIC ABS, MAX, MIN, SQRT 121* .. 122* .. Data statements .. 123 DATA ITVAL / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1, 124 $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1, 125 $ 2, 4, 9 / 126* .. 127* .. Executable Statements .. 128* 129* Get machine parameters 130* 131 EPS = DLAMCH( 'P' ) 132 SMLNUM = DLAMCH( 'S' ) / EPS 133 BIGNUM = ONE / SMLNUM 134 CALL DLABAD( SMLNUM, BIGNUM ) 135* 136* Set up test case parameters 137* 138 VAL( 1 ) = SQRT( SMLNUM ) 139 VAL( 2 ) = ONE 140 VAL( 3 ) = SQRT( BIGNUM ) 141* 142 KNT = 0 143 NINFO = 0 144 LMAX = 0 145 RMAX = ZERO 146* 147* Begin test loop 148* 149 DO 230 ITRANL = 0, 1 150 DO 220 ITRANR = 0, 1 151 DO 210 ISGN = -1, 1, 2 152 SGN = ISGN 153 LTRANL = ITRANL.EQ.1 154 LTRANR = ITRANR.EQ.1 155* 156 N1 = 1 157 N2 = 1 158 DO 30 ITL = 1, 3 159 DO 20 ITR = 1, 3 160 DO 10 IB = 1, 3 161 TL( 1, 1 ) = VAL( ITL ) 162 TR( 1, 1 ) = VAL( ITR ) 163 B( 1, 1 ) = VAL( IB ) 164 KNT = KNT + 1 165 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, 166 $ 2, TR, 2, B, 2, SCALE, X, 2, XNORM, 167 $ INFO ) 168 IF( INFO.NE.0 ) 169 $ NINFO = NINFO + 1 170 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )* 171 $ X( 1, 1 )-SCALE*B( 1, 1 ) ) 172 IF( INFO.EQ.0 ) THEN 173 DEN = MAX( EPS*( ( ABS( TR( 1, 174 $ 1 ) )+ABS( TL( 1, 1 ) ) )*ABS( X( 1, 175 $ 1 ) ) ), SMLNUM ) 176 ELSE 177 DEN = SMLNUM*MAX( ABS( X( 1, 1 ) ), ONE ) 178 END IF 179 RES = RES / DEN 180 IF( SCALE.GT.ONE ) 181 $ RES = RES + ONE / EPS 182 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) / 183 $ MAX( SMLNUM, XNORM ) / EPS 184 IF( INFO.NE.0 .AND. INFO.NE.1 ) 185 $ RES = RES + ONE / EPS 186 IF( RES.GT.RMAX ) THEN 187 LMAX = KNT 188 RMAX = RES 189 END IF 190 10 CONTINUE 191 20 CONTINUE 192 30 CONTINUE 193* 194 N1 = 2 195 N2 = 1 196 DO 80 ITL = 1, 8 197 DO 70 ITLSCL = 1, 3 198 DO 60 ITR = 1, 3 199 DO 50 IB1 = 1, 3 200 DO 40 IB2 = 1, 3 201 B( 1, 1 ) = VAL( IB1 ) 202 B( 2, 1 ) = -FOUR*VAL( IB2 ) 203 TL( 1, 1 ) = ITVAL( 1, 1, ITL )* 204 $ VAL( ITLSCL ) 205 TL( 2, 1 ) = ITVAL( 2, 1, ITL )* 206 $ VAL( ITLSCL ) 207 TL( 1, 2 ) = ITVAL( 1, 2, ITL )* 208 $ VAL( ITLSCL ) 209 TL( 2, 2 ) = ITVAL( 2, 2, ITL )* 210 $ VAL( ITLSCL ) 211 TR( 1, 1 ) = VAL( ITR ) 212 KNT = KNT + 1 213 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, 214 $ TL, 2, TR, 2, B, 2, SCALE, X, 215 $ 2, XNORM, INFO ) 216 IF( INFO.NE.0 ) 217 $ NINFO = NINFO + 1 218 IF( LTRANL ) THEN 219 TMP = TL( 1, 2 ) 220 TL( 1, 2 ) = TL( 2, 1 ) 221 TL( 2, 1 ) = TMP 222 END IF 223 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )* 224 $ X( 1, 1 )+TL( 1, 2 )*X( 2, 1 )- 225 $ SCALE*B( 1, 1 ) ) 226 RES = RES + ABS( ( TL( 2, 2 )+SGN*TR( 1, 227 $ 1 ) )*X( 2, 1 )+TL( 2, 1 )* 228 $ X( 1, 1 )-SCALE*B( 2, 1 ) ) 229 TNRM = ABS( TR( 1, 1 ) ) + 230 $ ABS( TL( 1, 1 ) ) + 231 $ ABS( TL( 1, 2 ) ) + 232 $ ABS( TL( 2, 1 ) ) + 233 $ ABS( TL( 2, 2 ) ) 234 XNRM = MAX( ABS( X( 1, 1 ) ), 235 $ ABS( X( 2, 1 ) ) ) 236 DEN = MAX( SMLNUM, SMLNUM*XNRM, 237 $ ( TNRM*EPS )*XNRM ) 238 RES = RES / DEN 239 IF( SCALE.GT.ONE ) 240 $ RES = RES + ONE / EPS 241 RES = RES + ABS( XNORM-XNRM ) / 242 $ MAX( SMLNUM, XNORM ) / EPS 243 IF( RES.GT.RMAX ) THEN 244 LMAX = KNT 245 RMAX = RES 246 END IF 247 40 CONTINUE 248 50 CONTINUE 249 60 CONTINUE 250 70 CONTINUE 251 80 CONTINUE 252* 253 N1 = 1 254 N2 = 2 255 DO 130 ITR = 1, 8 256 DO 120 ITRSCL = 1, 3 257 DO 110 ITL = 1, 3 258 DO 100 IB1 = 1, 3 259 DO 90 IB2 = 1, 3 260 B( 1, 1 ) = VAL( IB1 ) 261 B( 1, 2 ) = -TWO*VAL( IB2 ) 262 TR( 1, 1 ) = ITVAL( 1, 1, ITR )* 263 $ VAL( ITRSCL ) 264 TR( 2, 1 ) = ITVAL( 2, 1, ITR )* 265 $ VAL( ITRSCL ) 266 TR( 1, 2 ) = ITVAL( 1, 2, ITR )* 267 $ VAL( ITRSCL ) 268 TR( 2, 2 ) = ITVAL( 2, 2, ITR )* 269 $ VAL( ITRSCL ) 270 TL( 1, 1 ) = VAL( ITL ) 271 KNT = KNT + 1 272 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, 273 $ TL, 2, TR, 2, B, 2, SCALE, X, 274 $ 2, XNORM, INFO ) 275 IF( INFO.NE.0 ) 276 $ NINFO = NINFO + 1 277 IF( LTRANR ) THEN 278 TMP = TR( 1, 2 ) 279 TR( 1, 2 ) = TR( 2, 1 ) 280 TR( 2, 1 ) = TMP 281 END IF 282 TNRM = ABS( TL( 1, 1 ) ) + 283 $ ABS( TR( 1, 1 ) ) + 284 $ ABS( TR( 1, 2 ) ) + 285 $ ABS( TR( 2, 2 ) ) + 286 $ ABS( TR( 2, 1 ) ) 287 XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) ) 288 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1, 289 $ 1 ) ) )*( X( 1, 1 ) )+ 290 $ ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )- 291 $ ( SCALE*B( 1, 1 ) ) ) 292 RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2, 293 $ 2 ) ) )*( X( 1, 2 ) )+ 294 $ ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )- 295 $ ( SCALE*B( 1, 2 ) ) ) 296 DEN = MAX( SMLNUM, SMLNUM*XNRM, 297 $ ( TNRM*EPS )*XNRM ) 298 RES = RES / DEN 299 IF( SCALE.GT.ONE ) 300 $ RES = RES + ONE / EPS 301 RES = RES + ABS( XNORM-XNRM ) / 302 $ MAX( SMLNUM, XNORM ) / EPS 303 IF( RES.GT.RMAX ) THEN 304 LMAX = KNT 305 RMAX = RES 306 END IF 307 90 CONTINUE 308 100 CONTINUE 309 110 CONTINUE 310 120 CONTINUE 311 130 CONTINUE 312* 313 N1 = 2 314 N2 = 2 315 DO 200 ITR = 1, 8 316 DO 190 ITRSCL = 1, 3 317 DO 180 ITL = 1, 8 318 DO 170 ITLSCL = 1, 3 319 DO 160 IB1 = 1, 3 320 DO 150 IB2 = 1, 3 321 DO 140 IB3 = 1, 3 322 B( 1, 1 ) = VAL( IB1 ) 323 B( 2, 1 ) = -FOUR*VAL( IB2 ) 324 B( 1, 2 ) = -TWO*VAL( IB3 ) 325 B( 2, 2 ) = EIGHT* 326 $ MIN( VAL( IB1 ), VAL 327 $ ( IB2 ), VAL( IB3 ) ) 328 TR( 1, 1 ) = ITVAL( 1, 1, ITR )* 329 $ VAL( ITRSCL ) 330 TR( 2, 1 ) = ITVAL( 2, 1, ITR )* 331 $ VAL( ITRSCL ) 332 TR( 1, 2 ) = ITVAL( 1, 2, ITR )* 333 $ VAL( ITRSCL ) 334 TR( 2, 2 ) = ITVAL( 2, 2, ITR )* 335 $ VAL( ITRSCL ) 336 TL( 1, 1 ) = ITVAL( 1, 1, ITL )* 337 $ VAL( ITLSCL ) 338 TL( 2, 1 ) = ITVAL( 2, 1, ITL )* 339 $ VAL( ITLSCL ) 340 TL( 1, 2 ) = ITVAL( 1, 2, ITL )* 341 $ VAL( ITLSCL ) 342 TL( 2, 2 ) = ITVAL( 2, 2, ITL )* 343 $ VAL( ITLSCL ) 344 KNT = KNT + 1 345 CALL DLASY2( LTRANL, LTRANR, ISGN, 346 $ N1, N2, TL, 2, TR, 2, 347 $ B, 2, SCALE, X, 2, 348 $ XNORM, INFO ) 349 IF( INFO.NE.0 ) 350 $ NINFO = NINFO + 1 351 IF( LTRANR ) THEN 352 TMP = TR( 1, 2 ) 353 TR( 1, 2 ) = TR( 2, 1 ) 354 TR( 2, 1 ) = TMP 355 END IF 356 IF( LTRANL ) THEN 357 TMP = TL( 1, 2 ) 358 TL( 1, 2 ) = TL( 2, 1 ) 359 TL( 2, 1 ) = TMP 360 END IF 361 TNRM = ABS( TR( 1, 1 ) ) + 362 $ ABS( TR( 2, 1 ) ) + 363 $ ABS( TR( 1, 2 ) ) + 364 $ ABS( TR( 2, 2 ) ) + 365 $ ABS( TL( 1, 1 ) ) + 366 $ ABS( TL( 2, 1 ) ) + 367 $ ABS( TL( 1, 2 ) ) + 368 $ ABS( TL( 2, 2 ) ) 369 XNRM = MAX( ABS( X( 1, 1 ) )+ 370 $ ABS( X( 1, 2 ) ), 371 $ ABS( X( 2, 1 ) )+ 372 $ ABS( X( 2, 2 ) ) ) 373 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1, 374 $ 1 ) ) )*( X( 1, 1 ) )+ 375 $ ( SGN*TR( 2, 1 ) )* 376 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )* 377 $ ( X( 2, 1 ) )- 378 $ ( SCALE*B( 1, 1 ) ) ) 379 RES = RES + ABS( ( TL( 1, 1 ) )* 380 $ ( X( 1, 2 ) )+ 381 $ ( SGN*TR( 1, 2 ) )* 382 $ ( X( 1, 1 ) )+ 383 $ ( SGN*TR( 2, 2 ) )* 384 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )* 385 $ ( X( 2, 2 ) )- 386 $ ( SCALE*B( 1, 2 ) ) ) 387 RES = RES + ABS( ( TL( 2, 1 ) )* 388 $ ( X( 1, 1 ) )+ 389 $ ( SGN*TR( 1, 1 ) )* 390 $ ( X( 2, 1 ) )+ 391 $ ( SGN*TR( 2, 1 ) )* 392 $ ( X( 2, 2 ) )+( TL( 2, 2 ) )* 393 $ ( X( 2, 1 ) )- 394 $ ( SCALE*B( 2, 1 ) ) ) 395 RES = RES + ABS( ( ( TL( 2, 396 $ 2 )+SGN*TR( 2, 2 ) ) )* 397 $ ( X( 2, 2 ) )+ 398 $ ( SGN*TR( 1, 2 ) )* 399 $ ( X( 2, 1 ) )+( TL( 2, 1 ) )* 400 $ ( X( 1, 2 ) )- 401 $ ( SCALE*B( 2, 2 ) ) ) 402 DEN = MAX( SMLNUM, SMLNUM*XNRM, 403 $ ( TNRM*EPS )*XNRM ) 404 RES = RES / DEN 405 IF( SCALE.GT.ONE ) 406 $ RES = RES + ONE / EPS 407 RES = RES + ABS( XNORM-XNRM ) / 408 $ MAX( SMLNUM, XNORM ) / EPS 409 IF( RES.GT.RMAX ) THEN 410 LMAX = KNT 411 RMAX = RES 412 END IF 413 140 CONTINUE 414 150 CONTINUE 415 160 CONTINUE 416 170 CONTINUE 417 180 CONTINUE 418 190 CONTINUE 419 200 CONTINUE 420 210 CONTINUE 421 220 CONTINUE 422 230 CONTINUE 423* 424 RETURN 425* 426* End of DGET32 427* 428 END 429