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