00001 SUBROUTINE CCHKEQ( THRESH, NOUT )
00002
00003
00004
00005
00006
00007
00008 INTEGER NOUT
00009 REAL THRESH
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
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
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
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
00053 REAL SLAMCH
00054 EXTERNAL SLAMCH
00055
00056
00057 EXTERNAL CGBEQU, CGEEQU, CPBEQU, CPOEQU, CPPEQU
00058
00059
00060 INTRINSIC ABS, MAX, MIN
00061
00062
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
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
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
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
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
00270
00271 DO 360 N = 0, NSZ
00272
00273
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
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
00340
00341 DO 460 N = 0, NSZ
00342 DO 450 KL = 0, MAX( N-1, 0 )
00343
00344
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
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
00452
00453 END
