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