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