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