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