|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CERRHS( 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 * CERRHS tests the error exits for CGEBAK, CGEBAL, CGEHRD, CUNGHR, 00016 * CUNMHR, CHSEQR, CHSEIN, and CTREVC. 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, LW 00031 PARAMETER ( NMAX = 3, LW = NMAX*NMAX ) 00032 * .. 00033 * .. Local Scalars .. 00034 CHARACTER*2 C2 00035 INTEGER I, IHI, ILO, INFO, J, M, NT 00036 * .. 00037 * .. Local Arrays .. 00038 LOGICAL SEL( NMAX ) 00039 INTEGER IFAILL( NMAX ), IFAILR( NMAX ) 00040 REAL RW( NMAX ), S( NMAX ) 00041 COMPLEX A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ), 00042 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ), 00043 $ X( NMAX ) 00044 * .. 00045 * .. External Functions .. 00046 LOGICAL LSAMEN 00047 EXTERNAL LSAMEN 00048 * .. 00049 * .. External Subroutines .. 00050 EXTERNAL CHKXER, CGEBAK, CGEBAL, CGEHRD, CHSEIN, CHSEQR, 00051 $ CUNGHR, CUNMHR, CTREVC 00052 * .. 00053 * .. Intrinsic Functions .. 00054 INTRINSIC REAL 00055 * .. 00056 * .. Scalars in Common .. 00057 LOGICAL LERR, OK 00058 CHARACTER*32 SRNAMT 00059 INTEGER INFOT, NOUT 00060 * .. 00061 * .. Common blocks .. 00062 COMMON / INFOC / INFOT, NOUT, OK, LERR 00063 COMMON / SRNAMC / SRNAMT 00064 * .. 00065 * .. Executable Statements .. 00066 * 00067 NOUT = NUNIT 00068 WRITE( NOUT, FMT = * ) 00069 C2 = PATH( 2: 3 ) 00070 * 00071 * Set the variables to innocuous values. 00072 * 00073 DO 20 J = 1, NMAX 00074 DO 10 I = 1, NMAX 00075 A( I, J ) = 1. / REAL( I+J ) 00076 10 CONTINUE 00077 SEL( J ) = .TRUE. 00078 20 CONTINUE 00079 OK = .TRUE. 00080 NT = 0 00081 * 00082 * Test error exits of the nonsymmetric eigenvalue routines. 00083 * 00084 IF( LSAMEN( 2, C2, 'HS' ) ) THEN 00085 * 00086 * CGEBAL 00087 * 00088 SRNAMT = 'CGEBAL' 00089 INFOT = 1 00090 CALL CGEBAL( '/', 0, A, 1, ILO, IHI, S, INFO ) 00091 CALL CHKXER( 'CGEBAL', INFOT, NOUT, LERR, OK ) 00092 INFOT = 2 00093 CALL CGEBAL( 'N', -1, A, 1, ILO, IHI, S, INFO ) 00094 CALL CHKXER( 'CGEBAL', INFOT, NOUT, LERR, OK ) 00095 INFOT = 4 00096 CALL CGEBAL( 'N', 2, A, 1, ILO, IHI, S, INFO ) 00097 CALL CHKXER( 'CGEBAL', INFOT, NOUT, LERR, OK ) 00098 NT = NT + 3 00099 * 00100 * CGEBAK 00101 * 00102 SRNAMT = 'CGEBAK' 00103 INFOT = 1 00104 CALL CGEBAK( '/', 'R', 0, 1, 0, S, 0, A, 1, INFO ) 00105 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00106 INFOT = 2 00107 CALL CGEBAK( 'N', '/', 0, 1, 0, S, 0, A, 1, INFO ) 00108 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00109 INFOT = 3 00110 CALL CGEBAK( 'N', 'R', -1, 1, 0, S, 0, A, 1, INFO ) 00111 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00112 INFOT = 4 00113 CALL CGEBAK( 'N', 'R', 0, 0, 0, S, 0, A, 1, INFO ) 00114 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00115 INFOT = 4 00116 CALL CGEBAK( 'N', 'R', 0, 2, 0, S, 0, A, 1, INFO ) 00117 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00118 INFOT = 5 00119 CALL CGEBAK( 'N', 'R', 2, 2, 1, S, 0, A, 2, INFO ) 00120 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00121 INFOT = 5 00122 CALL CGEBAK( 'N', 'R', 0, 1, 1, S, 0, A, 1, INFO ) 00123 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00124 INFOT = 7 00125 CALL CGEBAK( 'N', 'R', 0, 1, 0, S, -1, A, 1, INFO ) 00126 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00127 INFOT = 9 00128 CALL CGEBAK( 'N', 'R', 2, 1, 2, S, 0, A, 1, INFO ) 00129 CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK ) 00130 NT = NT + 9 00131 * 00132 * CGEHRD 00133 * 00134 SRNAMT = 'CGEHRD' 00135 INFOT = 1 00136 CALL CGEHRD( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00137 CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK ) 00138 INFOT = 2 00139 CALL CGEHRD( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00140 CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL CGEHRD( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00143 CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK ) 00144 INFOT = 3 00145 CALL CGEHRD( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00146 CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK ) 00147 INFOT = 3 00148 CALL CGEHRD( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00149 CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK ) 00150 INFOT = 5 00151 CALL CGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO ) 00152 CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK ) 00153 INFOT = 8 00154 CALL CGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO ) 00155 CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK ) 00156 NT = NT + 7 00157 * 00158 * CUNGHR 00159 * 00160 SRNAMT = 'CUNGHR' 00161 INFOT = 1 00162 CALL CUNGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00163 CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK ) 00164 INFOT = 2 00165 CALL CUNGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00166 CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK ) 00167 INFOT = 2 00168 CALL CUNGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00169 CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK ) 00170 INFOT = 3 00171 CALL CUNGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00172 CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK ) 00173 INFOT = 3 00174 CALL CUNGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00175 CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK ) 00176 INFOT = 5 00177 CALL CUNGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO ) 00178 CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK ) 00179 INFOT = 8 00180 CALL CUNGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO ) 00181 CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK ) 00182 NT = NT + 7 00183 * 00184 * CUNMHR 00185 * 00186 SRNAMT = 'CUNMHR' 00187 INFOT = 1 00188 CALL CUNMHR( '/', 'N', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00189 $ INFO ) 00190 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00191 INFOT = 2 00192 CALL CUNMHR( 'L', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00193 $ INFO ) 00194 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00195 INFOT = 3 00196 CALL CUNMHR( 'L', 'N', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00197 $ INFO ) 00198 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00199 INFOT = 4 00200 CALL CUNMHR( 'L', 'N', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1, 00201 $ INFO ) 00202 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00203 INFOT = 5 00204 CALL CUNMHR( 'L', 'N', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1, 00205 $ INFO ) 00206 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00207 INFOT = 5 00208 CALL CUNMHR( 'L', 'N', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1, 00209 $ INFO ) 00210 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00211 INFOT = 5 00212 CALL CUNMHR( 'L', 'N', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2, 00213 $ INFO ) 00214 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00215 INFOT = 5 00216 CALL CUNMHR( 'R', 'N', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2, 00217 $ INFO ) 00218 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00219 INFOT = 6 00220 CALL CUNMHR( 'L', 'N', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1, 00221 $ INFO ) 00222 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00223 INFOT = 6 00224 CALL CUNMHR( 'L', 'N', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1, 00225 $ INFO ) 00226 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00227 INFOT = 6 00228 CALL CUNMHR( 'R', 'N', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1, 00229 $ INFO ) 00230 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00231 INFOT = 8 00232 CALL CUNMHR( 'L', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00233 $ INFO ) 00234 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00235 INFOT = 8 00236 CALL CUNMHR( 'R', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00237 $ INFO ) 00238 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00239 INFOT = 11 00240 CALL CUNMHR( 'L', 'N', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1, 00241 $ INFO ) 00242 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00243 INFOT = 13 00244 CALL CUNMHR( 'L', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00245 $ INFO ) 00246 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00247 INFOT = 13 00248 CALL CUNMHR( 'R', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00249 $ INFO ) 00250 CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK ) 00251 NT = NT + 16 00252 * 00253 * CHSEQR 00254 * 00255 SRNAMT = 'CHSEQR' 00256 INFOT = 1 00257 CALL CHSEQR( '/', 'N', 0, 1, 0, A, 1, X, C, 1, W, 1, 00258 $ INFO ) 00259 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00260 INFOT = 2 00261 CALL CHSEQR( 'E', '/', 0, 1, 0, A, 1, X, C, 1, W, 1, 00262 $ INFO ) 00263 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00264 INFOT = 3 00265 CALL CHSEQR( 'E', 'N', -1, 1, 0, A, 1, X, C, 1, W, 1, 00266 $ INFO ) 00267 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00268 INFOT = 4 00269 CALL CHSEQR( 'E', 'N', 0, 0, 0, A, 1, X, C, 1, W, 1, 00270 $ INFO ) 00271 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00272 INFOT = 4 00273 CALL CHSEQR( 'E', 'N', 0, 2, 0, A, 1, X, C, 1, W, 1, 00274 $ INFO ) 00275 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00276 INFOT = 5 00277 CALL CHSEQR( 'E', 'N', 1, 1, 0, A, 1, X, C, 1, W, 1, 00278 $ INFO ) 00279 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00280 INFOT = 5 00281 CALL CHSEQR( 'E', 'N', 1, 1, 2, A, 1, X, C, 1, W, 1, 00282 $ INFO ) 00283 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00284 INFOT = 7 00285 CALL CHSEQR( 'E', 'N', 2, 1, 2, A, 1, X, C, 2, W, 1, 00286 $ INFO ) 00287 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00288 INFOT = 10 00289 CALL CHSEQR( 'E', 'V', 2, 1, 2, A, 2, X, C, 1, W, 1, 00290 $ INFO ) 00291 CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK ) 00292 NT = NT + 9 00293 * 00294 * CHSEIN 00295 * 00296 SRNAMT = 'CHSEIN' 00297 INFOT = 1 00298 CALL CHSEIN( '/', 'N', 'N', SEL, 0, A, 1, X, VL, 1, VR, 1, 00299 $ 0, M, W, RW, IFAILL, IFAILR, INFO ) 00300 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00301 INFOT = 2 00302 CALL CHSEIN( 'R', '/', 'N', SEL, 0, A, 1, X, VL, 1, VR, 1, 00303 $ 0, M, W, RW, IFAILL, IFAILR, INFO ) 00304 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00305 INFOT = 3 00306 CALL CHSEIN( 'R', 'N', '/', SEL, 0, A, 1, X, VL, 1, VR, 1, 00307 $ 0, M, W, RW, IFAILL, IFAILR, INFO ) 00308 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00309 INFOT = 5 00310 CALL CHSEIN( 'R', 'N', 'N', SEL, -1, A, 1, X, VL, 1, VR, 00311 $ 1, 0, M, W, RW, IFAILL, IFAILR, INFO ) 00312 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00313 INFOT = 7 00314 CALL CHSEIN( 'R', 'N', 'N', SEL, 2, A, 1, X, VL, 1, VR, 2, 00315 $ 4, M, W, RW, IFAILL, IFAILR, INFO ) 00316 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00317 INFOT = 10 00318 CALL CHSEIN( 'L', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 1, 00319 $ 4, M, W, RW, IFAILL, IFAILR, INFO ) 00320 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00321 INFOT = 12 00322 CALL CHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 1, 00323 $ 4, M, W, RW, IFAILL, IFAILR, INFO ) 00324 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00325 INFOT = 13 00326 CALL CHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 2, 00327 $ 1, M, W, RW, IFAILL, IFAILR, INFO ) 00328 CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK ) 00329 NT = NT + 8 00330 * 00331 * CTREVC 00332 * 00333 SRNAMT = 'CTREVC' 00334 INFOT = 1 00335 CALL CTREVC( '/', 'A', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, 00336 $ RW, INFO ) 00337 CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK ) 00338 INFOT = 2 00339 CALL CTREVC( 'L', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, 00340 $ RW, INFO ) 00341 CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK ) 00342 INFOT = 4 00343 CALL CTREVC( 'L', 'A', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W, 00344 $ RW, INFO ) 00345 CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK ) 00346 INFOT = 6 00347 CALL CTREVC( 'L', 'A', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W, 00348 $ RW, INFO ) 00349 CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK ) 00350 INFOT = 8 00351 CALL CTREVC( 'L', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, 00352 $ RW, INFO ) 00353 CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK ) 00354 INFOT = 10 00355 CALL CTREVC( 'R', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, 00356 $ RW, INFO ) 00357 CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK ) 00358 INFOT = 11 00359 CALL CTREVC( 'L', 'A', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W, 00360 $ RW, INFO ) 00361 CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK ) 00362 NT = NT + 7 00363 END IF 00364 * 00365 * Print a summary line. 00366 * 00367 IF( OK ) THEN 00368 WRITE( NOUT, FMT = 9999 )PATH, NT 00369 ELSE 00370 WRITE( NOUT, FMT = 9998 )PATH 00371 END IF 00372 * 00373 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits', 00374 $ ' (', I3, ' tests done)' ) 00375 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 00376 $ 'exits ***' ) 00377 * 00378 RETURN 00379 * 00380 * End of CERRHS 00381 * 00382 END
1.7.3 
