![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DERRHS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE DERRHS( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> DERRHS tests the error exits for DGEBAK, SGEBAL, SGEHRD, DORGHR, 00025 *> DORMHR, DHSEQR, SHSEIN, and DTREVC. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup double_eig 00054 * 00055 * ===================================================================== 00056 SUBROUTINE DERRHS( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX, LW 00072 PARAMETER ( NMAX = 3, LW = ( NMAX+2 )*( NMAX+2 )+NMAX ) 00073 * .. 00074 * .. Local Scalars .. 00075 CHARACTER*2 C2 00076 INTEGER I, IHI, ILO, INFO, J, M, NT 00077 * .. 00078 * .. Local Arrays .. 00079 LOGICAL SEL( NMAX ) 00080 INTEGER IFAILL( NMAX ), IFAILR( NMAX ) 00081 DOUBLE PRECISION A( NMAX, NMAX ), C( NMAX, NMAX ), S( NMAX ), 00082 $ TAU( NMAX ), VL( NMAX, NMAX ), 00083 $ VR( NMAX, NMAX ), W( LW ), WI( NMAX ), 00084 $ WR( NMAX ) 00085 * .. 00086 * .. External Functions .. 00087 LOGICAL LSAMEN 00088 EXTERNAL LSAMEN 00089 * .. 00090 * .. External Subroutines .. 00091 EXTERNAL CHKXER, DGEBAK, DGEBAL, DGEHRD, DHSEIN, DHSEQR, 00092 $ DORGHR, DORMHR, DTREVC 00093 * .. 00094 * .. Intrinsic Functions .. 00095 INTRINSIC DBLE 00096 * .. 00097 * .. Scalars in Common .. 00098 LOGICAL LERR, OK 00099 CHARACTER*32 SRNAMT 00100 INTEGER INFOT, NOUT 00101 * .. 00102 * .. Common blocks .. 00103 COMMON / INFOC / INFOT, NOUT, OK, LERR 00104 COMMON / SRNAMC / SRNAMT 00105 * .. 00106 * .. Executable Statements .. 00107 * 00108 NOUT = NUNIT 00109 WRITE( NOUT, FMT = * ) 00110 C2 = PATH( 2: 3 ) 00111 * 00112 * Set the variables to innocuous values. 00113 * 00114 DO 20 J = 1, NMAX 00115 DO 10 I = 1, NMAX 00116 A( I, J ) = 1.D0 / DBLE( I+J ) 00117 10 CONTINUE 00118 WI( J ) = DBLE( J ) 00119 SEL( J ) = .TRUE. 00120 20 CONTINUE 00121 OK = .TRUE. 00122 NT = 0 00123 * 00124 * Test error exits of the nonsymmetric eigenvalue routines. 00125 * 00126 IF( LSAMEN( 2, C2, 'HS' ) ) THEN 00127 * 00128 * DGEBAL 00129 * 00130 SRNAMT = 'DGEBAL' 00131 INFOT = 1 00132 CALL DGEBAL( '/', 0, A, 1, ILO, IHI, S, INFO ) 00133 CALL CHKXER( 'DGEBAL', INFOT, NOUT, LERR, OK ) 00134 INFOT = 2 00135 CALL DGEBAL( 'N', -1, A, 1, ILO, IHI, S, INFO ) 00136 CALL CHKXER( 'DGEBAL', INFOT, NOUT, LERR, OK ) 00137 INFOT = 4 00138 CALL DGEBAL( 'N', 2, A, 1, ILO, IHI, S, INFO ) 00139 CALL CHKXER( 'DGEBAL', INFOT, NOUT, LERR, OK ) 00140 NT = NT + 3 00141 * 00142 * DGEBAK 00143 * 00144 SRNAMT = 'DGEBAK' 00145 INFOT = 1 00146 CALL DGEBAK( '/', 'R', 0, 1, 0, S, 0, A, 1, INFO ) 00147 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00148 INFOT = 2 00149 CALL DGEBAK( 'N', '/', 0, 1, 0, S, 0, A, 1, INFO ) 00150 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00151 INFOT = 3 00152 CALL DGEBAK( 'N', 'R', -1, 1, 0, S, 0, A, 1, INFO ) 00153 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00154 INFOT = 4 00155 CALL DGEBAK( 'N', 'R', 0, 0, 0, S, 0, A, 1, INFO ) 00156 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00157 INFOT = 4 00158 CALL DGEBAK( 'N', 'R', 0, 2, 0, S, 0, A, 1, INFO ) 00159 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00160 INFOT = 5 00161 CALL DGEBAK( 'N', 'R', 2, 2, 1, S, 0, A, 2, INFO ) 00162 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00163 INFOT = 5 00164 CALL DGEBAK( 'N', 'R', 0, 1, 1, S, 0, A, 1, INFO ) 00165 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00166 INFOT = 7 00167 CALL DGEBAK( 'N', 'R', 0, 1, 0, S, -1, A, 1, INFO ) 00168 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00169 INFOT = 9 00170 CALL DGEBAK( 'N', 'R', 2, 1, 2, S, 0, A, 1, INFO ) 00171 CALL CHKXER( 'DGEBAK', INFOT, NOUT, LERR, OK ) 00172 NT = NT + 9 00173 * 00174 * DGEHRD 00175 * 00176 SRNAMT = 'DGEHRD' 00177 INFOT = 1 00178 CALL DGEHRD( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00179 CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK ) 00180 INFOT = 2 00181 CALL DGEHRD( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00182 CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK ) 00183 INFOT = 2 00184 CALL DGEHRD( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00185 CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK ) 00186 INFOT = 3 00187 CALL DGEHRD( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00188 CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK ) 00189 INFOT = 3 00190 CALL DGEHRD( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00191 CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK ) 00192 INFOT = 5 00193 CALL DGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO ) 00194 CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK ) 00195 INFOT = 8 00196 CALL DGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO ) 00197 CALL CHKXER( 'DGEHRD', INFOT, NOUT, LERR, OK ) 00198 NT = NT + 7 00199 * 00200 * DORGHR 00201 * 00202 SRNAMT = 'DORGHR' 00203 INFOT = 1 00204 CALL DORGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00205 CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK ) 00206 INFOT = 2 00207 CALL DORGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00208 CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK ) 00209 INFOT = 2 00210 CALL DORGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00211 CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK ) 00212 INFOT = 3 00213 CALL DORGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00214 CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK ) 00215 INFOT = 3 00216 CALL DORGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00217 CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK ) 00218 INFOT = 5 00219 CALL DORGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO ) 00220 CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK ) 00221 INFOT = 8 00222 CALL DORGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO ) 00223 CALL CHKXER( 'DORGHR', INFOT, NOUT, LERR, OK ) 00224 NT = NT + 7 00225 * 00226 * DORMHR 00227 * 00228 SRNAMT = 'DORMHR' 00229 INFOT = 1 00230 CALL DORMHR( '/', 'N', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00231 $ INFO ) 00232 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00233 INFOT = 2 00234 CALL DORMHR( 'L', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00235 $ INFO ) 00236 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00237 INFOT = 3 00238 CALL DORMHR( 'L', 'N', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00239 $ INFO ) 00240 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00241 INFOT = 4 00242 CALL DORMHR( 'L', 'N', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1, 00243 $ INFO ) 00244 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00245 INFOT = 5 00246 CALL DORMHR( 'L', 'N', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1, 00247 $ INFO ) 00248 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00249 INFOT = 5 00250 CALL DORMHR( 'L', 'N', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1, 00251 $ INFO ) 00252 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00253 INFOT = 5 00254 CALL DORMHR( 'L', 'N', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2, 00255 $ INFO ) 00256 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00257 INFOT = 5 00258 CALL DORMHR( 'R', 'N', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2, 00259 $ INFO ) 00260 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00261 INFOT = 6 00262 CALL DORMHR( 'L', 'N', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1, 00263 $ INFO ) 00264 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00265 INFOT = 6 00266 CALL DORMHR( 'L', 'N', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1, 00267 $ INFO ) 00268 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00269 INFOT = 6 00270 CALL DORMHR( 'R', 'N', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1, 00271 $ INFO ) 00272 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00273 INFOT = 8 00274 CALL DORMHR( 'L', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00275 $ INFO ) 00276 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00277 INFOT = 8 00278 CALL DORMHR( 'R', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00279 $ INFO ) 00280 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00281 INFOT = 11 00282 CALL DORMHR( 'L', 'N', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1, 00283 $ INFO ) 00284 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00285 INFOT = 13 00286 CALL DORMHR( 'L', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00287 $ INFO ) 00288 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00289 INFOT = 13 00290 CALL DORMHR( 'R', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00291 $ INFO ) 00292 CALL CHKXER( 'DORMHR', INFOT, NOUT, LERR, OK ) 00293 NT = NT + 16 00294 * 00295 * DHSEQR 00296 * 00297 SRNAMT = 'DHSEQR' 00298 INFOT = 1 00299 CALL DHSEQR( '/', 'N', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00300 $ INFO ) 00301 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00302 INFOT = 2 00303 CALL DHSEQR( 'E', '/', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00304 $ INFO ) 00305 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00306 INFOT = 3 00307 CALL DHSEQR( 'E', 'N', -1, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00308 $ INFO ) 00309 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00310 INFOT = 4 00311 CALL DHSEQR( 'E', 'N', 0, 0, 0, A, 1, WR, WI, C, 1, W, 1, 00312 $ INFO ) 00313 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00314 INFOT = 4 00315 CALL DHSEQR( 'E', 'N', 0, 2, 0, A, 1, WR, WI, C, 1, W, 1, 00316 $ INFO ) 00317 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00318 INFOT = 5 00319 CALL DHSEQR( 'E', 'N', 1, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00320 $ INFO ) 00321 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00322 INFOT = 5 00323 CALL DHSEQR( 'E', 'N', 1, 1, 2, A, 1, WR, WI, C, 1, W, 1, 00324 $ INFO ) 00325 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00326 INFOT = 7 00327 CALL DHSEQR( 'E', 'N', 2, 1, 2, A, 1, WR, WI, C, 2, W, 1, 00328 $ INFO ) 00329 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00330 INFOT = 11 00331 CALL DHSEQR( 'E', 'V', 2, 1, 2, A, 2, WR, WI, C, 1, W, 1, 00332 $ INFO ) 00333 CALL CHKXER( 'DHSEQR', INFOT, NOUT, LERR, OK ) 00334 NT = NT + 9 00335 * 00336 * DHSEIN 00337 * 00338 SRNAMT = 'DHSEIN' 00339 INFOT = 1 00340 CALL DHSEIN( '/', 'N', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1, 00341 $ 0, M, W, IFAILL, IFAILR, INFO ) 00342 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00343 INFOT = 2 00344 CALL DHSEIN( 'R', '/', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1, 00345 $ 0, M, W, IFAILL, IFAILR, INFO ) 00346 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00347 INFOT = 3 00348 CALL DHSEIN( 'R', 'N', '/', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1, 00349 $ 0, M, W, IFAILL, IFAILR, INFO ) 00350 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00351 INFOT = 5 00352 CALL DHSEIN( 'R', 'N', 'N', SEL, -1, A, 1, WR, WI, VL, 1, VR, 00353 $ 1, 0, M, W, IFAILL, IFAILR, INFO ) 00354 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00355 INFOT = 7 00356 CALL DHSEIN( 'R', 'N', 'N', SEL, 2, A, 1, WR, WI, VL, 1, VR, 2, 00357 $ 4, M, W, IFAILL, IFAILR, INFO ) 00358 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00359 INFOT = 11 00360 CALL DHSEIN( 'L', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1, 00361 $ 4, M, W, IFAILL, IFAILR, INFO ) 00362 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00363 INFOT = 13 00364 CALL DHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1, 00365 $ 4, M, W, IFAILL, IFAILR, INFO ) 00366 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00367 INFOT = 14 00368 CALL DHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 2, 00369 $ 1, M, W, IFAILL, IFAILR, INFO ) 00370 CALL CHKXER( 'DHSEIN', INFOT, NOUT, LERR, OK ) 00371 NT = NT + 8 00372 * 00373 * DTREVC 00374 * 00375 SRNAMT = 'DTREVC' 00376 INFOT = 1 00377 CALL DTREVC( '/', 'A', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, 00378 $ INFO ) 00379 CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK ) 00380 INFOT = 2 00381 CALL DTREVC( 'L', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, 00382 $ INFO ) 00383 CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK ) 00384 INFOT = 4 00385 CALL DTREVC( 'L', 'A', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W, 00386 $ INFO ) 00387 CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK ) 00388 INFOT = 6 00389 CALL DTREVC( 'L', 'A', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W, 00390 $ INFO ) 00391 CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK ) 00392 INFOT = 8 00393 CALL DTREVC( 'L', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, 00394 $ INFO ) 00395 CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK ) 00396 INFOT = 10 00397 CALL DTREVC( 'R', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, 00398 $ INFO ) 00399 CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK ) 00400 INFOT = 11 00401 CALL DTREVC( 'L', 'A', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W, 00402 $ INFO ) 00403 CALL CHKXER( 'DTREVC', INFOT, NOUT, LERR, OK ) 00404 NT = NT + 7 00405 END IF 00406 * 00407 * Print a summary line. 00408 * 00409 IF( OK ) THEN 00410 WRITE( NOUT, FMT = 9999 )PATH, NT 00411 ELSE 00412 WRITE( NOUT, FMT = 9998 )PATH 00413 END IF 00414 * 00415 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits', 00416 $ ' (', I3, ' tests done)' ) 00417 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 00418 $ 'exits ***' ) 00419 * 00420 RETURN 00421 * 00422 * End of DERRHS 00423 * 00424 END