![]() |
LAPACK
3.4.0
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZERRSY 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 ZERRSY( 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 *> ZERRSY tests the error exits for the COMPLEX*16 routines 00025 *> for symmetric indefinite matrices. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup complex16_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE ZERRSY( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX 00072 PARAMETER ( NMAX = 4 ) 00073 * .. 00074 * .. Local Scalars .. 00075 CHARACTER*2 C2 00076 INTEGER I, INFO, J 00077 DOUBLE PRECISION ANRM, RCOND 00078 * .. 00079 * .. Local Arrays .. 00080 INTEGER IP( NMAX ) 00081 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ) 00082 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00083 $ W( 2*NMAX ), X( NMAX ) 00084 * .. 00085 * .. External Functions .. 00086 LOGICAL LSAMEN 00087 EXTERNAL LSAMEN 00088 * .. 00089 * .. External Subroutines .. 00090 EXTERNAL ALAESM, CHKXER, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI, 00091 $ ZSPTRS, ZSYCON, ZSYRFS, ZSYTF2, ZSYTRF, ZSYTRI, 00092 $ ZSYTRI2, ZSYTRS 00093 * .. 00094 * .. Scalars in Common .. 00095 LOGICAL LERR, OK 00096 CHARACTER*32 SRNAMT 00097 INTEGER INFOT, NOUT 00098 * .. 00099 * .. Common blocks .. 00100 COMMON / INFOC / INFOT, NOUT, OK, LERR 00101 COMMON / SRNAMC / SRNAMT 00102 * .. 00103 * .. Intrinsic Functions .. 00104 INTRINSIC DBLE, DCMPLX 00105 * .. 00106 * .. Executable Statements .. 00107 * 00108 NOUT = NUNIT 00109 WRITE( NOUT, FMT = * ) 00110 C2 = PATH( 2: 3 ) 00111 * 00112 * Set the variables to innocuous values. 00113 * 00114 DO 20 J = 1, NMAX 00115 DO 10 I = 1, NMAX 00116 A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00117 $ -1.D0 / DBLE( I+J ) ) 00118 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00119 $ -1.D0 / DBLE( I+J ) ) 00120 10 CONTINUE 00121 B( J ) = 0.D0 00122 R1( J ) = 0.D0 00123 R2( J ) = 0.D0 00124 W( J ) = 0.D0 00125 X( J ) = 0.D0 00126 IP( J ) = J 00127 20 CONTINUE 00128 ANRM = 1.0D0 00129 OK = .TRUE. 00130 * 00131 * Test error exits of the routines that use the diagonal pivoting 00132 * factorization of a symmetric indefinite matrix. 00133 * 00134 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00135 * 00136 * ZSYTRF 00137 * 00138 SRNAMT = 'ZSYTRF' 00139 INFOT = 1 00140 CALL ZSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00141 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00142 INFOT = 2 00143 CALL ZSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00144 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00145 INFOT = 4 00146 CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00147 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00148 * 00149 * ZSYTF2 00150 * 00151 SRNAMT = 'ZSYTF2' 00152 INFOT = 1 00153 CALL ZSYTF2( '/', 0, A, 1, IP, INFO ) 00154 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00155 INFOT = 2 00156 CALL ZSYTF2( 'U', -1, A, 1, IP, INFO ) 00157 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00158 INFOT = 4 00159 CALL ZSYTF2( 'U', 2, A, 1, IP, INFO ) 00160 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00161 * 00162 * ZSYTRI 00163 * 00164 SRNAMT = 'ZSYTRI' 00165 INFOT = 1 00166 CALL ZSYTRI( '/', 0, A, 1, IP, W, INFO ) 00167 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00168 INFOT = 2 00169 CALL ZSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00170 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00171 INFOT = 4 00172 CALL ZSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00173 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00174 * 00175 * ZSYTRI2 00176 * 00177 SRNAMT = 'ZSYTRI2' 00178 INFOT = 1 00179 CALL ZSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00180 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00181 INFOT = 2 00182 CALL ZSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00183 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00184 INFOT = 4 00185 CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00186 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00187 * 00188 * ZSYTRS 00189 * 00190 SRNAMT = 'ZSYTRS' 00191 INFOT = 1 00192 CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00193 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00194 INFOT = 2 00195 CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00196 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00197 INFOT = 3 00198 CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00199 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00200 INFOT = 5 00201 CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00202 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00203 INFOT = 8 00204 CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00205 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00206 * 00207 * ZSYRFS 00208 * 00209 SRNAMT = 'ZSYRFS' 00210 INFOT = 1 00211 CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00212 $ R, INFO ) 00213 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00214 INFOT = 2 00215 CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00216 $ W, R, INFO ) 00217 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00218 INFOT = 3 00219 CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00220 $ W, R, INFO ) 00221 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00222 INFOT = 5 00223 CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00224 $ R, INFO ) 00225 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00226 INFOT = 7 00227 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00228 $ R, INFO ) 00229 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00230 INFOT = 10 00231 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00232 $ R, INFO ) 00233 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00234 INFOT = 12 00235 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00236 $ R, INFO ) 00237 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00238 * 00239 * ZSYCON 00240 * 00241 SRNAMT = 'ZSYCON' 00242 INFOT = 1 00243 CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00244 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00245 INFOT = 2 00246 CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00247 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00248 INFOT = 4 00249 CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00250 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00251 INFOT = 6 00252 CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00253 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00254 * 00255 * Test error exits of the routines that use the diagonal pivoting 00256 * factorization of a symmetric indefinite packed matrix. 00257 * 00258 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00259 * 00260 * ZSPTRF 00261 * 00262 SRNAMT = 'ZSPTRF' 00263 INFOT = 1 00264 CALL ZSPTRF( '/', 0, A, IP, INFO ) 00265 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00266 INFOT = 2 00267 CALL ZSPTRF( 'U', -1, A, IP, INFO ) 00268 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00269 * 00270 * ZSPTRI 00271 * 00272 SRNAMT = 'ZSPTRI' 00273 INFOT = 1 00274 CALL ZSPTRI( '/', 0, A, IP, W, INFO ) 00275 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00276 INFOT = 2 00277 CALL ZSPTRI( 'U', -1, A, IP, W, INFO ) 00278 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00279 * 00280 * ZSPTRS 00281 * 00282 SRNAMT = 'ZSPTRS' 00283 INFOT = 1 00284 CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00285 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00286 INFOT = 2 00287 CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00288 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00289 INFOT = 3 00290 CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00291 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00292 INFOT = 7 00293 CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00294 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00295 * 00296 * ZSPRFS 00297 * 00298 SRNAMT = 'ZSPRFS' 00299 INFOT = 1 00300 CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00301 $ INFO ) 00302 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00303 INFOT = 2 00304 CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00305 $ INFO ) 00306 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00307 INFOT = 3 00308 CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00309 $ INFO ) 00310 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00311 INFOT = 8 00312 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00313 $ INFO ) 00314 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00315 INFOT = 10 00316 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00317 $ INFO ) 00318 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00319 * 00320 * ZSPCON 00321 * 00322 SRNAMT = 'ZSPCON' 00323 INFOT = 1 00324 CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00325 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00326 INFOT = 2 00327 CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00328 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00329 INFOT = 5 00330 CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00331 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00332 END IF 00333 * 00334 * Print a summary line. 00335 * 00336 CALL ALAESM( PATH, OK, NOUT ) 00337 * 00338 RETURN 00339 * 00340 * End of ZERRSY 00341 * 00342 END