|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CERRQR( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.3.0) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2010 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER NUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * CERRQR tests the error exits for the COMPLEX routines 00016 * that use the QR decomposition of a general matrix. 00017 * 00018 * Arguments 00019 * ========= 00020 * 00021 * PATH (input) CHARACTER*3 00022 * The LAPACK path name for the routines to be tested. 00023 * 00024 * NUNIT (input) INTEGER 00025 * The unit number for output. 00026 * 00027 * ===================================================================== 00028 * 00029 * .. Parameters .. 00030 INTEGER NMAX 00031 PARAMETER ( NMAX = 2 ) 00032 * .. 00033 * .. Local Scalars .. 00034 INTEGER I, INFO, J 00035 * .. 00036 * .. Local Arrays .. 00037 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00038 $ W( NMAX ), X( NMAX ) 00039 * .. 00040 * .. External Subroutines .. 00041 EXTERNAL ALAESM, CGEQR2, CGEQR2P, CGEQRF, CGEQRFP, 00042 $ CGEQRS, CHKXER, CUNG2R, CUNGQR, CUNM2R, 00043 $ CUNMQR 00044 * .. 00045 * .. Scalars in Common .. 00046 LOGICAL LERR, OK 00047 CHARACTER*32 SRNAMT 00048 INTEGER INFOT, NOUT 00049 * .. 00050 * .. Common blocks .. 00051 COMMON / INFOC / INFOT, NOUT, OK, LERR 00052 COMMON / SRNAMC / SRNAMT 00053 * .. 00054 * .. Intrinsic Functions .. 00055 INTRINSIC CMPLX, REAL 00056 * .. 00057 * .. Executable Statements .. 00058 * 00059 NOUT = NUNIT 00060 WRITE( NOUT, FMT = * ) 00061 * 00062 * Set the variables to innocuous values. 00063 * 00064 DO 20 J = 1, NMAX 00065 DO 10 I = 1, NMAX 00066 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00067 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 00068 10 CONTINUE 00069 B( J ) = 0. 00070 W( J ) = 0. 00071 X( J ) = 0. 00072 20 CONTINUE 00073 OK = .TRUE. 00074 * 00075 * Error exits for QR factorization 00076 * 00077 * CGEQRF 00078 * 00079 SRNAMT = 'CGEQRF' 00080 INFOT = 1 00081 CALL CGEQRF( -1, 0, A, 1, B, W, 1, INFO ) 00082 CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK ) 00083 INFOT = 2 00084 CALL CGEQRF( 0, -1, A, 1, B, W, 1, INFO ) 00085 CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK ) 00086 INFOT = 4 00087 CALL CGEQRF( 2, 1, A, 1, B, W, 1, INFO ) 00088 CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK ) 00089 INFOT = 7 00090 CALL CGEQRF( 1, 2, A, 1, B, W, 1, INFO ) 00091 CALL CHKXER( 'CGEQRF', INFOT, NOUT, LERR, OK ) 00092 * 00093 * CGEQRFP 00094 * 00095 SRNAMT = 'CGEQRFP' 00096 INFOT = 1 00097 CALL CGEQRFP( -1, 0, A, 1, B, W, 1, INFO ) 00098 CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK ) 00099 INFOT = 2 00100 CALL CGEQRFP( 0, -1, A, 1, B, W, 1, INFO ) 00101 CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK ) 00102 INFOT = 4 00103 CALL CGEQRFP( 2, 1, A, 1, B, W, 1, INFO ) 00104 CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK ) 00105 INFOT = 7 00106 CALL CGEQRFP( 1, 2, A, 1, B, W, 1, INFO ) 00107 CALL CHKXER( 'CGEQRFP', INFOT, NOUT, LERR, OK ) 00108 * 00109 * CGEQR2 00110 * 00111 SRNAMT = 'CGEQR2' 00112 INFOT = 1 00113 CALL CGEQR2( -1, 0, A, 1, B, W, INFO ) 00114 CALL CHKXER( 'CGEQR2', INFOT, NOUT, LERR, OK ) 00115 INFOT = 2 00116 CALL CGEQR2( 0, -1, A, 1, B, W, INFO ) 00117 CALL CHKXER( 'CGEQR2', INFOT, NOUT, LERR, OK ) 00118 INFOT = 4 00119 CALL CGEQR2( 2, 1, A, 1, B, W, INFO ) 00120 CALL CHKXER( 'CGEQR2', INFOT, NOUT, LERR, OK ) 00121 * 00122 * CGEQR2P 00123 * 00124 SRNAMT = 'CGEQR2P' 00125 INFOT = 1 00126 CALL CGEQR2P( -1, 0, A, 1, B, W, INFO ) 00127 CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK ) 00128 INFOT = 2 00129 CALL CGEQR2P( 0, -1, A, 1, B, W, INFO ) 00130 CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK ) 00131 INFOT = 4 00132 CALL CGEQR2P( 2, 1, A, 1, B, W, INFO ) 00133 CALL CHKXER( 'CGEQR2P', INFOT, NOUT, LERR, OK ) 00134 * 00135 * CGEQRS 00136 * 00137 SRNAMT = 'CGEQRS' 00138 INFOT = 1 00139 CALL CGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO ) 00140 CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL CGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO ) 00143 CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK ) 00144 INFOT = 2 00145 CALL CGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO ) 00146 CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK ) 00147 INFOT = 3 00148 CALL CGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO ) 00149 CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK ) 00150 INFOT = 5 00151 CALL CGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO ) 00152 CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK ) 00153 INFOT = 8 00154 CALL CGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO ) 00155 CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK ) 00156 INFOT = 10 00157 CALL CGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO ) 00158 CALL CHKXER( 'CGEQRS', INFOT, NOUT, LERR, OK ) 00159 * 00160 * CUNGQR 00161 * 00162 SRNAMT = 'CUNGQR' 00163 INFOT = 1 00164 CALL CUNGQR( -1, 0, 0, A, 1, X, W, 1, INFO ) 00165 CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK ) 00166 INFOT = 2 00167 CALL CUNGQR( 0, -1, 0, A, 1, X, W, 1, INFO ) 00168 CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK ) 00169 INFOT = 2 00170 CALL CUNGQR( 1, 2, 0, A, 1, X, W, 2, INFO ) 00171 CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK ) 00172 INFOT = 3 00173 CALL CUNGQR( 0, 0, -1, A, 1, X, W, 1, INFO ) 00174 CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK ) 00175 INFOT = 3 00176 CALL CUNGQR( 1, 1, 2, A, 1, X, W, 1, INFO ) 00177 CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK ) 00178 INFOT = 5 00179 CALL CUNGQR( 2, 2, 0, A, 1, X, W, 2, INFO ) 00180 CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK ) 00181 INFOT = 8 00182 CALL CUNGQR( 2, 2, 0, A, 2, X, W, 1, INFO ) 00183 CALL CHKXER( 'CUNGQR', INFOT, NOUT, LERR, OK ) 00184 * 00185 * CUNG2R 00186 * 00187 SRNAMT = 'CUNG2R' 00188 INFOT = 1 00189 CALL CUNG2R( -1, 0, 0, A, 1, X, W, INFO ) 00190 CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK ) 00191 INFOT = 2 00192 CALL CUNG2R( 0, -1, 0, A, 1, X, W, INFO ) 00193 CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK ) 00194 INFOT = 2 00195 CALL CUNG2R( 1, 2, 0, A, 1, X, W, INFO ) 00196 CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK ) 00197 INFOT = 3 00198 CALL CUNG2R( 0, 0, -1, A, 1, X, W, INFO ) 00199 CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK ) 00200 INFOT = 3 00201 CALL CUNG2R( 2, 1, 2, A, 2, X, W, INFO ) 00202 CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK ) 00203 INFOT = 5 00204 CALL CUNG2R( 2, 1, 0, A, 1, X, W, INFO ) 00205 CALL CHKXER( 'CUNG2R', INFOT, NOUT, LERR, OK ) 00206 * 00207 * CUNMQR 00208 * 00209 SRNAMT = 'CUNMQR' 00210 INFOT = 1 00211 CALL CUNMQR( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00212 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00213 INFOT = 2 00214 CALL CUNMQR( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00215 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00216 INFOT = 3 00217 CALL CUNMQR( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00218 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00219 INFOT = 4 00220 CALL CUNMQR( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO ) 00221 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00222 INFOT = 5 00223 CALL CUNMQR( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO ) 00224 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00225 INFOT = 5 00226 CALL CUNMQR( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO ) 00227 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00228 INFOT = 5 00229 CALL CUNMQR( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO ) 00230 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00231 INFOT = 7 00232 CALL CUNMQR( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO ) 00233 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00234 INFOT = 7 00235 CALL CUNMQR( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO ) 00236 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00237 INFOT = 10 00238 CALL CUNMQR( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO ) 00239 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00240 INFOT = 12 00241 CALL CUNMQR( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO ) 00242 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00243 INFOT = 12 00244 CALL CUNMQR( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO ) 00245 CALL CHKXER( 'CUNMQR', INFOT, NOUT, LERR, OK ) 00246 * 00247 * CUNM2R 00248 * 00249 SRNAMT = 'CUNM2R' 00250 INFOT = 1 00251 CALL CUNM2R( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00252 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00253 INFOT = 2 00254 CALL CUNM2R( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00255 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00256 INFOT = 3 00257 CALL CUNM2R( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO ) 00258 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00259 INFOT = 4 00260 CALL CUNM2R( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO ) 00261 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00262 INFOT = 5 00263 CALL CUNM2R( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO ) 00264 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00265 INFOT = 5 00266 CALL CUNM2R( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO ) 00267 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00268 INFOT = 5 00269 CALL CUNM2R( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO ) 00270 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00271 INFOT = 7 00272 CALL CUNM2R( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, INFO ) 00273 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00274 INFOT = 7 00275 CALL CUNM2R( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, INFO ) 00276 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00277 INFOT = 10 00278 CALL CUNM2R( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, INFO ) 00279 CALL CHKXER( 'CUNM2R', INFOT, NOUT, LERR, OK ) 00280 * 00281 * Print a summary line. 00282 * 00283 CALL ALAESM( PATH, OK, NOUT ) 00284 * 00285 RETURN 00286 * 00287 * End of CERRQR 00288 * 00289 END
1.7.3 
