 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE ZERRRQ( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER NUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * ZERRRQ tests the error exits for the COMPLEX*16 routines 00016 * that use the RQ 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, ZGERQ2, ZGERQF, ZGERQS, ZUNGR2, 00042 $ ZUNGRQ, ZUNMR2, ZUNMRQ 00043 * .. 00044 * .. Scalars in Common .. 00045 LOGICAL LERR, OK 00046 CHARACTER*32 SRNAMT 00047 INTEGER INFOT, NOUT 00048 * .. 00049 * .. Common blocks .. 00050 COMMON / INFOC / INFOT, NOUT, OK, LERR 00051 COMMON / SRNAMC / SRNAMT 00052 * .. 00053 * .. Intrinsic Functions .. 00054 INTRINSIC DBLE, DCMPLX 00055 * .. 00056 * .. Executable Statements .. 00057 * 00058 NOUT = NUNIT 00059 WRITE( NOUT, FMT = * ) 00060 * 00061 * Set the variables to innocuous values. 00062 * 00063 DO 20 J = 1, NMAX 00064 DO 10 I = 1, NMAX 00065 A( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00066 $ -1.D0 / DBLE( I+J ) ) 00067 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ), 00068 $ -1.D0 / DBLE( I+J ) ) 00069 10 CONTINUE 00070 B( J ) = 0.D0 00071 W( J ) = 0.D0 00072 X( J ) = 0.D0 00073 20 CONTINUE 00074 OK = .TRUE. 00075 * 00076 * Error exits for RQ factorization 00077 * 00078 * ZGERQF 00079 * 00080 SRNAMT = 'ZGERQF' 00081 INFOT = 1 00082 CALL ZGERQF( -1, 0, A, 1, B, W, 1, INFO ) 00083 CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK ) 00084 INFOT = 2 00085 CALL ZGERQF( 0, -1, A, 1, B, W, 1, INFO ) 00086 CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK ) 00087 INFOT = 4 00088 CALL ZGERQF( 2, 1, A, 1, B, W, 2, INFO ) 00089 CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK ) 00090 INFOT = 7 00091 CALL ZGERQF( 2, 1, A, 2, B, W, 1, INFO ) 00092 CALL CHKXER( 'ZGERQF', INFOT, NOUT, LERR, OK ) 00093 * 00094 * ZGERQ2 00095 * 00096 SRNAMT = 'ZGERQ2' 00097 INFOT = 1 00098 CALL ZGERQ2( -1, 0, A, 1, B, W, INFO ) 00099 CALL CHKXER( 'ZGERQ2', INFOT, NOUT, LERR, OK ) 00100 INFOT = 2 00101 CALL ZGERQ2( 0, -1, A, 1, B, W, INFO ) 00102 CALL CHKXER( 'ZGERQ2', INFOT, NOUT, LERR, OK ) 00103 INFOT = 4 00104 CALL ZGERQ2( 2, 1, A, 1, B, W, INFO ) 00105 CALL CHKXER( 'ZGERQ2', INFOT, NOUT, LERR, OK ) 00106 * 00107 * ZGERQS 00108 * 00109 SRNAMT = 'ZGERQS' 00110 INFOT = 1 00111 CALL ZGERQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO ) 00112 CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK ) 00113 INFOT = 2 00114 CALL ZGERQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO ) 00115 CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK ) 00116 INFOT = 2 00117 CALL ZGERQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO ) 00118 CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK ) 00119 INFOT = 3 00120 CALL ZGERQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO ) 00121 CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK ) 00122 INFOT = 5 00123 CALL ZGERQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO ) 00124 CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK ) 00125 INFOT = 8 00126 CALL ZGERQS( 2, 2, 0, A, 2, X, B, 1, W, 1, INFO ) 00127 CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK ) 00128 INFOT = 10 00129 CALL ZGERQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO ) 00130 CALL CHKXER( 'ZGERQS', INFOT, NOUT, LERR, OK ) 00131 * 00132 * ZUNGRQ 00133 * 00134 SRNAMT = 'ZUNGRQ' 00135 INFOT = 1 00136 CALL ZUNGRQ( -1, 0, 0, A, 1, X, W, 1, INFO ) 00137 CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK ) 00138 INFOT = 2 00139 CALL ZUNGRQ( 0, -1, 0, A, 1, X, W, 1, INFO ) 00140 CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL ZUNGRQ( 2, 1, 0, A, 2, X, W, 2, INFO ) 00143 CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK ) 00144 INFOT = 3 00145 CALL ZUNGRQ( 0, 0, -1, A, 1, X, W, 1, INFO ) 00146 CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK ) 00147 INFOT = 3 00148 CALL ZUNGRQ( 1, 2, 2, A, 1, X, W, 1, INFO ) 00149 CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK ) 00150 INFOT = 5 00151 CALL ZUNGRQ( 2, 2, 0, A, 1, X, W, 2, INFO ) 00152 CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK ) 00153 INFOT = 8 00154 CALL ZUNGRQ( 2, 2, 0, A, 2, X, W, 1, INFO ) 00155 CALL CHKXER( 'ZUNGRQ', INFOT, NOUT, LERR, OK ) 00156 * 00157 * ZUNGR2 00158 * 00159 SRNAMT = 'ZUNGR2' 00160 INFOT = 1 00161 CALL ZUNGR2( -1, 0, 0, A, 1, X, W, INFO ) 00162 CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK ) 00163 INFOT = 2 00164 CALL ZUNGR2( 0, -1, 0, A, 1, X, W, INFO ) 00165 CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK ) 00166 INFOT = 2 00167 CALL ZUNGR2( 2, 1, 0, A, 2, X, W, INFO ) 00168 CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK ) 00169 INFOT = 3 00170 CALL ZUNGR2( 0, 0, -1, A, 1, X, W, INFO ) 00171 CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK ) 00172 INFOT = 3 00173 CALL ZUNGR2( 1, 2, 2, A, 2, X, W, INFO ) 00174 CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK ) 00175 INFOT = 5 00176 CALL ZUNGR2( 2, 2, 0, A, 1, X, W, INFO ) 00177 CALL CHKXER( 'ZUNGR2', INFOT, NOUT, LERR, OK ) 00178 * 00179 * ZUNMRQ 00180 * 00181 SRNAMT = 'ZUNMRQ' 00182 INFOT = 1 00183 CALL ZUNMRQ( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00184 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00185 INFOT = 2 00186 CALL ZUNMRQ( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00187 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00188 INFOT = 3 00189 CALL ZUNMRQ( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 00190 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00191 INFOT = 4 00192 CALL ZUNMRQ( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO ) 00193 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00194 INFOT = 5 00195 CALL ZUNMRQ( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO ) 00196 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00197 INFOT = 5 00198 CALL ZUNMRQ( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO ) 00199 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00200 INFOT = 5 00201 CALL ZUNMRQ( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO ) 00202 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00203 INFOT = 7 00204 CALL ZUNMRQ( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, 1, INFO ) 00205 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00206 INFOT = 7 00207 CALL ZUNMRQ( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, 1, INFO ) 00208 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00209 INFOT = 10 00210 CALL ZUNMRQ( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, 1, INFO ) 00211 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00212 INFOT = 12 00213 CALL ZUNMRQ( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO ) 00214 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00215 INFOT = 12 00216 CALL ZUNMRQ( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO ) 00217 CALL CHKXER( 'ZUNMRQ', INFOT, NOUT, LERR, OK ) 00218 * 00219 * ZUNMR2 00220 * 00221 SRNAMT = 'ZUNMR2' 00222 INFOT = 1 00223 CALL ZUNMR2( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00224 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00225 INFOT = 2 00226 CALL ZUNMR2( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 00227 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00228 INFOT = 3 00229 CALL ZUNMR2( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO ) 00230 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00231 INFOT = 4 00232 CALL ZUNMR2( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO ) 00233 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00234 INFOT = 5 00235 CALL ZUNMR2( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO ) 00236 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00237 INFOT = 5 00238 CALL ZUNMR2( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO ) 00239 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00240 INFOT = 5 00241 CALL ZUNMR2( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO ) 00242 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00243 INFOT = 7 00244 CALL ZUNMR2( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, INFO ) 00245 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00246 INFOT = 7 00247 CALL ZUNMR2( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, INFO ) 00248 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00249 INFOT = 10 00250 CALL ZUNMR2( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, INFO ) 00251 CALL CHKXER( 'ZUNMR2', INFOT, NOUT, LERR, OK ) 00252 * 00253 * Print a summary line. 00254 * 00255 CALL ALAESM( PATH, OK, NOUT ) 00256 * 00257 RETURN 00258 * 00259 * End of ZERRRQ 00260 * 00261 END
1.7.3 
