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