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