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