![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SERRHS 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 SERRHS( 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 *> SERRHS tests the error exits for SGEBAK, SGEBAL, SGEHRD, SORGHR, 00025 *> SORMHR, SHSEQR, SHSEIN, and STREVC. 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 single_eig 00054 * 00055 * ===================================================================== 00056 SUBROUTINE SERRHS( 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, ILO, IHI, INFO, J, M, NT 00077 * .. 00078 * .. Local Arrays .. 00079 LOGICAL SEL( NMAX ) 00080 INTEGER IFAILL( NMAX ), IFAILR( NMAX ) 00081 REAL A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ), 00082 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ), 00083 $ WI( NMAX ), WR( NMAX ), S( NMAX ) 00084 * .. 00085 * .. External Functions .. 00086 LOGICAL LSAMEN 00087 EXTERNAL LSAMEN 00088 * .. 00089 * .. External Subroutines .. 00090 EXTERNAL CHKXER, SGEBAK, SGEBAL, SGEHRD, SHSEIN, SHSEQR, 00091 $ SORGHR, SORMHR, STREVC 00092 * .. 00093 * .. Intrinsic Functions .. 00094 INTRINSIC REAL 00095 * .. 00096 * .. Scalars in Common .. 00097 LOGICAL LERR, OK 00098 CHARACTER*32 SRNAMT 00099 INTEGER INFOT, NOUT 00100 * .. 00101 * .. Common blocks .. 00102 COMMON / INFOC / INFOT, NOUT, OK, LERR 00103 COMMON / SRNAMC / SRNAMT 00104 * .. 00105 * .. Executable Statements .. 00106 * 00107 NOUT = NUNIT 00108 WRITE( NOUT, FMT = * ) 00109 C2 = PATH( 2: 3 ) 00110 * 00111 * Set the variables to innocuous values. 00112 * 00113 DO 20 J = 1, NMAX 00114 DO 10 I = 1, NMAX 00115 A( I, J ) = 1. / REAL( I+J ) 00116 10 CONTINUE 00117 WI( J ) = REAL( J ) 00118 SEL( J ) = .TRUE. 00119 20 CONTINUE 00120 OK = .TRUE. 00121 NT = 0 00122 * 00123 * Test error exits of the nonsymmetric eigenvalue routines. 00124 * 00125 IF( LSAMEN( 2, C2, 'HS' ) ) THEN 00126 * 00127 * SGEBAL 00128 * 00129 SRNAMT = 'SGEBAL' 00130 INFOT = 1 00131 CALL SGEBAL( '/', 0, A, 1, ILO, IHI, S, INFO ) 00132 CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK ) 00133 INFOT = 2 00134 CALL SGEBAL( 'N', -1, A, 1, ILO, IHI, S, INFO ) 00135 CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK ) 00136 INFOT = 4 00137 CALL SGEBAL( 'N', 2, A, 1, ILO, IHI, S, INFO ) 00138 CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK ) 00139 NT = NT + 3 00140 * 00141 * SGEBAK 00142 * 00143 SRNAMT = 'SGEBAK' 00144 INFOT = 1 00145 CALL SGEBAK( '/', 'R', 0, 1, 0, S, 0, A, 1, INFO ) 00146 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00147 INFOT = 2 00148 CALL SGEBAK( 'N', '/', 0, 1, 0, S, 0, A, 1, INFO ) 00149 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00150 INFOT = 3 00151 CALL SGEBAK( 'N', 'R', -1, 1, 0, S, 0, A, 1, INFO ) 00152 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00153 INFOT = 4 00154 CALL SGEBAK( 'N', 'R', 0, 0, 0, S, 0, A, 1, INFO ) 00155 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00156 INFOT = 4 00157 CALL SGEBAK( 'N', 'R', 0, 2, 0, S, 0, A, 1, INFO ) 00158 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00159 INFOT = 5 00160 CALL SGEBAK( 'N', 'R', 2, 2, 1, S, 0, A, 2, INFO ) 00161 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00162 INFOT = 5 00163 CALL SGEBAK( 'N', 'R', 0, 1, 1, S, 0, A, 1, INFO ) 00164 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00165 INFOT = 7 00166 CALL SGEBAK( 'N', 'R', 0, 1, 0, S, -1, A, 1, INFO ) 00167 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00168 INFOT = 9 00169 CALL SGEBAK( 'N', 'R', 2, 1, 2, S, 0, A, 1, INFO ) 00170 CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK ) 00171 NT = NT + 9 00172 * 00173 * SGEHRD 00174 * 00175 SRNAMT = 'SGEHRD' 00176 INFOT = 1 00177 CALL SGEHRD( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00178 CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK ) 00179 INFOT = 2 00180 CALL SGEHRD( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00181 CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK ) 00182 INFOT = 2 00183 CALL SGEHRD( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00184 CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK ) 00185 INFOT = 3 00186 CALL SGEHRD( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00187 CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK ) 00188 INFOT = 3 00189 CALL SGEHRD( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00190 CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK ) 00191 INFOT = 5 00192 CALL SGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO ) 00193 CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK ) 00194 INFOT = 8 00195 CALL SGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO ) 00196 CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK ) 00197 NT = NT + 7 00198 * 00199 * SORGHR 00200 * 00201 SRNAMT = 'SORGHR' 00202 INFOT = 1 00203 CALL SORGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO ) 00204 CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK ) 00205 INFOT = 2 00206 CALL SORGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO ) 00207 CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK ) 00208 INFOT = 2 00209 CALL SORGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO ) 00210 CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK ) 00211 INFOT = 3 00212 CALL SORGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO ) 00213 CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK ) 00214 INFOT = 3 00215 CALL SORGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO ) 00216 CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK ) 00217 INFOT = 5 00218 CALL SORGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO ) 00219 CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK ) 00220 INFOT = 8 00221 CALL SORGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO ) 00222 CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK ) 00223 NT = NT + 7 00224 * 00225 * SORMHR 00226 * 00227 SRNAMT = 'SORMHR' 00228 INFOT = 1 00229 CALL SORMHR( '/', 'N', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00230 $ INFO ) 00231 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00232 INFOT = 2 00233 CALL SORMHR( 'L', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00234 $ INFO ) 00235 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00236 INFOT = 3 00237 CALL SORMHR( 'L', 'N', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1, 00238 $ INFO ) 00239 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00240 INFOT = 4 00241 CALL SORMHR( 'L', 'N', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1, 00242 $ INFO ) 00243 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00244 INFOT = 5 00245 CALL SORMHR( 'L', 'N', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1, 00246 $ INFO ) 00247 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00248 INFOT = 5 00249 CALL SORMHR( 'L', 'N', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1, 00250 $ INFO ) 00251 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00252 INFOT = 5 00253 CALL SORMHR( 'L', 'N', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2, 00254 $ INFO ) 00255 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00256 INFOT = 5 00257 CALL SORMHR( 'R', 'N', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2, 00258 $ INFO ) 00259 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00260 INFOT = 6 00261 CALL SORMHR( 'L', 'N', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1, 00262 $ INFO ) 00263 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00264 INFOT = 6 00265 CALL SORMHR( 'L', 'N', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1, 00266 $ INFO ) 00267 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00268 INFOT = 6 00269 CALL SORMHR( 'R', 'N', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1, 00270 $ INFO ) 00271 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00272 INFOT = 8 00273 CALL SORMHR( 'L', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00274 $ INFO ) 00275 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00276 INFOT = 8 00277 CALL SORMHR( 'R', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00278 $ INFO ) 00279 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00280 INFOT = 11 00281 CALL SORMHR( 'L', 'N', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1, 00282 $ INFO ) 00283 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00284 INFOT = 13 00285 CALL SORMHR( 'L', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1, 00286 $ INFO ) 00287 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00288 INFOT = 13 00289 CALL SORMHR( 'R', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1, 00290 $ INFO ) 00291 CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK ) 00292 NT = NT + 16 00293 * 00294 * SHSEQR 00295 * 00296 SRNAMT = 'SHSEQR' 00297 INFOT = 1 00298 CALL SHSEQR( '/', 'N', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00299 $ INFO ) 00300 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00301 INFOT = 2 00302 CALL SHSEQR( 'E', '/', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00303 $ INFO ) 00304 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00305 INFOT = 3 00306 CALL SHSEQR( 'E', 'N', -1, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00307 $ INFO ) 00308 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00309 INFOT = 4 00310 CALL SHSEQR( 'E', 'N', 0, 0, 0, A, 1, WR, WI, C, 1, W, 1, 00311 $ INFO ) 00312 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00313 INFOT = 4 00314 CALL SHSEQR( 'E', 'N', 0, 2, 0, A, 1, WR, WI, C, 1, W, 1, 00315 $ INFO ) 00316 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00317 INFOT = 5 00318 CALL SHSEQR( 'E', 'N', 1, 1, 0, A, 1, WR, WI, C, 1, W, 1, 00319 $ INFO ) 00320 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00321 INFOT = 5 00322 CALL SHSEQR( 'E', 'N', 1, 1, 2, A, 1, WR, WI, C, 1, W, 1, 00323 $ INFO ) 00324 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00325 INFOT = 7 00326 CALL SHSEQR( 'E', 'N', 2, 1, 2, A, 1, WR, WI, C, 2, W, 1, 00327 $ INFO ) 00328 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00329 INFOT = 11 00330 CALL SHSEQR( 'E', 'V', 2, 1, 2, A, 2, WR, WI, C, 1, W, 1, 00331 $ INFO ) 00332 CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK ) 00333 NT = NT + 9 00334 * 00335 * SHSEIN 00336 * 00337 SRNAMT = 'SHSEIN' 00338 INFOT = 1 00339 CALL SHSEIN( '/', 'N', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1, 00340 $ 0, M, W, IFAILL, IFAILR, INFO ) 00341 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00342 INFOT = 2 00343 CALL SHSEIN( 'R', '/', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1, 00344 $ 0, M, W, IFAILL, IFAILR, INFO ) 00345 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00346 INFOT = 3 00347 CALL SHSEIN( 'R', 'N', '/', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1, 00348 $ 0, M, W, IFAILL, IFAILR, INFO ) 00349 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00350 INFOT = 5 00351 CALL SHSEIN( 'R', 'N', 'N', SEL, -1, A, 1, WR, WI, VL, 1, VR, 00352 $ 1, 0, M, W, IFAILL, IFAILR, INFO ) 00353 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00354 INFOT = 7 00355 CALL SHSEIN( 'R', 'N', 'N', SEL, 2, A, 1, WR, WI, VL, 1, VR, 2, 00356 $ 4, M, W, IFAILL, IFAILR, INFO ) 00357 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00358 INFOT = 11 00359 CALL SHSEIN( 'L', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1, 00360 $ 4, M, W, IFAILL, IFAILR, INFO ) 00361 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00362 INFOT = 13 00363 CALL SHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1, 00364 $ 4, M, W, IFAILL, IFAILR, INFO ) 00365 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00366 INFOT = 14 00367 CALL SHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 2, 00368 $ 1, M, W, IFAILL, IFAILR, INFO ) 00369 CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK ) 00370 NT = NT + 8 00371 * 00372 * STREVC 00373 * 00374 SRNAMT = 'STREVC' 00375 INFOT = 1 00376 CALL STREVC( '/', 'A', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, 00377 $ INFO ) 00378 CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK ) 00379 INFOT = 2 00380 CALL STREVC( 'L', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W, 00381 $ INFO ) 00382 CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK ) 00383 INFOT = 4 00384 CALL STREVC( 'L', 'A', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W, 00385 $ INFO ) 00386 CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK ) 00387 INFOT = 6 00388 CALL STREVC( 'L', 'A', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W, 00389 $ INFO ) 00390 CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK ) 00391 INFOT = 8 00392 CALL STREVC( 'L', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, 00393 $ INFO ) 00394 CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK ) 00395 INFOT = 10 00396 CALL STREVC( 'R', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W, 00397 $ INFO ) 00398 CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK ) 00399 INFOT = 11 00400 CALL STREVC( 'L', 'A', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W, 00401 $ INFO ) 00402 CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK ) 00403 NT = NT + 7 00404 END IF 00405 * 00406 * Print a summary line. 00407 * 00408 IF( OK ) THEN 00409 WRITE( NOUT, FMT = 9999 )PATH, NT 00410 ELSE 00411 WRITE( NOUT, FMT = 9998 )PATH 00412 END IF 00413 * 00414 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits', 00415 $ ' (', I3, ' tests done)' ) 00416 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 00417 $ 'exits ***' ) 00418 * 00419 RETURN 00420 * 00421 * End of SERRHS 00422 * 00423 END