![]() |
LAPACK
3.4.1
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 April 2012 00052 * 00053 *> \ingroup complex16_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE ZERRSY( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.1) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * April 2012 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 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00132 * 00133 * Test error exits of the routines that use factorization 00134 * of a symmetric indefinite matrix with patrial 00135 * (Bunch-Kaufman) pivoting. 00136 * 00137 * ZSYTRF 00138 * 00139 SRNAMT = 'ZSYTRF' 00140 INFOT = 1 00141 CALL ZSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 00142 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00143 INFOT = 2 00144 CALL ZSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 00145 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00146 INFOT = 4 00147 CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 00148 CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK ) 00149 * 00150 * ZSYTF2 00151 * 00152 SRNAMT = 'ZSYTF2' 00153 INFOT = 1 00154 CALL ZSYTF2( '/', 0, A, 1, IP, INFO ) 00155 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00156 INFOT = 2 00157 CALL ZSYTF2( 'U', -1, A, 1, IP, INFO ) 00158 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00159 INFOT = 4 00160 CALL ZSYTF2( 'U', 2, A, 1, IP, INFO ) 00161 CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK ) 00162 * 00163 * ZSYTRI 00164 * 00165 SRNAMT = 'ZSYTRI' 00166 INFOT = 1 00167 CALL ZSYTRI( '/', 0, A, 1, IP, W, INFO ) 00168 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00169 INFOT = 2 00170 CALL ZSYTRI( 'U', -1, A, 1, IP, W, INFO ) 00171 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00172 INFOT = 4 00173 CALL ZSYTRI( 'U', 2, A, 1, IP, W, INFO ) 00174 CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK ) 00175 * 00176 * ZSYTRI2 00177 * 00178 SRNAMT = 'ZSYTRI2' 00179 INFOT = 1 00180 CALL ZSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 00181 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00182 INFOT = 2 00183 CALL ZSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 00184 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00185 INFOT = 4 00186 CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 00187 CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK ) 00188 * 00189 * ZSYTRS 00190 * 00191 SRNAMT = 'ZSYTRS' 00192 INFOT = 1 00193 CALL ZSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00194 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00195 INFOT = 2 00196 CALL ZSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 00197 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00198 INFOT = 3 00199 CALL ZSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 00200 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00201 INFOT = 5 00202 CALL ZSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 00203 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00204 INFOT = 8 00205 CALL ZSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 00206 CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK ) 00207 * 00208 * ZSYRFS 00209 * 00210 SRNAMT = 'ZSYRFS' 00211 INFOT = 1 00212 CALL ZSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00213 $ R, INFO ) 00214 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00215 INFOT = 2 00216 CALL ZSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00217 $ W, R, INFO ) 00218 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00219 INFOT = 3 00220 CALL ZSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00221 $ W, R, INFO ) 00222 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00223 INFOT = 5 00224 CALL ZSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00225 $ R, INFO ) 00226 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00227 INFOT = 7 00228 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00229 $ R, INFO ) 00230 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00231 INFOT = 10 00232 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00233 $ R, INFO ) 00234 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00235 INFOT = 12 00236 CALL ZSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00237 $ R, INFO ) 00238 CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK ) 00239 * 00240 * ZSYCON 00241 * 00242 SRNAMT = 'ZSYCON' 00243 INFOT = 1 00244 CALL ZSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 00245 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00246 INFOT = 2 00247 CALL ZSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 00248 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00249 INFOT = 4 00250 CALL ZSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 00251 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00252 INFOT = 6 00253 CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 00254 CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK ) 00255 * 00256 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00257 * 00258 * Test error exits of the routines that use factorization 00259 * of a symmetric indefinite packed matrix with patrial 00260 * (Bunch-Kaufman) pivoting. 00261 * 00262 * ZSPTRF 00263 * 00264 SRNAMT = 'ZSPTRF' 00265 INFOT = 1 00266 CALL ZSPTRF( '/', 0, A, IP, INFO ) 00267 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00268 INFOT = 2 00269 CALL ZSPTRF( 'U', -1, A, IP, INFO ) 00270 CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK ) 00271 * 00272 * ZSPTRI 00273 * 00274 SRNAMT = 'ZSPTRI' 00275 INFOT = 1 00276 CALL ZSPTRI( '/', 0, A, IP, W, INFO ) 00277 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00278 INFOT = 2 00279 CALL ZSPTRI( 'U', -1, A, IP, W, INFO ) 00280 CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK ) 00281 * 00282 * ZSPTRS 00283 * 00284 SRNAMT = 'ZSPTRS' 00285 INFOT = 1 00286 CALL ZSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 00287 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00288 INFOT = 2 00289 CALL ZSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 00290 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00291 INFOT = 3 00292 CALL ZSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 00293 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00294 INFOT = 7 00295 CALL ZSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 00296 CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK ) 00297 * 00298 * ZSPRFS 00299 * 00300 SRNAMT = 'ZSPRFS' 00301 INFOT = 1 00302 CALL ZSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00303 $ INFO ) 00304 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00305 INFOT = 2 00306 CALL ZSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00307 $ INFO ) 00308 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00309 INFOT = 3 00310 CALL ZSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 00311 $ INFO ) 00312 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00313 INFOT = 8 00314 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 00315 $ INFO ) 00316 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00317 INFOT = 10 00318 CALL ZSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 00319 $ INFO ) 00320 CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK ) 00321 * 00322 * ZSPCON 00323 * 00324 SRNAMT = 'ZSPCON' 00325 INFOT = 1 00326 CALL ZSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 00327 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00328 INFOT = 2 00329 CALL ZSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 00330 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00331 INFOT = 5 00332 CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 00333 CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK ) 00334 END IF 00335 * 00336 * Print a summary line. 00337 * 00338 CALL ALAESM( PATH, OK, NOUT ) 00339 * 00340 RETURN 00341 * 00342 * End of ZERRSY 00343 * 00344 END