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