1*> \brief \b SCHKEQ 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 SCHKEQ( THRESH, NOUT ) 12* 13* .. Scalar Arguments .. 14* INTEGER NOUT 15* REAL THRESH 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> SCHKEQ tests SGEEQU, SGBEQU, SPOEQU, SPPEQU and SPBEQU 25*> \endverbatim 26* 27* Arguments: 28* ========== 29* 30*> \param[in] THRESH 31*> \verbatim 32*> THRESH is REAL 33*> Threshold for testing routines. Should be between 2 and 10. 34*> \endverbatim 35*> 36*> \param[in] NOUT 37*> \verbatim 38*> NOUT is INTEGER 39*> The unit number for output. 40*> \endverbatim 41* 42* Authors: 43* ======== 44* 45*> \author Univ. of Tennessee 46*> \author Univ. of California Berkeley 47*> \author Univ. of Colorado Denver 48*> \author NAG Ltd. 49* 50*> \ingroup single_lin 51* 52* ===================================================================== 53 SUBROUTINE SCHKEQ( THRESH, NOUT ) 54* 55* -- LAPACK test routine -- 56* -- LAPACK is a software package provided by Univ. of Tennessee, -- 57* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 58* 59* .. Scalar Arguments .. 60 INTEGER NOUT 61 REAL THRESH 62* .. 63* 64* ===================================================================== 65* 66* .. Parameters .. 67 REAL ZERO, ONE, TEN 68 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E+0, TEN = 1.0E1 ) 69 INTEGER NSZ, NSZB 70 PARAMETER ( NSZ = 5, NSZB = 3*NSZ-2 ) 71 INTEGER NSZP, NPOW 72 PARAMETER ( NSZP = ( NSZ*( NSZ+1 ) ) / 2, 73 $ NPOW = 2*NSZ+1 ) 74* .. 75* .. Local Scalars .. 76 LOGICAL OK 77 CHARACTER*3 PATH 78 INTEGER I, INFO, J, KL, KU, M, N 79 REAL CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND 80* .. 81* .. Local Arrays .. 82 REAL A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP ), 83 $ C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ), 84 $ RPOW( NPOW ) 85* .. 86* .. External Functions .. 87 REAL SLAMCH 88 EXTERNAL SLAMCH 89* .. 90* .. External Subroutines .. 91 EXTERNAL SGBEQU, SGEEQU, SPBEQU, SPOEQU, SPPEQU 92* .. 93* .. Intrinsic Functions .. 94 INTRINSIC ABS, MAX, MIN 95* .. 96* .. Executable Statements .. 97* 98 PATH( 1:1 ) = 'Single precision' 99 PATH( 2:3 ) = 'EQ' 100* 101 EPS = SLAMCH( 'P' ) 102 DO 10 I = 1, 5 103 RESLTS( I ) = ZERO 104 10 CONTINUE 105 DO 20 I = 1, NPOW 106 POW( I ) = TEN**( I-1 ) 107 RPOW( I ) = ONE / POW( I ) 108 20 CONTINUE 109* 110* Test SGEEQU 111* 112 DO 80 N = 0, NSZ 113 DO 70 M = 0, NSZ 114* 115 DO 40 J = 1, NSZ 116 DO 30 I = 1, NSZ 117 IF( I.LE.M .AND. J.LE.N ) THEN 118 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J ) 119 ELSE 120 A( I, J ) = ZERO 121 END IF 122 30 CONTINUE 123 40 CONTINUE 124* 125 CALL SGEEQU( M, N, A, NSZ, R, C, RCOND, CCOND, NORM, INFO ) 126* 127 IF( INFO.NE.0 ) THEN 128 RESLTS( 1 ) = ONE 129 ELSE 130 IF( N.NE.0 .AND. M.NE.0 ) THEN 131 RESLTS( 1 ) = MAX( RESLTS( 1 ), 132 $ ABS( ( RCOND-RPOW( M ) ) / RPOW( M ) ) ) 133 RESLTS( 1 ) = MAX( RESLTS( 1 ), 134 $ ABS( ( CCOND-RPOW( N ) ) / RPOW( N ) ) ) 135 RESLTS( 1 ) = MAX( RESLTS( 1 ), 136 $ ABS( ( NORM-POW( N+M+1 ) ) / POW( N+M+ 137 $ 1 ) ) ) 138 DO 50 I = 1, M 139 RESLTS( 1 ) = MAX( RESLTS( 1 ), 140 $ ABS( ( R( I )-RPOW( I+N+1 ) ) / 141 $ RPOW( I+N+1 ) ) ) 142 50 CONTINUE 143 DO 60 J = 1, N 144 RESLTS( 1 ) = MAX( RESLTS( 1 ), 145 $ ABS( ( C( J )-POW( N-J+1 ) ) / 146 $ POW( N-J+1 ) ) ) 147 60 CONTINUE 148 END IF 149 END IF 150* 151 70 CONTINUE 152 80 CONTINUE 153* 154* Test with zero rows and columns 155* 156 DO 90 J = 1, NSZ 157 A( MAX( NSZ-1, 1 ), J ) = ZERO 158 90 CONTINUE 159 CALL SGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO ) 160 IF( INFO.NE.MAX( NSZ-1, 1 ) ) 161 $ RESLTS( 1 ) = ONE 162* 163 DO 100 J = 1, NSZ 164 A( MAX( NSZ-1, 1 ), J ) = ONE 165 100 CONTINUE 166 DO 110 I = 1, NSZ 167 A( I, MAX( NSZ-1, 1 ) ) = ZERO 168 110 CONTINUE 169 CALL SGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO ) 170 IF( INFO.NE.NSZ+MAX( NSZ-1, 1 ) ) 171 $ RESLTS( 1 ) = ONE 172 RESLTS( 1 ) = RESLTS( 1 ) / EPS 173* 174* Test SGBEQU 175* 176 DO 250 N = 0, NSZ 177 DO 240 M = 0, NSZ 178 DO 230 KL = 0, MAX( M-1, 0 ) 179 DO 220 KU = 0, MAX( N-1, 0 ) 180* 181 DO 130 J = 1, NSZ 182 DO 120 I = 1, NSZB 183 AB( I, J ) = ZERO 184 120 CONTINUE 185 130 CONTINUE 186 DO 150 J = 1, N 187 DO 140 I = 1, M 188 IF( I.LE.MIN( M, J+KL ) .AND. I.GE. 189 $ MAX( 1, J-KU ) .AND. J.LE.N ) THEN 190 AB( KU+1+I-J, J ) = POW( I+J+1 )* 191 $ ( -1 )**( I+J ) 192 END IF 193 140 CONTINUE 194 150 CONTINUE 195* 196 CALL SGBEQU( M, N, KL, KU, AB, NSZB, R, C, RCOND, 197 $ CCOND, NORM, INFO ) 198* 199 IF( INFO.NE.0 ) THEN 200 IF( .NOT.( ( N+KL.LT.M .AND. INFO.EQ.N+KL+1 ) .OR. 201 $ ( M+KU.LT.N .AND. INFO.EQ.2*M+KU+1 ) ) ) THEN 202 RESLTS( 2 ) = ONE 203 END IF 204 ELSE 205 IF( N.NE.0 .AND. M.NE.0 ) THEN 206* 207 RCMIN = R( 1 ) 208 RCMAX = R( 1 ) 209 DO 160 I = 1, M 210 RCMIN = MIN( RCMIN, R( I ) ) 211 RCMAX = MAX( RCMAX, R( I ) ) 212 160 CONTINUE 213 RATIO = RCMIN / RCMAX 214 RESLTS( 2 ) = MAX( RESLTS( 2 ), 215 $ ABS( ( RCOND-RATIO ) / RATIO ) ) 216* 217 RCMIN = C( 1 ) 218 RCMAX = C( 1 ) 219 DO 170 J = 1, N 220 RCMIN = MIN( RCMIN, C( J ) ) 221 RCMAX = MAX( RCMAX, C( J ) ) 222 170 CONTINUE 223 RATIO = RCMIN / RCMAX 224 RESLTS( 2 ) = MAX( RESLTS( 2 ), 225 $ ABS( ( CCOND-RATIO ) / RATIO ) ) 226* 227 RESLTS( 2 ) = MAX( RESLTS( 2 ), 228 $ ABS( ( NORM-POW( N+M+1 ) ) / 229 $ POW( N+M+1 ) ) ) 230 DO 190 I = 1, M 231 RCMAX = ZERO 232 DO 180 J = 1, N 233 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN 234 RATIO = ABS( R( I )*POW( I+J+1 )* 235 $ C( J ) ) 236 RCMAX = MAX( RCMAX, RATIO ) 237 END IF 238 180 CONTINUE 239 RESLTS( 2 ) = MAX( RESLTS( 2 ), 240 $ ABS( ONE-RCMAX ) ) 241 190 CONTINUE 242* 243 DO 210 J = 1, N 244 RCMAX = ZERO 245 DO 200 I = 1, M 246 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN 247 RATIO = ABS( R( I )*POW( I+J+1 )* 248 $ C( J ) ) 249 RCMAX = MAX( RCMAX, RATIO ) 250 END IF 251 200 CONTINUE 252 RESLTS( 2 ) = MAX( RESLTS( 2 ), 253 $ ABS( ONE-RCMAX ) ) 254 210 CONTINUE 255 END IF 256 END IF 257* 258 220 CONTINUE 259 230 CONTINUE 260 240 CONTINUE 261 250 CONTINUE 262 RESLTS( 2 ) = RESLTS( 2 ) / EPS 263* 264* Test SPOEQU 265* 266 DO 290 N = 0, NSZ 267* 268 DO 270 I = 1, NSZ 269 DO 260 J = 1, NSZ 270 IF( I.LE.N .AND. J.EQ.I ) THEN 271 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J ) 272 ELSE 273 A( I, J ) = ZERO 274 END IF 275 260 CONTINUE 276 270 CONTINUE 277* 278 CALL SPOEQU( N, A, NSZ, R, RCOND, NORM, INFO ) 279* 280 IF( INFO.NE.0 ) THEN 281 RESLTS( 3 ) = ONE 282 ELSE 283 IF( N.NE.0 ) THEN 284 RESLTS( 3 ) = MAX( RESLTS( 3 ), 285 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 286 RESLTS( 3 ) = MAX( RESLTS( 3 ), 287 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 288 $ 1 ) ) ) 289 DO 280 I = 1, N 290 RESLTS( 3 ) = MAX( RESLTS( 3 ), 291 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+ 292 $ 1 ) ) ) 293 280 CONTINUE 294 END IF 295 END IF 296 290 CONTINUE 297 A( MAX( NSZ-1, 1 ), MAX( NSZ-1, 1 ) ) = -ONE 298 CALL SPOEQU( NSZ, A, NSZ, R, RCOND, NORM, INFO ) 299 IF( INFO.NE.MAX( NSZ-1, 1 ) ) 300 $ RESLTS( 3 ) = ONE 301 RESLTS( 3 ) = RESLTS( 3 ) / EPS 302* 303* Test SPPEQU 304* 305 DO 360 N = 0, NSZ 306* 307* Upper triangular packed storage 308* 309 DO 300 I = 1, ( N*( N+1 ) ) / 2 310 AP( I ) = ZERO 311 300 CONTINUE 312 DO 310 I = 1, N 313 AP( ( I*( I+1 ) ) / 2 ) = POW( 2*I+1 ) 314 310 CONTINUE 315* 316 CALL SPPEQU( 'U', N, AP, R, RCOND, NORM, INFO ) 317* 318 IF( INFO.NE.0 ) THEN 319 RESLTS( 4 ) = ONE 320 ELSE 321 IF( N.NE.0 ) THEN 322 RESLTS( 4 ) = MAX( RESLTS( 4 ), 323 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 324 RESLTS( 4 ) = MAX( RESLTS( 4 ), 325 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 326 $ 1 ) ) ) 327 DO 320 I = 1, N 328 RESLTS( 4 ) = MAX( RESLTS( 4 ), 329 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+ 330 $ 1 ) ) ) 331 320 CONTINUE 332 END IF 333 END IF 334* 335* Lower triangular packed storage 336* 337 DO 330 I = 1, ( N*( N+1 ) ) / 2 338 AP( I ) = ZERO 339 330 CONTINUE 340 J = 1 341 DO 340 I = 1, N 342 AP( J ) = POW( 2*I+1 ) 343 J = J + ( N-I+1 ) 344 340 CONTINUE 345* 346 CALL SPPEQU( 'L', N, AP, R, RCOND, NORM, INFO ) 347* 348 IF( INFO.NE.0 ) THEN 349 RESLTS( 4 ) = ONE 350 ELSE 351 IF( N.NE.0 ) THEN 352 RESLTS( 4 ) = MAX( RESLTS( 4 ), 353 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 354 RESLTS( 4 ) = MAX( RESLTS( 4 ), 355 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 356 $ 1 ) ) ) 357 DO 350 I = 1, N 358 RESLTS( 4 ) = MAX( RESLTS( 4 ), 359 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+ 360 $ 1 ) ) ) 361 350 CONTINUE 362 END IF 363 END IF 364* 365 360 CONTINUE 366 I = ( NSZ*( NSZ+1 ) ) / 2 - 2 367 AP( I ) = -ONE 368 CALL SPPEQU( 'L', NSZ, AP, R, RCOND, NORM, INFO ) 369 IF( INFO.NE.MAX( NSZ-1, 1 ) ) 370 $ RESLTS( 4 ) = ONE 371 RESLTS( 4 ) = RESLTS( 4 ) / EPS 372* 373* Test SPBEQU 374* 375 DO 460 N = 0, NSZ 376 DO 450 KL = 0, MAX( N-1, 0 ) 377* 378* Test upper triangular storage 379* 380 DO 380 J = 1, NSZ 381 DO 370 I = 1, NSZB 382 AB( I, J ) = ZERO 383 370 CONTINUE 384 380 CONTINUE 385 DO 390 J = 1, N 386 AB( KL+1, J ) = POW( 2*J+1 ) 387 390 CONTINUE 388* 389 CALL SPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 390* 391 IF( INFO.NE.0 ) THEN 392 RESLTS( 5 ) = ONE 393 ELSE 394 IF( N.NE.0 ) THEN 395 RESLTS( 5 ) = MAX( RESLTS( 5 ), 396 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 397 RESLTS( 5 ) = MAX( RESLTS( 5 ), 398 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 399 $ 1 ) ) ) 400 DO 400 I = 1, N 401 RESLTS( 5 ) = MAX( RESLTS( 5 ), 402 $ ABS( ( R( I )-RPOW( I+1 ) ) / 403 $ RPOW( I+1 ) ) ) 404 400 CONTINUE 405 END IF 406 END IF 407 IF( N.NE.0 ) THEN 408 AB( KL+1, MAX( N-1, 1 ) ) = -ONE 409 CALL SPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 410 IF( INFO.NE.MAX( N-1, 1 ) ) 411 $ RESLTS( 5 ) = ONE 412 END IF 413* 414* Test lower triangular storage 415* 416 DO 420 J = 1, NSZ 417 DO 410 I = 1, NSZB 418 AB( I, J ) = ZERO 419 410 CONTINUE 420 420 CONTINUE 421 DO 430 J = 1, N 422 AB( 1, J ) = POW( 2*J+1 ) 423 430 CONTINUE 424* 425 CALL SPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 426* 427 IF( INFO.NE.0 ) THEN 428 RESLTS( 5 ) = ONE 429 ELSE 430 IF( N.NE.0 ) THEN 431 RESLTS( 5 ) = MAX( RESLTS( 5 ), 432 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 433 RESLTS( 5 ) = MAX( RESLTS( 5 ), 434 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 435 $ 1 ) ) ) 436 DO 440 I = 1, N 437 RESLTS( 5 ) = MAX( RESLTS( 5 ), 438 $ ABS( ( R( I )-RPOW( I+1 ) ) / 439 $ RPOW( I+1 ) ) ) 440 440 CONTINUE 441 END IF 442 END IF 443 IF( N.NE.0 ) THEN 444 AB( 1, MAX( N-1, 1 ) ) = -ONE 445 CALL SPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 446 IF( INFO.NE.MAX( N-1, 1 ) ) 447 $ RESLTS( 5 ) = ONE 448 END IF 449 450 CONTINUE 450 460 CONTINUE 451 RESLTS( 5 ) = RESLTS( 5 ) / EPS 452 OK = ( RESLTS( 1 ).LE.THRESH ) .AND. 453 $ ( RESLTS( 2 ).LE.THRESH ) .AND. 454 $ ( RESLTS( 3 ).LE.THRESH ) .AND. 455 $ ( RESLTS( 4 ).LE.THRESH ) .AND. ( RESLTS( 5 ).LE.THRESH ) 456 WRITE( NOUT, FMT = * ) 457 IF( OK ) THEN 458 WRITE( NOUT, FMT = 9999 )PATH 459 ELSE 460 IF( RESLTS( 1 ).GT.THRESH ) 461 $ WRITE( NOUT, FMT = 9998 )RESLTS( 1 ), THRESH 462 IF( RESLTS( 2 ).GT.THRESH ) 463 $ WRITE( NOUT, FMT = 9997 )RESLTS( 2 ), THRESH 464 IF( RESLTS( 3 ).GT.THRESH ) 465 $ WRITE( NOUT, FMT = 9996 )RESLTS( 3 ), THRESH 466 IF( RESLTS( 4 ).GT.THRESH ) 467 $ WRITE( NOUT, FMT = 9995 )RESLTS( 4 ), THRESH 468 IF( RESLTS( 5 ).GT.THRESH ) 469 $ WRITE( NOUT, FMT = 9994 )RESLTS( 5 ), THRESH 470 END IF 471 9999 FORMAT( 1X, 'All tests for ', A3, 472 $ ' routines passed the threshold' ) 473 9998 FORMAT( ' SGEEQU failed test with value ', E10.3, ' exceeding', 474 $ ' threshold ', E10.3 ) 475 9997 FORMAT( ' SGBEQU failed test with value ', E10.3, ' exceeding', 476 $ ' threshold ', E10.3 ) 477 9996 FORMAT( ' SPOEQU failed test with value ', E10.3, ' exceeding', 478 $ ' threshold ', E10.3 ) 479 9995 FORMAT( ' SPPEQU failed test with value ', E10.3, ' exceeding', 480 $ ' threshold ', E10.3 ) 481 9994 FORMAT( ' SPBEQU failed test with value ', E10.3, ' exceeding', 482 $ ' threshold ', E10.3 ) 483 RETURN 484* 485* End of SCHKEQ 486* 487 END 488