|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRHS( 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 * ZERRHS tests the error exits for ZGEBAK, CGEBAL, CGEHRD, ZUNGHR, 00016 * ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC. 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 DOUBLE PRECISION RW( NMAX ), S( NMAX ) 00041 COMPLEX*16 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, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEIN, ZHSEQR, 00051 $ ZTREVC, ZUNGHR, ZUNMHR 00052 * .. 00053 * .. Intrinsic Functions .. 00054 INTRINSIC DBLE 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.D0 / DBLE( 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 * ZGEBAL 00087 * 00088 SRNAMT = 'ZGEBAL' 00089 INFOT = 1 00090 CALL ZGEBAL( '/', 0, A, 1, ILO, IHI, S, INFO ) 00091 CALL CHKXER( 'ZGEBAL', INFOT, NOUT, LERR, OK ) 00092 INFOT = 2 00093 CALL ZGEBAL( 'N', -1, A, 1, ILO, IHI, S, INFO ) 00094 CALL CHKXER( 'ZGEBAL', INFOT, NOUT, LERR, OK ) 00095 INFOT = 4 00096 CALL ZGEBAL( 'N', 2, A, 1, ILO, IHI, S, INFO ) 00097 CALL CHKXER( 'ZGEBAL', INFOT, NOUT, LERR, OK ) 00098 NT = NT + 3 00099 * 00100 * ZGEBAK 00101 * 00102 SRNAMT = 'ZGEBAK' 00103 INFOT = 1 00104 CALL ZGEBAK( '/', 'R', 0, 1, 0, S, 0, A, 1, INFO ) 00105 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00106 INFOT = 2 00107 CALL ZGEBAK( 'N', '/', 0, 1, 0, S, 0, A, 1, INFO ) 00108 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00109 INFOT = 3 00110 CALL ZGEBAK( 'N', 'R', -1, 1, 0, S, 0, A, 1, INFO ) 00111 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00112 INFOT = 4 00113 CALL ZGEBAK( 'N', 'R', 0, 0, 0, S, 0, A, 1, INFO ) 00114 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00115 INFOT = 4 00116 CALL ZGEBAK( 'N', 'R', 0, 2, 0, S, 0, A, 1, INFO ) 00117 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00118 INFOT = 5 00119 CALL ZGEBAK( 'N', 'R', 2, 2, 1, S, 0, A, 2, INFO ) 00120 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00121 INFOT = 5 00122 CALL ZGEBAK( 'N', 'R', 0, 1, 1, S, 0, A, 1, INFO ) 00123 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00124 INFOT = 7 00125 CALL ZGEBAK( 'N', 'R', 0, 1, 0, S, -1, A, 1, INFO ) 00126 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00127 INFOT = 9 00128 CALL ZGEBAK( 'N', 'R', 2, 1, 2, S, 0, A, 1, INFO ) 00129 CALL CHKXER( 'ZGEBAK', INFOT, NOUT, LERR, OK ) 00130 NT = NT + 9 00131 * 00132 * ZGEHRD 00133 * 00134 SRNAMT = 'ZGEHRD' 00135 INFOT = 1 00136 CALL ZGEHRD( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00137 CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK ) 00138 INFOT = 2 00139 CALL ZGEHRD( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00140 CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK ) 00141 INFOT = 2 00142 CALL ZGEHRD( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00143 CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK ) 00144 INFOT = 3 00145 CALL ZGEHRD( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00146 CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK ) 00147 INFOT = 3 00148 CALL ZGEHRD( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00149 CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK ) 00150 INFOT = 5 00151 CALL ZGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO ) 00152 CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK ) 00153 INFOT = 8 00154 CALL ZGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO ) 00155 CALL CHKXER( 'ZGEHRD', INFOT, NOUT, LERR, OK ) 00156 NT = NT + 7 00157 * 00158 * ZUNGHR 00159 * 00160 SRNAMT = 'ZUNGHR' 00161 INFOT = 1 00162 CALL ZUNGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00163 CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK ) 00164 INFOT = 2 00165 CALL ZUNGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00166 CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK ) 00167 INFOT = 2 00168 CALL ZUNGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00169 CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK ) 00170 INFOT = 3 00171 CALL ZUNGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00172 CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK ) 00173 INFOT = 3 00174 CALL ZUNGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00175 CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK ) 00176 INFOT = 5 00177 CALL ZUNGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO ) 00178 CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK ) 00179 INFOT = 8 00180 CALL ZUNGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO ) 00181 CALL CHKXER( 'ZUNGHR', INFOT, NOUT, LERR, OK ) 00182 NT = NT + 7 00183 * 00184 * ZUNMHR 00185 * 00186 SRNAMT = 'ZUNMHR' 00187 INFOT = 1 00188 CALL ZUNMHR( '/', 'N', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00189 $ INFO ) 00190 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00191 INFOT = 2 00192 CALL ZUNMHR( 'L', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00193 $ INFO ) 00194 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00195 INFOT = 3 00196 CALL ZUNMHR( 'L', 'N', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00197 $ INFO ) 00198 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00199 INFOT = 4 00200 CALL ZUNMHR( 'L', 'N', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1, 00201 $ INFO ) 00202 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00203 INFOT = 5 00204 CALL ZUNMHR( 'L', 'N', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1, 00205 $ INFO ) 00206 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00207 INFOT = 5 00208 CALL ZUNMHR( 'L', 'N', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1, 00209 $ INFO ) 00210 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00211 INFOT = 5 00212 CALL ZUNMHR( 'L', 'N', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2, 00213 $ INFO ) 00214 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00215 INFOT = 5 00216 CALL ZUNMHR( 'R', 'N', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2, 00217 $ INFO ) 00218 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00219 INFOT = 6 00220 CALL ZUNMHR( 'L', 'N', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1, 00221 $ INFO ) 00222 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00223 INFOT = 6 00224 CALL ZUNMHR( 'L', 'N', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1, 00225 $ INFO ) 00226 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00227 INFOT = 6 00228 CALL ZUNMHR( 'R', 'N', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1, 00229 $ INFO ) 00230 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00231 INFOT = 8 00232 CALL ZUNMHR( 'L', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00233 $ INFO ) 00234 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00235 INFOT = 8 00236 CALL ZUNMHR( 'R', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00237 $ INFO ) 00238 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00239 INFOT = 11 00240 CALL ZUNMHR( 'L', 'N', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1, 00241 $ INFO ) 00242 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00243 INFOT = 13 00244 CALL ZUNMHR( 'L', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00245 $ INFO ) 00246 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00247 INFOT = 13 00248 CALL ZUNMHR( 'R', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00249 $ INFO ) 00250 CALL CHKXER( 'ZUNMHR', INFOT, NOUT, LERR, OK ) 00251 NT = NT + 16 00252 * 00253 * ZHSEQR 00254 * 00255 SRNAMT = 'ZHSEQR' 00256 INFOT = 1 00257 CALL ZHSEQR( '/', 'N', 0, 1, 0, A, 1, X, C, 1, W, 1, INFO ) 00258 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00259 INFOT = 2 00260 CALL ZHSEQR( 'E', '/', 0, 1, 0, A, 1, X, C, 1, W, 1, INFO ) 00261 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00262 INFOT = 3 00263 CALL ZHSEQR( 'E', 'N', -1, 1, 0, A, 1, X, C, 1, W, 1, INFO ) 00264 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00265 INFOT = 4 00266 CALL ZHSEQR( 'E', 'N', 0, 0, 0, A, 1, X, C, 1, W, 1, INFO ) 00267 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00268 INFOT = 4 00269 CALL ZHSEQR( 'E', 'N', 0, 2, 0, A, 1, X, C, 1, W, 1, INFO ) 00270 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00271 INFOT = 5 00272 CALL ZHSEQR( 'E', 'N', 1, 1, 0, A, 1, X, C, 1, W, 1, INFO ) 00273 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00274 INFOT = 5 00275 CALL ZHSEQR( 'E', 'N', 1, 1, 2, A, 1, X, C, 1, W, 1, INFO ) 00276 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00277 INFOT = 7 00278 CALL ZHSEQR( 'E', 'N', 2, 1, 2, A, 1, X, C, 2, W, 1, INFO ) 00279 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00280 INFOT = 10 00281 CALL ZHSEQR( 'E', 'V', 2, 1, 2, A, 2, X, C, 1, W, 1, INFO ) 00282 CALL CHKXER( 'ZHSEQR', INFOT, NOUT, LERR, OK ) 00283 NT = NT + 9 00284 * 00285 * ZHSEIN 00286 * 00287 SRNAMT = 'ZHSEIN' 00288 INFOT = 1 00289 CALL ZHSEIN( '/', 'N', 'N', SEL, 0, A, 1, X, VL, 1, VR, 1, 0, 00290 $ M, W, RW, IFAILL, IFAILR, INFO ) 00291 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00292 INFOT = 2 00293 CALL ZHSEIN( 'R', '/', 'N', SEL, 0, A, 1, X, VL, 1, VR, 1, 0, 00294 $ M, W, RW, IFAILL, IFAILR, INFO ) 00295 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00296 INFOT = 3 00297 CALL ZHSEIN( 'R', 'N', '/', SEL, 0, A, 1, X, VL, 1, VR, 1, 0, 00298 $ M, W, RW, IFAILL, IFAILR, INFO ) 00299 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00300 INFOT = 5 00301 CALL ZHSEIN( 'R', 'N', 'N', SEL, -1, A, 1, X, VL, 1, VR, 1, 0, 00302 $ M, W, RW, IFAILL, IFAILR, INFO ) 00303 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00304 INFOT = 7 00305 CALL ZHSEIN( 'R', 'N', 'N', SEL, 2, A, 1, X, VL, 1, VR, 2, 4, 00306 $ M, W, RW, IFAILL, IFAILR, INFO ) 00307 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00308 INFOT = 10 00309 CALL ZHSEIN( 'L', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 1, 4, 00310 $ M, W, RW, IFAILL, IFAILR, INFO ) 00311 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00312 INFOT = 12 00313 CALL ZHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 1, 4, 00314 $ M, W, RW, IFAILL, IFAILR, INFO ) 00315 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00316 INFOT = 13 00317 CALL ZHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, X, VL, 1, VR, 2, 1, 00318 $ M, W, RW, IFAILL, IFAILR, INFO ) 00319 CALL CHKXER( 'ZHSEIN', INFOT, NOUT, LERR, OK ) 00320 NT = NT + 8 00321 * 00322 * ZTREVC 00323 * 00324 SRNAMT = 'ZTREVC' 00325 INFOT = 1 00326 CALL ZTREVC( '/', 'A', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, RW, 00327 $ INFO ) 00328 CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK ) 00329 INFOT = 2 00330 CALL ZTREVC( 'L', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, RW, 00331 $ INFO ) 00332 CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK ) 00333 INFOT = 4 00334 CALL ZTREVC( 'L', 'A', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W, 00335 $ RW, INFO ) 00336 CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK ) 00337 INFOT = 6 00338 CALL ZTREVC( 'L', 'A', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W, RW, 00339 $ INFO ) 00340 CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK ) 00341 INFOT = 8 00342 CALL ZTREVC( 'L', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, RW, 00343 $ INFO ) 00344 CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK ) 00345 INFOT = 10 00346 CALL ZTREVC( 'R', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, RW, 00347 $ INFO ) 00348 CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK ) 00349 INFOT = 11 00350 CALL ZTREVC( 'L', 'A', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W, RW, 00351 $ INFO ) 00352 CALL CHKXER( 'ZTREVC', INFOT, NOUT, LERR, OK ) 00353 NT = NT + 7 00354 END IF 00355 * 00356 * Print a summary line. 00357 * 00358 IF( OK ) THEN 00359 WRITE( NOUT, FMT = 9999 )PATH, NT 00360 ELSE 00361 WRITE( NOUT, FMT = 9998 )PATH 00362 END IF 00363 * 00364 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits', 00365 $ ' (', I3, ' tests done)' ) 00366 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 00367 $ 'exits ***' ) 00368 * 00369 RETURN 00370 * 00371 * End of ZERRHS 00372 * 00373 END
1.7.3 
