|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CCHKEQ( THRESH, NOUT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 INTEGER NOUT 00009 REAL THRESH 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * CCHKEQ tests CGEEQU, CGBEQU, CPOEQU, CPPEQU and CPBEQU 00016 * 00017 * Arguments 00018 * ========= 00019 * 00020 * THRESH (input) REAL 00021 * Threshold for testing routines. Should be between 2 and 10. 00022 * 00023 * NOUT (input) INTEGER 00024 * The unit number for output. 00025 * 00026 * ===================================================================== 00027 * 00028 * .. Parameters .. 00029 REAL ZERO, ONE, TEN 00030 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E+0, TEN = 1.0E1 ) 00031 COMPLEX CZERO 00032 PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ) ) 00033 COMPLEX CONE 00034 PARAMETER ( CONE = ( 1.0E0, 0.0E0 ) ) 00035 INTEGER NSZ, NSZB 00036 PARAMETER ( NSZ = 5, NSZB = 3*NSZ-2 ) 00037 INTEGER NSZP, NPOW 00038 PARAMETER ( NSZP = ( NSZ*( NSZ+1 ) ) / 2, 00039 $ NPOW = 2*NSZ+1 ) 00040 * .. 00041 * .. Local Scalars .. 00042 LOGICAL OK 00043 CHARACTER*3 PATH 00044 INTEGER I, INFO, J, KL, KU, M, N 00045 REAL CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND 00046 * .. 00047 * .. Local Arrays .. 00048 REAL C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ), 00049 $ RPOW( NPOW ) 00050 COMPLEX A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP ) 00051 * .. 00052 * .. External Functions .. 00053 REAL SLAMCH 00054 EXTERNAL SLAMCH 00055 * .. 00056 * .. External Subroutines .. 00057 EXTERNAL CGBEQU, CGEEQU, CPBEQU, CPOEQU, CPPEQU 00058 * .. 00059 * .. Intrinsic Functions .. 00060 INTRINSIC ABS, MAX, MIN 00061 * .. 00062 * .. Executable Statements .. 00063 * 00064 PATH( 1:1 ) = 'Complex precision' 00065 PATH( 2:3 ) = 'EQ' 00066 * 00067 EPS = SLAMCH( 'P' ) 00068 DO 10 I = 1, 5 00069 RESLTS( I ) = ZERO 00070 10 CONTINUE 00071 DO 20 I = 1, NPOW 00072 POW( I ) = TEN**( I-1 ) 00073 RPOW( I ) = ONE / POW( I ) 00074 20 CONTINUE 00075 * 00076 * Test CGEEQU 00077 * 00078 DO 80 N = 0, NSZ 00079 DO 70 M = 0, NSZ 00080 * 00081 DO 40 J = 1, NSZ 00082 DO 30 I = 1, NSZ 00083 IF( I.LE.M .AND. J.LE.N ) THEN 00084 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J ) 00085 ELSE 00086 A( I, J ) = CZERO 00087 END IF 00088 30 CONTINUE 00089 40 CONTINUE 00090 * 00091 CALL CGEEQU( M, N, A, NSZ, R, C, RCOND, CCOND, NORM, INFO ) 00092 * 00093 IF( INFO.NE.0 ) THEN 00094 RESLTS( 1 ) = ONE 00095 ELSE 00096 IF( N.NE.0 .AND. M.NE.0 ) THEN 00097 RESLTS( 1 ) = MAX( RESLTS( 1 ), 00098 $ ABS( ( RCOND-RPOW( M ) ) / RPOW( M ) ) ) 00099 RESLTS( 1 ) = MAX( RESLTS( 1 ), 00100 $ ABS( ( CCOND-RPOW( N ) ) / RPOW( N ) ) ) 00101 RESLTS( 1 ) = MAX( RESLTS( 1 ), 00102 $ ABS( ( NORM-POW( N+M+1 ) ) / POW( N+M+ 00103 $ 1 ) ) ) 00104 DO 50 I = 1, M 00105 RESLTS( 1 ) = MAX( RESLTS( 1 ), 00106 $ ABS( ( R( I )-RPOW( I+N+1 ) ) / 00107 $ RPOW( I+N+1 ) ) ) 00108 50 CONTINUE 00109 DO 60 J = 1, N 00110 RESLTS( 1 ) = MAX( RESLTS( 1 ), 00111 $ ABS( ( C( J )-POW( N-J+1 ) ) / 00112 $ POW( N-J+1 ) ) ) 00113 60 CONTINUE 00114 END IF 00115 END IF 00116 * 00117 70 CONTINUE 00118 80 CONTINUE 00119 * 00120 * Test with zero rows and columns 00121 * 00122 DO 90 J = 1, NSZ 00123 A( MAX( NSZ-1, 1 ), J ) = CZERO 00124 90 CONTINUE 00125 CALL CGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO ) 00126 IF( INFO.NE.MAX( NSZ-1, 1 ) ) 00127 $ RESLTS( 1 ) = ONE 00128 * 00129 DO 100 J = 1, NSZ 00130 A( MAX( NSZ-1, 1 ), J ) = CONE 00131 100 CONTINUE 00132 DO 110 I = 1, NSZ 00133 A( I, MAX( NSZ-1, 1 ) ) = CZERO 00134 110 CONTINUE 00135 CALL CGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO ) 00136 IF( INFO.NE.NSZ+MAX( NSZ-1, 1 ) ) 00137 $ RESLTS( 1 ) = ONE 00138 RESLTS( 1 ) = RESLTS( 1 ) / EPS 00139 * 00140 * Test CGBEQU 00141 * 00142 DO 250 N = 0, NSZ 00143 DO 240 M = 0, NSZ 00144 DO 230 KL = 0, MAX( M-1, 0 ) 00145 DO 220 KU = 0, MAX( N-1, 0 ) 00146 * 00147 DO 130 J = 1, NSZ 00148 DO 120 I = 1, NSZB 00149 AB( I, J ) = CZERO 00150 120 CONTINUE 00151 130 CONTINUE 00152 DO 150 J = 1, N 00153 DO 140 I = 1, M 00154 IF( I.LE.MIN( M, J+KL ) .AND. I.GE. 00155 $ MAX( 1, J-KU ) .AND. J.LE.N ) THEN 00156 AB( KU+1+I-J, J ) = POW( I+J+1 )* 00157 $ ( -1 )**( I+J ) 00158 END IF 00159 140 CONTINUE 00160 150 CONTINUE 00161 * 00162 CALL CGBEQU( M, N, KL, KU, AB, NSZB, R, C, RCOND, 00163 $ CCOND, NORM, INFO ) 00164 * 00165 IF( INFO.NE.0 ) THEN 00166 IF( .NOT.( ( N+KL.LT.M .AND. INFO.EQ.N+KL+1 ) .OR. 00167 $ ( M+KU.LT.N .AND. INFO.EQ.2*M+KU+1 ) ) ) THEN 00168 RESLTS( 2 ) = ONE 00169 END IF 00170 ELSE 00171 IF( N.NE.0 .AND. M.NE.0 ) THEN 00172 * 00173 RCMIN = R( 1 ) 00174 RCMAX = R( 1 ) 00175 DO 160 I = 1, M 00176 RCMIN = MIN( RCMIN, R( I ) ) 00177 RCMAX = MAX( RCMAX, R( I ) ) 00178 160 CONTINUE 00179 RATIO = RCMIN / RCMAX 00180 RESLTS( 2 ) = MAX( RESLTS( 2 ), 00181 $ ABS( ( RCOND-RATIO ) / RATIO ) ) 00182 * 00183 RCMIN = C( 1 ) 00184 RCMAX = C( 1 ) 00185 DO 170 J = 1, N 00186 RCMIN = MIN( RCMIN, C( J ) ) 00187 RCMAX = MAX( RCMAX, C( J ) ) 00188 170 CONTINUE 00189 RATIO = RCMIN / RCMAX 00190 RESLTS( 2 ) = MAX( RESLTS( 2 ), 00191 $ ABS( ( CCOND-RATIO ) / RATIO ) ) 00192 * 00193 RESLTS( 2 ) = MAX( RESLTS( 2 ), 00194 $ ABS( ( NORM-POW( N+M+1 ) ) / 00195 $ POW( N+M+1 ) ) ) 00196 DO 190 I = 1, M 00197 RCMAX = ZERO 00198 DO 180 J = 1, N 00199 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN 00200 RATIO = ABS( R( I )*POW( I+J+1 )* 00201 $ C( J ) ) 00202 RCMAX = MAX( RCMAX, RATIO ) 00203 END IF 00204 180 CONTINUE 00205 RESLTS( 2 ) = MAX( RESLTS( 2 ), 00206 $ ABS( ONE-RCMAX ) ) 00207 190 CONTINUE 00208 * 00209 DO 210 J = 1, N 00210 RCMAX = ZERO 00211 DO 200 I = 1, M 00212 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN 00213 RATIO = ABS( R( I )*POW( I+J+1 )* 00214 $ C( J ) ) 00215 RCMAX = MAX( RCMAX, RATIO ) 00216 END IF 00217 200 CONTINUE 00218 RESLTS( 2 ) = MAX( RESLTS( 2 ), 00219 $ ABS( ONE-RCMAX ) ) 00220 210 CONTINUE 00221 END IF 00222 END IF 00223 * 00224 220 CONTINUE 00225 230 CONTINUE 00226 240 CONTINUE 00227 250 CONTINUE 00228 RESLTS( 2 ) = RESLTS( 2 ) / EPS 00229 * 00230 * Test CPOEQU 00231 * 00232 DO 290 N = 0, NSZ 00233 * 00234 DO 270 I = 1, NSZ 00235 DO 260 J = 1, NSZ 00236 IF( I.LE.N .AND. J.EQ.I ) THEN 00237 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J ) 00238 ELSE 00239 A( I, J ) = CZERO 00240 END IF 00241 260 CONTINUE 00242 270 CONTINUE 00243 * 00244 CALL CPOEQU( N, A, NSZ, R, RCOND, NORM, INFO ) 00245 * 00246 IF( INFO.NE.0 ) THEN 00247 RESLTS( 3 ) = ONE 00248 ELSE 00249 IF( N.NE.0 ) THEN 00250 RESLTS( 3 ) = MAX( RESLTS( 3 ), 00251 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 00252 RESLTS( 3 ) = MAX( RESLTS( 3 ), 00253 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 00254 $ 1 ) ) ) 00255 DO 280 I = 1, N 00256 RESLTS( 3 ) = MAX( RESLTS( 3 ), 00257 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+ 00258 $ 1 ) ) ) 00259 280 CONTINUE 00260 END IF 00261 END IF 00262 290 CONTINUE 00263 A( MAX( NSZ-1, 1 ), MAX( NSZ-1, 1 ) ) = -CONE 00264 CALL CPOEQU( NSZ, A, NSZ, R, RCOND, NORM, INFO ) 00265 IF( INFO.NE.MAX( NSZ-1, 1 ) ) 00266 $ RESLTS( 3 ) = ONE 00267 RESLTS( 3 ) = RESLTS( 3 ) / EPS 00268 * 00269 * Test CPPEQU 00270 * 00271 DO 360 N = 0, NSZ 00272 * 00273 * Upper triangular packed storage 00274 * 00275 DO 300 I = 1, ( N*( N+1 ) ) / 2 00276 AP( I ) = CZERO 00277 300 CONTINUE 00278 DO 310 I = 1, N 00279 AP( ( I*( I+1 ) ) / 2 ) = POW( 2*I+1 ) 00280 310 CONTINUE 00281 * 00282 CALL CPPEQU( 'U', N, AP, R, RCOND, NORM, INFO ) 00283 * 00284 IF( INFO.NE.0 ) THEN 00285 RESLTS( 4 ) = ONE 00286 ELSE 00287 IF( N.NE.0 ) THEN 00288 RESLTS( 4 ) = MAX( RESLTS( 4 ), 00289 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 00290 RESLTS( 4 ) = MAX( RESLTS( 4 ), 00291 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 00292 $ 1 ) ) ) 00293 DO 320 I = 1, N 00294 RESLTS( 4 ) = MAX( RESLTS( 4 ), 00295 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+ 00296 $ 1 ) ) ) 00297 320 CONTINUE 00298 END IF 00299 END IF 00300 * 00301 * Lower triangular packed storage 00302 * 00303 DO 330 I = 1, ( N*( N+1 ) ) / 2 00304 AP( I ) = CZERO 00305 330 CONTINUE 00306 J = 1 00307 DO 340 I = 1, N 00308 AP( J ) = POW( 2*I+1 ) 00309 J = J + ( N-I+1 ) 00310 340 CONTINUE 00311 * 00312 CALL CPPEQU( 'L', N, AP, R, RCOND, NORM, INFO ) 00313 * 00314 IF( INFO.NE.0 ) THEN 00315 RESLTS( 4 ) = ONE 00316 ELSE 00317 IF( N.NE.0 ) THEN 00318 RESLTS( 4 ) = MAX( RESLTS( 4 ), 00319 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 00320 RESLTS( 4 ) = MAX( RESLTS( 4 ), 00321 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 00322 $ 1 ) ) ) 00323 DO 350 I = 1, N 00324 RESLTS( 4 ) = MAX( RESLTS( 4 ), 00325 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+ 00326 $ 1 ) ) ) 00327 350 CONTINUE 00328 END IF 00329 END IF 00330 * 00331 360 CONTINUE 00332 I = ( NSZ*( NSZ+1 ) ) / 2 - 2 00333 AP( I ) = -CONE 00334 CALL CPPEQU( 'L', NSZ, AP, R, RCOND, NORM, INFO ) 00335 IF( INFO.NE.MAX( NSZ-1, 1 ) ) 00336 $ RESLTS( 4 ) = ONE 00337 RESLTS( 4 ) = RESLTS( 4 ) / EPS 00338 * 00339 * Test CPBEQU 00340 * 00341 DO 460 N = 0, NSZ 00342 DO 450 KL = 0, MAX( N-1, 0 ) 00343 * 00344 * Test upper triangular storage 00345 * 00346 DO 380 J = 1, NSZ 00347 DO 370 I = 1, NSZB 00348 AB( I, J ) = CZERO 00349 370 CONTINUE 00350 380 CONTINUE 00351 DO 390 J = 1, N 00352 AB( KL+1, J ) = POW( 2*J+1 ) 00353 390 CONTINUE 00354 * 00355 CALL CPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 00356 * 00357 IF( INFO.NE.0 ) THEN 00358 RESLTS( 5 ) = ONE 00359 ELSE 00360 IF( N.NE.0 ) THEN 00361 RESLTS( 5 ) = MAX( RESLTS( 5 ), 00362 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 00363 RESLTS( 5 ) = MAX( RESLTS( 5 ), 00364 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 00365 $ 1 ) ) ) 00366 DO 400 I = 1, N 00367 RESLTS( 5 ) = MAX( RESLTS( 5 ), 00368 $ ABS( ( R( I )-RPOW( I+1 ) ) / 00369 $ RPOW( I+1 ) ) ) 00370 400 CONTINUE 00371 END IF 00372 END IF 00373 IF( N.NE.0 ) THEN 00374 AB( KL+1, MAX( N-1, 1 ) ) = -CONE 00375 CALL CPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 00376 IF( INFO.NE.MAX( N-1, 1 ) ) 00377 $ RESLTS( 5 ) = ONE 00378 END IF 00379 * 00380 * Test lower triangular storage 00381 * 00382 DO 420 J = 1, NSZ 00383 DO 410 I = 1, NSZB 00384 AB( I, J ) = CZERO 00385 410 CONTINUE 00386 420 CONTINUE 00387 DO 430 J = 1, N 00388 AB( 1, J ) = POW( 2*J+1 ) 00389 430 CONTINUE 00390 * 00391 CALL CPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 00392 * 00393 IF( INFO.NE.0 ) THEN 00394 RESLTS( 5 ) = ONE 00395 ELSE 00396 IF( N.NE.0 ) THEN 00397 RESLTS( 5 ) = MAX( RESLTS( 5 ), 00398 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) ) 00399 RESLTS( 5 ) = MAX( RESLTS( 5 ), 00400 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+ 00401 $ 1 ) ) ) 00402 DO 440 I = 1, N 00403 RESLTS( 5 ) = MAX( RESLTS( 5 ), 00404 $ ABS( ( R( I )-RPOW( I+1 ) ) / 00405 $ RPOW( I+1 ) ) ) 00406 440 CONTINUE 00407 END IF 00408 END IF 00409 IF( N.NE.0 ) THEN 00410 AB( 1, MAX( N-1, 1 ) ) = -CONE 00411 CALL CPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO ) 00412 IF( INFO.NE.MAX( N-1, 1 ) ) 00413 $ RESLTS( 5 ) = ONE 00414 END IF 00415 450 CONTINUE 00416 460 CONTINUE 00417 RESLTS( 5 ) = RESLTS( 5 ) / EPS 00418 OK = ( RESLTS( 1 ).LE.THRESH ) .AND. 00419 $ ( RESLTS( 2 ).LE.THRESH ) .AND. 00420 $ ( RESLTS( 3 ).LE.THRESH ) .AND. 00421 $ ( RESLTS( 4 ).LE.THRESH ) .AND. ( RESLTS( 5 ).LE.THRESH ) 00422 WRITE( NOUT, FMT = * ) 00423 IF( OK ) THEN 00424 WRITE( NOUT, FMT = 9999 )PATH 00425 ELSE 00426 IF( RESLTS( 1 ).GT.THRESH ) 00427 $ WRITE( NOUT, FMT = 9998 )RESLTS( 1 ), THRESH 00428 IF( RESLTS( 2 ).GT.THRESH ) 00429 $ WRITE( NOUT, FMT = 9997 )RESLTS( 2 ), THRESH 00430 IF( RESLTS( 3 ).GT.THRESH ) 00431 $ WRITE( NOUT, FMT = 9996 )RESLTS( 3 ), THRESH 00432 IF( RESLTS( 4 ).GT.THRESH ) 00433 $ WRITE( NOUT, FMT = 9995 )RESLTS( 4 ), THRESH 00434 IF( RESLTS( 5 ).GT.THRESH ) 00435 $ WRITE( NOUT, FMT = 9994 )RESLTS( 5 ), THRESH 00436 END IF 00437 9999 FORMAT( 1X, 'All tests for ', A3, 00438 $ ' routines passed the threshold' ) 00439 9998 FORMAT( ' CGEEQU failed test with value ', E10.3, ' exceeding', 00440 $ ' threshold ', E10.3 ) 00441 9997 FORMAT( ' CGBEQU failed test with value ', E10.3, ' exceeding', 00442 $ ' threshold ', E10.3 ) 00443 9996 FORMAT( ' CPOEQU failed test with value ', E10.3, ' exceeding', 00444 $ ' threshold ', E10.3 ) 00445 9995 FORMAT( ' CPPEQU failed test with value ', E10.3, ' exceeding', 00446 $ ' threshold ', E10.3 ) 00447 9994 FORMAT( ' CPBEQU failed test with value ', E10.3, ' exceeding', 00448 $ ' threshold ', E10.3 ) 00449 RETURN 00450 * 00451 * End of CCHKEQ 00452 * 00453 END
1.7.3 
