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