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*> \date November 2011 79* 80*> \ingroup double_eig 81* 82* ===================================================================== 83 SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT ) 84* 85* -- LAPACK test routine (version 3.4.0) -- 86* -- LAPACK is a software package provided by Univ. of Tennessee, -- 87* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 88* November 2011 89* 90* .. Scalar Arguments .. 91 INTEGER KNT, LMAX, NINFO 92 DOUBLE PRECISION RMAX 93* .. 94* 95* ===================================================================== 96* 97* .. Parameters .. 98 DOUBLE PRECISION ZERO, ONE 99 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 100 DOUBLE PRECISION TWO, FOUR, EIGHT 101 PARAMETER ( TWO = 2.0D0, FOUR = 4.0D0, EIGHT = 8.0D0 ) 102* .. 103* .. Local Scalars .. 104 LOGICAL LTRANL, LTRANR 105 INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL, 106 $ ITR, ITRANL, ITRANR, ITRSCL, N1, N2 107 DOUBLE PRECISION BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP, 108 $ TNRM, XNORM, XNRM 109* .. 110* .. Local Arrays .. 111 INTEGER ITVAL( 2, 2, 8 ) 112 DOUBLE PRECISION B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ), 113 $ X( 2, 2 ) 114* .. 115* .. External Functions .. 116 DOUBLE PRECISION DLAMCH 117 EXTERNAL DLAMCH 118* .. 119* .. External Subroutines .. 120 EXTERNAL DLABAD, DLASY2 121* .. 122* .. Intrinsic Functions .. 123 INTRINSIC ABS, MAX, MIN, SQRT 124* .. 125* .. Data statements .. 126 DATA ITVAL / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1, 127 $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1, 128 $ 2, 4, 9 / 129* .. 130* .. Executable Statements .. 131* 132* Get machine parameters 133* 134 EPS = DLAMCH( 'P' ) 135 SMLNUM = DLAMCH( 'S' ) / EPS 136 BIGNUM = ONE / SMLNUM 137 CALL DLABAD( SMLNUM, BIGNUM ) 138* 139* Set up test case parameters 140* 141 VAL( 1 ) = SQRT( SMLNUM ) 142 VAL( 2 ) = ONE 143 VAL( 3 ) = SQRT( BIGNUM ) 144* 145 KNT = 0 146 NINFO = 0 147 LMAX = 0 148 RMAX = ZERO 149* 150* Begin test loop 151* 152 DO 230 ITRANL = 0, 1 153 DO 220 ITRANR = 0, 1 154 DO 210 ISGN = -1, 1, 2 155 SGN = ISGN 156 LTRANL = ITRANL.EQ.1 157 LTRANR = ITRANR.EQ.1 158* 159 N1 = 1 160 N2 = 1 161 DO 30 ITL = 1, 3 162 DO 20 ITR = 1, 3 163 DO 10 IB = 1, 3 164 TL( 1, 1 ) = VAL( ITL ) 165 TR( 1, 1 ) = VAL( ITR ) 166 B( 1, 1 ) = VAL( IB ) 167 KNT = KNT + 1 168 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, 169 $ 2, TR, 2, B, 2, SCALE, X, 2, XNORM, 170 $ INFO ) 171 IF( INFO.NE.0 ) 172 $ NINFO = NINFO + 1 173 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )* 174 $ X( 1, 1 )-SCALE*B( 1, 1 ) ) 175 IF( INFO.EQ.0 ) THEN 176 DEN = MAX( EPS*( ( ABS( TR( 1, 177 $ 1 ) )+ABS( TL( 1, 1 ) ) )*ABS( X( 1, 178 $ 1 ) ) ), SMLNUM ) 179 ELSE 180 DEN = SMLNUM*MAX( ABS( X( 1, 1 ) ), ONE ) 181 END IF 182 RES = RES / DEN 183 IF( SCALE.GT.ONE ) 184 $ RES = RES + ONE / EPS 185 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) / 186 $ MAX( SMLNUM, XNORM ) / EPS 187 IF( INFO.NE.0 .AND. INFO.NE.1 ) 188 $ RES = RES + ONE / EPS 189 IF( RES.GT.RMAX ) THEN 190 LMAX = KNT 191 RMAX = RES 192 END IF 193 10 CONTINUE 194 20 CONTINUE 195 30 CONTINUE 196* 197 N1 = 2 198 N2 = 1 199 DO 80 ITL = 1, 8 200 DO 70 ITLSCL = 1, 3 201 DO 60 ITR = 1, 3 202 DO 50 IB1 = 1, 3 203 DO 40 IB2 = 1, 3 204 B( 1, 1 ) = VAL( IB1 ) 205 B( 2, 1 ) = -FOUR*VAL( IB2 ) 206 TL( 1, 1 ) = ITVAL( 1, 1, ITL )* 207 $ VAL( ITLSCL ) 208 TL( 2, 1 ) = ITVAL( 2, 1, ITL )* 209 $ VAL( ITLSCL ) 210 TL( 1, 2 ) = ITVAL( 1, 2, ITL )* 211 $ VAL( ITLSCL ) 212 TL( 2, 2 ) = ITVAL( 2, 2, ITL )* 213 $ VAL( ITLSCL ) 214 TR( 1, 1 ) = VAL( ITR ) 215 KNT = KNT + 1 216 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, 217 $ TL, 2, TR, 2, B, 2, SCALE, X, 218 $ 2, XNORM, INFO ) 219 IF( INFO.NE.0 ) 220 $ NINFO = NINFO + 1 221 IF( LTRANL ) THEN 222 TMP = TL( 1, 2 ) 223 TL( 1, 2 ) = TL( 2, 1 ) 224 TL( 2, 1 ) = TMP 225 END IF 226 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )* 227 $ X( 1, 1 )+TL( 1, 2 )*X( 2, 1 )- 228 $ SCALE*B( 1, 1 ) ) 229 RES = RES + ABS( ( TL( 2, 2 )+SGN*TR( 1, 230 $ 1 ) )*X( 2, 1 )+TL( 2, 1 )* 231 $ X( 1, 1 )-SCALE*B( 2, 1 ) ) 232 TNRM = ABS( TR( 1, 1 ) ) + 233 $ ABS( TL( 1, 1 ) ) + 234 $ ABS( TL( 1, 2 ) ) + 235 $ ABS( TL( 2, 1 ) ) + 236 $ ABS( TL( 2, 2 ) ) 237 XNRM = MAX( ABS( X( 1, 1 ) ), 238 $ ABS( X( 2, 1 ) ) ) 239 DEN = MAX( SMLNUM, SMLNUM*XNRM, 240 $ ( TNRM*EPS )*XNRM ) 241 RES = RES / DEN 242 IF( SCALE.GT.ONE ) 243 $ RES = RES + ONE / EPS 244 RES = RES + ABS( XNORM-XNRM ) / 245 $ MAX( SMLNUM, XNORM ) / EPS 246 IF( RES.GT.RMAX ) THEN 247 LMAX = KNT 248 RMAX = RES 249 END IF 250 40 CONTINUE 251 50 CONTINUE 252 60 CONTINUE 253 70 CONTINUE 254 80 CONTINUE 255* 256 N1 = 1 257 N2 = 2 258 DO 130 ITR = 1, 8 259 DO 120 ITRSCL = 1, 3 260 DO 110 ITL = 1, 3 261 DO 100 IB1 = 1, 3 262 DO 90 IB2 = 1, 3 263 B( 1, 1 ) = VAL( IB1 ) 264 B( 1, 2 ) = -TWO*VAL( IB2 ) 265 TR( 1, 1 ) = ITVAL( 1, 1, ITR )* 266 $ VAL( ITRSCL ) 267 TR( 2, 1 ) = ITVAL( 2, 1, ITR )* 268 $ VAL( ITRSCL ) 269 TR( 1, 2 ) = ITVAL( 1, 2, ITR )* 270 $ VAL( ITRSCL ) 271 TR( 2, 2 ) = ITVAL( 2, 2, ITR )* 272 $ VAL( ITRSCL ) 273 TL( 1, 1 ) = VAL( ITL ) 274 KNT = KNT + 1 275 CALL DLASY2( LTRANL, LTRANR, ISGN, N1, N2, 276 $ TL, 2, TR, 2, B, 2, SCALE, X, 277 $ 2, XNORM, INFO ) 278 IF( INFO.NE.0 ) 279 $ NINFO = NINFO + 1 280 IF( LTRANR ) THEN 281 TMP = TR( 1, 2 ) 282 TR( 1, 2 ) = TR( 2, 1 ) 283 TR( 2, 1 ) = TMP 284 END IF 285 TNRM = ABS( TL( 1, 1 ) ) + 286 $ ABS( TR( 1, 1 ) ) + 287 $ ABS( TR( 1, 2 ) ) + 288 $ ABS( TR( 2, 2 ) ) + 289 $ ABS( TR( 2, 1 ) ) 290 XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) ) 291 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1, 292 $ 1 ) ) )*( X( 1, 1 ) )+ 293 $ ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )- 294 $ ( SCALE*B( 1, 1 ) ) ) 295 RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2, 296 $ 2 ) ) )*( X( 1, 2 ) )+ 297 $ ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )- 298 $ ( SCALE*B( 1, 2 ) ) ) 299 DEN = MAX( SMLNUM, SMLNUM*XNRM, 300 $ ( TNRM*EPS )*XNRM ) 301 RES = RES / DEN 302 IF( SCALE.GT.ONE ) 303 $ RES = RES + ONE / EPS 304 RES = RES + ABS( XNORM-XNRM ) / 305 $ MAX( SMLNUM, XNORM ) / EPS 306 IF( RES.GT.RMAX ) THEN 307 LMAX = KNT 308 RMAX = RES 309 END IF 310 90 CONTINUE 311 100 CONTINUE 312 110 CONTINUE 313 120 CONTINUE 314 130 CONTINUE 315* 316 N1 = 2 317 N2 = 2 318 DO 200 ITR = 1, 8 319 DO 190 ITRSCL = 1, 3 320 DO 180 ITL = 1, 8 321 DO 170 ITLSCL = 1, 3 322 DO 160 IB1 = 1, 3 323 DO 150 IB2 = 1, 3 324 DO 140 IB3 = 1, 3 325 B( 1, 1 ) = VAL( IB1 ) 326 B( 2, 1 ) = -FOUR*VAL( IB2 ) 327 B( 1, 2 ) = -TWO*VAL( IB3 ) 328 B( 2, 2 ) = EIGHT* 329 $ MIN( VAL( IB1 ), VAL 330 $ ( IB2 ), VAL( IB3 ) ) 331 TR( 1, 1 ) = ITVAL( 1, 1, ITR )* 332 $ VAL( ITRSCL ) 333 TR( 2, 1 ) = ITVAL( 2, 1, ITR )* 334 $ VAL( ITRSCL ) 335 TR( 1, 2 ) = ITVAL( 1, 2, ITR )* 336 $ VAL( ITRSCL ) 337 TR( 2, 2 ) = ITVAL( 2, 2, ITR )* 338 $ VAL( ITRSCL ) 339 TL( 1, 1 ) = ITVAL( 1, 1, ITL )* 340 $ VAL( ITLSCL ) 341 TL( 2, 1 ) = ITVAL( 2, 1, ITL )* 342 $ VAL( ITLSCL ) 343 TL( 1, 2 ) = ITVAL( 1, 2, ITL )* 344 $ VAL( ITLSCL ) 345 TL( 2, 2 ) = ITVAL( 2, 2, ITL )* 346 $ VAL( ITLSCL ) 347 KNT = KNT + 1 348 CALL DLASY2( LTRANL, LTRANR, ISGN, 349 $ N1, N2, TL, 2, TR, 2, 350 $ B, 2, SCALE, X, 2, 351 $ XNORM, INFO ) 352 IF( INFO.NE.0 ) 353 $ NINFO = NINFO + 1 354 IF( LTRANR ) THEN 355 TMP = TR( 1, 2 ) 356 TR( 1, 2 ) = TR( 2, 1 ) 357 TR( 2, 1 ) = TMP 358 END IF 359 IF( LTRANL ) THEN 360 TMP = TL( 1, 2 ) 361 TL( 1, 2 ) = TL( 2, 1 ) 362 TL( 2, 1 ) = TMP 363 END IF 364 TNRM = ABS( TR( 1, 1 ) ) + 365 $ ABS( TR( 2, 1 ) ) + 366 $ ABS( TR( 1, 2 ) ) + 367 $ ABS( TR( 2, 2 ) ) + 368 $ ABS( TL( 1, 1 ) ) + 369 $ ABS( TL( 2, 1 ) ) + 370 $ ABS( TL( 1, 2 ) ) + 371 $ ABS( TL( 2, 2 ) ) 372 XNRM = MAX( ABS( X( 1, 1 ) )+ 373 $ ABS( X( 1, 2 ) ), 374 $ ABS( X( 2, 1 ) )+ 375 $ ABS( X( 2, 2 ) ) ) 376 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1, 377 $ 1 ) ) )*( X( 1, 1 ) )+ 378 $ ( SGN*TR( 2, 1 ) )* 379 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )* 380 $ ( X( 2, 1 ) )- 381 $ ( SCALE*B( 1, 1 ) ) ) 382 RES = RES + ABS( ( TL( 1, 1 ) )* 383 $ ( X( 1, 2 ) )+ 384 $ ( SGN*TR( 1, 2 ) )* 385 $ ( X( 1, 1 ) )+ 386 $ ( SGN*TR( 2, 2 ) )* 387 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )* 388 $ ( X( 2, 2 ) )- 389 $ ( SCALE*B( 1, 2 ) ) ) 390 RES = RES + ABS( ( TL( 2, 1 ) )* 391 $ ( X( 1, 1 ) )+ 392 $ ( SGN*TR( 1, 1 ) )* 393 $ ( X( 2, 1 ) )+ 394 $ ( SGN*TR( 2, 1 ) )* 395 $ ( X( 2, 2 ) )+( TL( 2, 2 ) )* 396 $ ( X( 2, 1 ) )- 397 $ ( SCALE*B( 2, 1 ) ) ) 398 RES = RES + ABS( ( ( TL( 2, 399 $ 2 )+SGN*TR( 2, 2 ) ) )* 400 $ ( X( 2, 2 ) )+ 401 $ ( SGN*TR( 1, 2 ) )* 402 $ ( X( 2, 1 ) )+( TL( 2, 1 ) )* 403 $ ( X( 1, 2 ) )- 404 $ ( SCALE*B( 2, 2 ) ) ) 405 DEN = MAX( SMLNUM, SMLNUM*XNRM, 406 $ ( TNRM*EPS )*XNRM ) 407 RES = RES / DEN 408 IF( SCALE.GT.ONE ) 409 $ RES = RES + ONE / EPS 410 RES = RES + ABS( XNORM-XNRM ) / 411 $ MAX( SMLNUM, XNORM ) / EPS 412 IF( RES.GT.RMAX ) THEN 413 LMAX = KNT 414 RMAX = RES 415 END IF 416 140 CONTINUE 417 150 CONTINUE 418 160 CONTINUE 419 170 CONTINUE 420 180 CONTINUE 421 190 CONTINUE 422 200 CONTINUE 423 210 CONTINUE 424 220 CONTINUE 425 230 CONTINUE 426* 427 RETURN 428* 429* End of DGET32 430* 431 END 432