|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRQR( 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 * ZERRQR tests the error exits for the COMPLEX*16 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*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 00038 $ W( NMAX ), X( NMAX ) 00039 * .. 00040 * .. External Subroutines .. 00041 EXTERNAL ALAESM, CHKXER, ZGEQR2, ZGEQR2P, ZGEQRF, 00042 $ ZGEQRFP, ZGEQRS, ZUNG2R, ZUNGQR, ZUNM2R, 00043 $ ZUNMQR 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 DBLE, DCMPLX 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 ) = DCMPLX( 1.D0 / DBLE( I+J ), 00067 $ -1.D0 / DBLE( I+J ) ) 00068 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00069 $ -1.D0 / DBLE( I+J ) ) 00070 10 CONTINUE 00071 B( J ) = 0.D0 00072 W( J ) = 0.D0 00073 X( J ) = 0.D0 00074 20 CONTINUE 00075 OK = .TRUE. 00076 * 00077 * Error exits for QR factorization 00078 * 00079 * ZGEQRF 00080 * 00081 SRNAMT = 'ZGEQRF' 00082 INFOT = 1 00083 CALL ZGEQRF( -1, 0, A, 1, B, W, 1, INFO ) 00084 CALL CHKXER( 'ZGEQRF', INFOT, NOUT, LERR, OK ) 00085 INFOT = 2 00086 CALL ZGEQRF( 0, -1, A, 1, B, W, 1, INFO ) 00087 CALL CHKXER( 'ZGEQRF', INFOT, NOUT, LERR, OK ) 00088 INFOT = 4 00089 CALL ZGEQRF( 2, 1, A, 1, B, W, 1, INFO ) 00090 CALL CHKXER( 'ZGEQRF', INFOT, NOUT, LERR, OK ) 00091 INFOT = 7 00092 CALL ZGEQRF( 1, 2, A, 1, B, W, 1, INFO ) 00093 CALL CHKXER( 'ZGEQRF', INFOT, NOUT, LERR, OK ) 00094 * 00095 * ZGEQRFP 00096 * 00097 SRNAMT = 'ZGEQRFP' 00098 INFOT = 1 00099 CALL ZGEQRFP( -1, 0, A, 1, B, W, 1, INFO ) 00100 CALL CHKXER( 'ZGEQRFP', INFOT, NOUT, LERR, OK ) 00101 INFOT = 2 00102 CALL ZGEQRFP( 0, -1, A, 1, B, W, 1, INFO ) 00103 CALL CHKXER( 'ZGEQRFP', INFOT, NOUT, LERR, OK ) 00104 INFOT = 4 00105 CALL ZGEQRFP( 2, 1, A, 1, B, W, 1, INFO ) 00106 CALL CHKXER( 'ZGEQRFP', INFOT, NOUT, LERR, OK ) 00107 INFOT = 7 00108 CALL ZGEQRFP( 1, 2, A, 1, B, W, 1, INFO ) 00109 CALL CHKXER( 'ZGEQRFP', INFOT, NOUT, LERR, OK ) 00110 * 00111 * ZGEQR2 00112 * 00113 SRNAMT = 'ZGEQR2' 00114 INFOT = 1 00115 CALL ZGEQR2( -1, 0, A, 1, B, W, INFO ) 00116 CALL CHKXER( 'ZGEQR2', INFOT, NOUT, LERR, OK ) 00117 INFOT = 2 00118 CALL ZGEQR2( 0, -1, A, 1, B, W, INFO ) 00119 CALL CHKXER( 'ZGEQR2', INFOT, NOUT, LERR, OK ) 00120 INFOT = 4 00121 CALL ZGEQR2( 2, 1, A, 1, B, W, INFO ) 00122 CALL CHKXER( 'ZGEQR2', INFOT, NOUT, LERR, OK ) 00123 * 00124 * ZGEQR2P 00125 * 00126 SRNAMT = 'ZGEQR2P' 00127 INFOT = 1 00128 CALL ZGEQR2P( -1, 0, A, 1, B, W, INFO ) 00129 CALL CHKXER( 'ZGEQR2P', INFOT, NOUT, LERR, OK ) 00130 INFOT = 2 00131 CALL ZGEQR2P( 0, -1, A, 1, B, W, INFO ) 00132 CALL CHKXER( 'ZGEQR2P', INFOT, NOUT, LERR, OK ) 00133 INFOT = 4 00134 CALL ZGEQR2P( 2, 1, A, 1, B, W, INFO ) 00135 CALL CHKXER( 'ZGEQR2P', INFOT, NOUT, LERR, OK ) 00136 * 00137 * ZGEQRS 00138 * 00139 SRNAMT = 'ZGEQRS' 00140 INFOT = 1 00141 CALL ZGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO ) 00142 CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK ) 00143 INFOT = 2 00144 CALL ZGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO ) 00145 CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK ) 00146 INFOT = 2 00147 CALL ZGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO ) 00148 CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK ) 00149 INFOT = 3 00150 CALL ZGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO ) 00151 CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK ) 00152 INFOT = 5 00153 CALL ZGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO ) 00154 CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK ) 00155 INFOT = 8 00156 CALL ZGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO ) 00157 CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK ) 00158 INFOT = 10 00159 CALL ZGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO ) 00160 CALL CHKXER( 'ZGEQRS', INFOT, NOUT, LERR, OK ) 00161 * 00162 * ZUNGQR 00163 * 00164 SRNAMT = 'ZUNGQR' 00165 INFOT = 1 00166 CALL ZUNGQR( -1, 0, 0, A, 1, X, W, 1, INFO ) 00167 CALL CHKXER( 'ZUNGQR', INFOT, NOUT, LERR, OK ) 00168 INFOT = 2 00169 CALL ZUNGQR( 0, -1, 0, A, 1, X, W, 1, INFO ) 00170 CALL CHKXER( 'ZUNGQR', INFOT, NOUT, LERR, OK ) 00171 INFOT = 2 00172 CALL ZUNGQR( 1, 2, 0, A, 1, X, W, 2, INFO ) 00173 CALL CHKXER( 'ZUNGQR', INFOT, NOUT, LERR, OK ) 00174 INFOT = 3 00175 CALL ZUNGQR( 0, 0, -1, A, 1, X, W, 1, INFO ) 00176 CALL CHKXER( 'ZUNGQR', INFOT, NOUT, LERR, OK ) 00177 INFOT = 3 00178 CALL ZUNGQR( 1, 1, 2, A, 1, X, W, 1, INFO ) 00179 CALL CHKXER( 'ZUNGQR', INFOT, NOUT, LERR, OK ) 00180 INFOT = 5 00181 CALL ZUNGQR( 2, 2, 0, A, 1, X, W, 2, INFO ) 00182 CALL CHKXER( 'ZUNGQR', INFOT, NOUT, LERR, OK ) 00183 INFOT = 8 00184 CALL ZUNGQR( 2, 2, 0, A, 2, X, W, 1, INFO ) 00185 CALL CHKXER( 'ZUNGQR', INFOT, NOUT, LERR, OK ) 00186 * 00187 * ZUNG2R 00188 * 00189 SRNAMT = 'ZUNG2R' 00190 INFOT = 1 00191 CALL ZUNG2R( -1, 0, 0, A, 1, X, W, INFO ) 00192 CALL CHKXER( 'ZUNG2R', INFOT, NOUT, LERR, OK ) 00193 INFOT = 2 00194 CALL ZUNG2R( 0, -1, 0, A, 1, X, W, INFO ) 00195 CALL CHKXER( 'ZUNG2R', INFOT, NOUT, LERR, OK ) 00196 INFOT = 2 00197 CALL ZUNG2R( 1, 2, 0, A, 1, X, W, INFO ) 00198 CALL CHKXER( 'ZUNG2R', INFOT, NOUT, LERR, OK ) 00199 INFOT = 3 00200 CALL ZUNG2R( 0, 0, -1, A, 1, X, W, INFO ) 00201 CALL CHKXER( 'ZUNG2R', INFOT, NOUT, LERR, OK ) 00202 INFOT = 3 00203 CALL ZUNG2R( 2, 1, 2, A, 2, X, W, INFO ) 00204 CALL CHKXER( 'ZUNG2R', INFOT, NOUT, LERR, OK ) 00205 INFOT = 5 00206 CALL ZUNG2R( 2, 1, 0, A, 1, X, W, INFO ) 00207 CALL CHKXER( 'ZUNG2R', INFOT, NOUT, LERR, OK ) 00208 * 00209 * ZUNMQR 00210 * 00211 SRNAMT = 'ZUNMQR' 00212 INFOT = 1 00213 CALL ZUNMQR( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00214 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00215 INFOT = 2 00216 CALL ZUNMQR( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00217 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00218 INFOT = 3 00219 CALL ZUNMQR( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00220 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00221 INFOT = 4 00222 CALL ZUNMQR( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO ) 00223 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00224 INFOT = 5 00225 CALL ZUNMQR( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO ) 00226 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00227 INFOT = 5 00228 CALL ZUNMQR( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO ) 00229 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00230 INFOT = 5 00231 CALL ZUNMQR( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO ) 00232 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00233 INFOT = 7 00234 CALL ZUNMQR( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO ) 00235 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00236 INFOT = 7 00237 CALL ZUNMQR( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO ) 00238 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00239 INFOT = 10 00240 CALL ZUNMQR( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO ) 00241 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00242 INFOT = 12 00243 CALL ZUNMQR( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO ) 00244 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00245 INFOT = 12 00246 CALL ZUNMQR( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO ) 00247 CALL CHKXER( 'ZUNMQR', INFOT, NOUT, LERR, OK ) 00248 * 00249 * ZUNM2R 00250 * 00251 SRNAMT = 'ZUNM2R' 00252 INFOT = 1 00253 CALL ZUNM2R( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00254 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00255 INFOT = 2 00256 CALL ZUNM2R( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00257 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00258 INFOT = 3 00259 CALL ZUNM2R( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO ) 00260 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00261 INFOT = 4 00262 CALL ZUNM2R( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO ) 00263 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00264 INFOT = 5 00265 CALL ZUNM2R( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO ) 00266 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00267 INFOT = 5 00268 CALL ZUNM2R( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO ) 00269 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00270 INFOT = 5 00271 CALL ZUNM2R( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO ) 00272 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00273 INFOT = 7 00274 CALL ZUNM2R( 'L', 'N', 2, 1, 0, A, 1, X, AF, 2, W, INFO ) 00275 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00276 INFOT = 7 00277 CALL ZUNM2R( 'R', 'N', 1, 2, 0, A, 1, X, AF, 1, W, INFO ) 00278 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00279 INFOT = 10 00280 CALL ZUNM2R( 'L', 'N', 2, 1, 0, A, 2, X, AF, 1, W, INFO ) 00281 CALL CHKXER( 'ZUNM2R', INFOT, NOUT, LERR, OK ) 00282 * 00283 * Print a summary line. 00284 * 00285 CALL ALAESM( PATH, OK, NOUT ) 00286 * 00287 RETURN 00288 * 00289 * End of ZERRQR 00290 * 00291 END
1.7.3 
