![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZERRGE 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 ZERRGE( 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 *> ZERRGE tests the error exits for the COMPLEX*16 routines 00025 *> for general 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 ZERRGE( 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, CCOND, 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, ZGBCON, ZGBEQU, ZGBRFS, ZGBTF2, 00091 $ ZGBTRF, ZGBTRS, ZGECON, ZGEEQU, ZGERFS, ZGETF2, 00092 $ ZGETRF, ZGETRI, ZGETRS 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 OK = .TRUE. 00129 * 00130 * Test error exits of the routines that use the LU decomposition 00131 * of a general matrix. 00132 * 00133 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00134 * 00135 * ZGETRF 00136 * 00137 SRNAMT = 'ZGETRF' 00138 INFOT = 1 00139 CALL ZGETRF( -1, 0, A, 1, IP, INFO ) 00140 CALL CHKXER( 'ZGETRF', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL ZGETRF( 0, -1, A, 1, IP, INFO ) 00143 CALL CHKXER( 'ZGETRF', INFOT, NOUT, LERR, OK ) 00144 INFOT = 4 00145 CALL ZGETRF( 2, 1, A, 1, IP, INFO ) 00146 CALL CHKXER( 'ZGETRF', INFOT, NOUT, LERR, OK ) 00147 * 00148 * ZGETF2 00149 * 00150 SRNAMT = 'ZGETF2' 00151 INFOT = 1 00152 CALL ZGETF2( -1, 0, A, 1, IP, INFO ) 00153 CALL CHKXER( 'ZGETF2', INFOT, NOUT, LERR, OK ) 00154 INFOT = 2 00155 CALL ZGETF2( 0, -1, A, 1, IP, INFO ) 00156 CALL CHKXER( 'ZGETF2', INFOT, NOUT, LERR, OK ) 00157 INFOT = 4 00158 CALL ZGETF2( 2, 1, A, 1, IP, INFO ) 00159 CALL CHKXER( 'ZGETF2', INFOT, NOUT, LERR, OK ) 00160 * 00161 * ZGETRI 00162 * 00163 SRNAMT = 'ZGETRI' 00164 INFOT = 1 00165 CALL ZGETRI( -1, A, 1, IP, W, 1, INFO ) 00166 CALL CHKXER( 'ZGETRI', INFOT, NOUT, LERR, OK ) 00167 INFOT = 3 00168 CALL ZGETRI( 2, A, 1, IP, W, 2, INFO ) 00169 CALL CHKXER( 'ZGETRI', INFOT, NOUT, LERR, OK ) 00170 INFOT = 6 00171 CALL ZGETRI( 2, A, 2, IP, W, 1, INFO ) 00172 CALL CHKXER( 'ZGETRI', INFOT, NOUT, LERR, OK ) 00173 * 00174 * ZGETRS 00175 * 00176 SRNAMT = 'ZGETRS' 00177 INFOT = 1 00178 CALL ZGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 00179 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00180 INFOT = 2 00181 CALL ZGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 00182 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00183 INFOT = 3 00184 CALL ZGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 00185 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00186 INFOT = 5 00187 CALL ZGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 00188 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00189 INFOT = 8 00190 CALL ZGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 00191 CALL CHKXER( 'ZGETRS', INFOT, NOUT, LERR, OK ) 00192 * 00193 * ZGERFS 00194 * 00195 SRNAMT = 'ZGERFS' 00196 INFOT = 1 00197 CALL ZGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 00198 $ R, INFO ) 00199 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00200 INFOT = 2 00201 CALL ZGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00202 $ W, R, INFO ) 00203 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00204 INFOT = 3 00205 CALL ZGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 00206 $ W, R, INFO ) 00207 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00208 INFOT = 5 00209 CALL ZGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 00210 $ R, INFO ) 00211 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00212 INFOT = 7 00213 CALL ZGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 00214 $ R, INFO ) 00215 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00216 INFOT = 10 00217 CALL ZGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 00218 $ R, INFO ) 00219 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00220 INFOT = 12 00221 CALL ZGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 00222 $ R, INFO ) 00223 CALL CHKXER( 'ZGERFS', INFOT, NOUT, LERR, OK ) 00224 * 00225 * ZGECON 00226 * 00227 SRNAMT = 'ZGECON' 00228 INFOT = 1 00229 CALL ZGECON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO ) 00230 CALL CHKXER( 'ZGECON', INFOT, NOUT, LERR, OK ) 00231 INFOT = 2 00232 CALL ZGECON( '1', -1, A, 1, ANRM, RCOND, W, R, INFO ) 00233 CALL CHKXER( 'ZGECON', INFOT, NOUT, LERR, OK ) 00234 INFOT = 4 00235 CALL ZGECON( '1', 2, A, 1, ANRM, RCOND, W, R, INFO ) 00236 CALL CHKXER( 'ZGECON', INFOT, NOUT, LERR, OK ) 00237 * 00238 * ZGEEQU 00239 * 00240 SRNAMT = 'ZGEEQU' 00241 INFOT = 1 00242 CALL ZGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00243 CALL CHKXER( 'ZGEEQU', INFOT, NOUT, LERR, OK ) 00244 INFOT = 2 00245 CALL ZGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00246 CALL CHKXER( 'ZGEEQU', INFOT, NOUT, LERR, OK ) 00247 INFOT = 4 00248 CALL ZGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 00249 CALL CHKXER( 'ZGEEQU', INFOT, NOUT, LERR, OK ) 00250 * 00251 * Test error exits of the routines that use the LU decomposition 00252 * of a general band matrix. 00253 * 00254 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00255 * 00256 * ZGBTRF 00257 * 00258 SRNAMT = 'ZGBTRF' 00259 INFOT = 1 00260 CALL ZGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 00261 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00262 INFOT = 2 00263 CALL ZGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 00264 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00265 INFOT = 3 00266 CALL ZGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 00267 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00268 INFOT = 4 00269 CALL ZGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 00270 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00271 INFOT = 6 00272 CALL ZGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 00273 CALL CHKXER( 'ZGBTRF', INFOT, NOUT, LERR, OK ) 00274 * 00275 * ZGBTF2 00276 * 00277 SRNAMT = 'ZGBTF2' 00278 INFOT = 1 00279 CALL ZGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 00280 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00281 INFOT = 2 00282 CALL ZGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 00283 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00284 INFOT = 3 00285 CALL ZGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 00286 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00287 INFOT = 4 00288 CALL ZGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 00289 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00290 INFOT = 6 00291 CALL ZGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 00292 CALL CHKXER( 'ZGBTF2', INFOT, NOUT, LERR, OK ) 00293 * 00294 * ZGBTRS 00295 * 00296 SRNAMT = 'ZGBTRS' 00297 INFOT = 1 00298 CALL ZGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00299 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00300 INFOT = 2 00301 CALL ZGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00302 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00303 INFOT = 3 00304 CALL ZGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 00305 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00306 INFOT = 4 00307 CALL ZGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 00308 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00309 INFOT = 5 00310 CALL ZGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 00311 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00312 INFOT = 7 00313 CALL ZGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 00314 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00315 INFOT = 10 00316 CALL ZGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 00317 CALL CHKXER( 'ZGBTRS', INFOT, NOUT, LERR, OK ) 00318 * 00319 * ZGBRFS 00320 * 00321 SRNAMT = 'ZGBRFS' 00322 INFOT = 1 00323 CALL ZGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00324 $ R2, W, R, INFO ) 00325 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00326 INFOT = 2 00327 CALL ZGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00328 $ R2, W, R, INFO ) 00329 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00330 INFOT = 3 00331 CALL ZGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00332 $ R2, W, R, INFO ) 00333 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00334 INFOT = 4 00335 CALL ZGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00336 $ R2, W, R, INFO ) 00337 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00338 INFOT = 5 00339 CALL ZGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 00340 $ R2, W, R, INFO ) 00341 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00342 INFOT = 7 00343 CALL ZGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 00344 $ R2, W, R, INFO ) 00345 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00346 INFOT = 9 00347 CALL ZGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 00348 $ R2, W, R, INFO ) 00349 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00350 INFOT = 12 00351 CALL ZGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 00352 $ R2, W, R, INFO ) 00353 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00354 INFOT = 14 00355 CALL ZGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 00356 $ R2, W, R, INFO ) 00357 CALL CHKXER( 'ZGBRFS', INFOT, NOUT, LERR, OK ) 00358 * 00359 * ZGBCON 00360 * 00361 SRNAMT = 'ZGBCON' 00362 INFOT = 1 00363 CALL ZGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00364 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00365 INFOT = 2 00366 CALL ZGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00367 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00368 INFOT = 3 00369 CALL ZGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00370 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00371 INFOT = 4 00372 CALL ZGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, R, INFO ) 00373 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00374 INFOT = 6 00375 CALL ZGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, R, INFO ) 00376 CALL CHKXER( 'ZGBCON', INFOT, NOUT, LERR, OK ) 00377 * 00378 * ZGBEQU 00379 * 00380 SRNAMT = 'ZGBEQU' 00381 INFOT = 1 00382 CALL ZGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00383 $ INFO ) 00384 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00385 INFOT = 2 00386 CALL ZGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00387 $ INFO ) 00388 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00389 INFOT = 3 00390 CALL ZGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 00391 $ INFO ) 00392 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00393 INFOT = 4 00394 CALL ZGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 00395 $ INFO ) 00396 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00397 INFOT = 6 00398 CALL ZGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 00399 $ INFO ) 00400 CALL CHKXER( 'ZGBEQU', INFOT, NOUT, LERR, OK ) 00401 END IF 00402 * 00403 * Print a summary line. 00404 * 00405 CALL ALAESM( PATH, OK, NOUT ) 00406 * 00407 RETURN 00408 * 00409 * End of ZERRGE 00410 * 00411 END