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