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