 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE CERRED( PATH, NUNIT ) 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 CHARACTER*3 PATH 00009 INTEGER NUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * CERRED tests the error exits for the eigenvalue driver routines for 00016 * REAL matrices: 00017 * 00018 * PATH driver description 00019 * ---- ------ ----------- 00020 * CEV CGEEV find eigenvalues/eigenvectors for nonsymmetric A 00021 * CES CGEES find eigenvalues/Schur form for nonsymmetric A 00022 * CVX CGEEVX CGEEV + balancing and condition estimation 00023 * CSX CGEESX CGEES + balancing and condition estimation 00024 * CBD CGESVD compute SVD of an M-by-N matrix A 00025 * CGESDD compute SVD of an M-by-N matrix A(by divide and 00026 * conquer) 00027 * 00028 * Arguments 00029 * ========= 00030 * 00031 * PATH (input) CHARACTER*3 00032 * The LAPACK path name for the routines to be tested. 00033 * 00034 * NUNIT (input) INTEGER 00035 * The unit number for output. 00036 * 00037 * ===================================================================== 00038 * 00039 * .. Parameters .. 00040 INTEGER NMAX, LW 00041 PARAMETER ( NMAX = 4, LW = 5*NMAX ) 00042 REAL ONE, ZERO 00043 PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 ) 00044 * .. 00045 * .. Local Scalars .. 00046 CHARACTER*2 C2 00047 INTEGER I, IHI, ILO, INFO, J, NT, SDIM 00048 REAL ABNRM 00049 * .. 00050 * .. Local Arrays .. 00051 LOGICAL B( NMAX ) 00052 INTEGER IW( 4*NMAX ) 00053 REAL R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX ) 00054 COMPLEX A( NMAX, NMAX ), U( NMAX, NMAX ), 00055 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), 00056 $ VT( NMAX, NMAX ), W( 4*NMAX ), X( NMAX ) 00057 * .. 00058 * .. External Subroutines .. 00059 EXTERNAL CGEES, CGEESX, CGEEV, CGEEVX, CGESDD, CGESVD, 00060 $ CHKXER 00061 * .. 00062 * .. External Functions .. 00063 LOGICAL CSLECT, LSAMEN 00064 EXTERNAL CSLECT, LSAMEN 00065 * .. 00066 * .. Intrinsic Functions .. 00067 INTRINSIC LEN_TRIM 00068 * .. 00069 * .. Arrays in Common .. 00070 LOGICAL SELVAL( 20 ) 00071 REAL SELWI( 20 ), SELWR( 20 ) 00072 * .. 00073 * .. Scalars in Common .. 00074 LOGICAL LERR, OK 00075 CHARACTER*32 SRNAMT 00076 INTEGER INFOT, NOUT, SELDIM, SELOPT 00077 * .. 00078 * .. Common blocks .. 00079 COMMON / INFOC / INFOT, NOUT, OK, LERR 00080 COMMON / SRNAMC / SRNAMT 00081 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 00082 * .. 00083 * .. Executable Statements .. 00084 * 00085 NOUT = NUNIT 00086 WRITE( NOUT, FMT = * ) 00087 C2 = PATH( 2: 3 ) 00088 * 00089 * Initialize A 00090 * 00091 DO 20 J = 1, NMAX 00092 DO 10 I = 1, NMAX 00093 A( I, J ) = ZERO 00094 10 CONTINUE 00095 20 CONTINUE 00096 DO 30 I = 1, NMAX 00097 A( I, I ) = ONE 00098 30 CONTINUE 00099 OK = .TRUE. 00100 NT = 0 00101 * 00102 IF( LSAMEN( 2, C2, 'EV' ) ) THEN 00103 * 00104 * Test CGEEV 00105 * 00106 SRNAMT = 'CGEEV ' 00107 INFOT = 1 00108 CALL CGEEV( 'X', 'N', 0, A, 1, X, VL, 1, VR, 1, W, 1, RW, 00109 $ INFO ) 00110 CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK ) 00111 INFOT = 2 00112 CALL CGEEV( 'N', 'X', 0, A, 1, X, VL, 1, VR, 1, W, 1, RW, 00113 $ INFO ) 00114 CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK ) 00115 INFOT = 3 00116 CALL CGEEV( 'N', 'N', -1, A, 1, X, VL, 1, VR, 1, W, 1, RW, 00117 $ INFO ) 00118 CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK ) 00119 INFOT = 5 00120 CALL CGEEV( 'N', 'N', 2, A, 1, X, VL, 1, VR, 1, W, 4, RW, 00121 $ INFO ) 00122 CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK ) 00123 INFOT = 8 00124 CALL CGEEV( 'V', 'N', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW, 00125 $ INFO ) 00126 CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK ) 00127 INFOT = 10 00128 CALL CGEEV( 'N', 'V', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW, 00129 $ INFO ) 00130 CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK ) 00131 INFOT = 12 00132 CALL CGEEV( 'V', 'V', 1, A, 1, X, VL, 1, VR, 1, W, 1, RW, 00133 $ INFO ) 00134 CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK ) 00135 NT = NT + 7 00136 * 00137 ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN 00138 * 00139 * Test CGEES 00140 * 00141 SRNAMT = 'CGEES ' 00142 INFOT = 1 00143 CALL CGEES( 'X', 'N', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1, 00144 $ RW, B, INFO ) 00145 CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK ) 00146 INFOT = 2 00147 CALL CGEES( 'N', 'X', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1, 00148 $ RW, B, INFO ) 00149 CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK ) 00150 INFOT = 4 00151 CALL CGEES( 'N', 'S', CSLECT, -1, A, 1, SDIM, X, VL, 1, W, 1, 00152 $ RW, B, INFO ) 00153 CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK ) 00154 INFOT = 6 00155 CALL CGEES( 'N', 'S', CSLECT, 2, A, 1, SDIM, X, VL, 1, W, 4, 00156 $ RW, B, INFO ) 00157 CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK ) 00158 INFOT = 10 00159 CALL CGEES( 'V', 'S', CSLECT, 2, A, 2, SDIM, X, VL, 1, W, 4, 00160 $ RW, B, INFO ) 00161 CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK ) 00162 INFOT = 12 00163 CALL CGEES( 'N', 'S', CSLECT, 1, A, 1, SDIM, X, VL, 1, W, 1, 00164 $ RW, B, INFO ) 00165 CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK ) 00166 NT = NT + 6 00167 * 00168 ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN 00169 * 00170 * Test CGEEVX 00171 * 00172 SRNAMT = 'CGEEVX' 00173 INFOT = 1 00174 CALL CGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO, 00175 $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO ) 00176 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00177 INFOT = 2 00178 CALL CGEEVX( 'N', 'X', 'N', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO, 00179 $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO ) 00180 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00181 INFOT = 3 00182 CALL CGEEVX( 'N', 'N', 'X', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO, 00183 $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO ) 00184 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00185 INFOT = 4 00186 CALL CGEEVX( 'N', 'N', 'N', 'X', 0, A, 1, X, VL, 1, VR, 1, ILO, 00187 $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO ) 00188 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00189 INFOT = 5 00190 CALL CGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, X, VL, 1, VR, 1, 00191 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, RW, INFO ) 00192 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00193 INFOT = 7 00194 CALL CGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, X, VL, 1, VR, 1, ILO, 00195 $ IHI, S, ABNRM, R1, R2, W, 4, RW, INFO ) 00196 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00197 INFOT = 10 00198 CALL CGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, X, VL, 1, VR, 1, ILO, 00199 $ IHI, S, ABNRM, R1, R2, W, 4, RW, INFO ) 00200 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00201 INFOT = 12 00202 CALL CGEEVX( 'N', 'N', 'V', 'N', 2, A, 2, X, VL, 1, VR, 1, ILO, 00203 $ IHI, S, ABNRM, R1, R2, W, 4, RW, INFO ) 00204 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00205 INFOT = 20 00206 CALL CGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, X, VL, 1, VR, 1, ILO, 00207 $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO ) 00208 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00209 INFOT = 20 00210 CALL CGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, X, VL, 1, VR, 1, ILO, 00211 $ IHI, S, ABNRM, R1, R2, W, 2, RW, INFO ) 00212 CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK ) 00213 NT = NT + 10 00214 * 00215 ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN 00216 * 00217 * Test CGEESX 00218 * 00219 SRNAMT = 'CGEESX' 00220 INFOT = 1 00221 CALL CGEESX( 'X', 'N', CSLECT, 'N', 0, A, 1, SDIM, X, VL, 1, 00222 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO ) 00223 CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK ) 00224 INFOT = 2 00225 CALL CGEESX( 'N', 'X', CSLECT, 'N', 0, A, 1, SDIM, X, VL, 1, 00226 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO ) 00227 CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK ) 00228 INFOT = 4 00229 CALL CGEESX( 'N', 'N', CSLECT, 'X', 0, A, 1, SDIM, X, VL, 1, 00230 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO ) 00231 CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK ) 00232 INFOT = 5 00233 CALL CGEESX( 'N', 'N', CSLECT, 'N', -1, A, 1, SDIM, X, VL, 1, 00234 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO ) 00235 CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK ) 00236 INFOT = 7 00237 CALL CGEESX( 'N', 'N', CSLECT, 'N', 2, A, 1, SDIM, X, VL, 1, 00238 $ R1( 1 ), R2( 1 ), W, 4, RW, B, INFO ) 00239 CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK ) 00240 INFOT = 11 00241 CALL CGEESX( 'V', 'N', CSLECT, 'N', 2, A, 2, SDIM, X, VL, 1, 00242 $ R1( 1 ), R2( 1 ), W, 4, RW, B, INFO ) 00243 CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK ) 00244 INFOT = 15 00245 CALL CGEESX( 'N', 'N', CSLECT, 'N', 1, A, 1, SDIM, X, VL, 1, 00246 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO ) 00247 CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK ) 00248 NT = NT + 7 00249 * 00250 ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN 00251 * 00252 * Test CGESVD 00253 * 00254 SRNAMT = 'CGESVD' 00255 INFOT = 1 00256 CALL CGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, 00257 $ INFO ) 00258 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00259 INFOT = 2 00260 CALL CGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, 00261 $ INFO ) 00262 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00263 INFOT = 2 00264 CALL CGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, 00265 $ INFO ) 00266 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00267 INFOT = 3 00268 CALL CGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, 00269 $ INFO ) 00270 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00271 INFOT = 4 00272 CALL CGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, RW, 00273 $ INFO ) 00274 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00275 INFOT = 6 00276 CALL CGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, RW, 00277 $ INFO ) 00278 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00279 INFOT = 9 00280 CALL CGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, RW, 00281 $ INFO ) 00282 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00283 INFOT = 11 00284 CALL CGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, RW, 00285 $ INFO ) 00286 CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK ) 00287 NT = NT + 8 00288 IF( OK ) THEN 00289 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 00290 $ NT 00291 ELSE 00292 WRITE( NOUT, FMT = 9998 ) 00293 END IF 00294 * 00295 * Test CGESDD 00296 * 00297 SRNAMT = 'CGESDD' 00298 INFOT = 1 00299 CALL CGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, IW, 00300 $ INFO ) 00301 CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK ) 00302 INFOT = 2 00303 CALL CGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, IW, 00304 $ INFO ) 00305 CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK ) 00306 INFOT = 3 00307 CALL CGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, RW, IW, 00308 $ INFO ) 00309 CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK ) 00310 INFOT = 5 00311 CALL CGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, RW, IW, 00312 $ INFO ) 00313 CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK ) 00314 INFOT = 8 00315 CALL CGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, RW, IW, 00316 $ INFO ) 00317 CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK ) 00318 INFOT = 10 00319 CALL CGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, RW, IW, 00320 $ INFO ) 00321 CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK ) 00322 NT = NT - 2 00323 IF( OK ) THEN 00324 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 00325 $ NT 00326 ELSE 00327 WRITE( NOUT, FMT = 9998 ) 00328 END IF 00329 END IF 00330 * 00331 * Print a summary line. 00332 * 00333 IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN 00334 IF( OK ) THEN 00335 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 00336 $ NT 00337 ELSE 00338 WRITE( NOUT, FMT = 9998 ) 00339 END IF 00340 END IF 00341 * 00342 9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3, 00343 $ ' tests done)' ) 00344 9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' ) 00345 RETURN 00346 * 00347 * End of CERRED 00348 * 00349 END
1.7.3 
