![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SERREC 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 SERREC( 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 *> SERREC tests the error exits for the routines for eigen- condition 00025 *> estimation for REAL matrices: 00026 *> STRSYL, STREXC, STRSNA and STRSEN. 00027 *> \endverbatim 00028 * 00029 * Arguments: 00030 * ========== 00031 * 00032 *> \param[in] PATH 00033 *> \verbatim 00034 *> PATH is CHARACTER*3 00035 *> The LAPACK path name for the routines to be tested. 00036 *> \endverbatim 00037 *> 00038 *> \param[in] NUNIT 00039 *> \verbatim 00040 *> NUNIT is INTEGER 00041 *> The unit number for output. 00042 *> \endverbatim 00043 * 00044 * Authors: 00045 * ======== 00046 * 00047 *> \author Univ. of Tennessee 00048 *> \author Univ. of California Berkeley 00049 *> \author Univ. of Colorado Denver 00050 *> \author NAG Ltd. 00051 * 00052 *> \date November 2011 00053 * 00054 *> \ingroup single_eig 00055 * 00056 * ===================================================================== 00057 SUBROUTINE SERREC( PATH, NUNIT ) 00058 * 00059 * -- LAPACK test routine (version 3.4.0) -- 00060 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00061 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00062 * November 2011 00063 * 00064 * .. Scalar Arguments .. 00065 CHARACTER*3 PATH 00066 INTEGER NUNIT 00067 * .. 00068 * 00069 * ===================================================================== 00070 * 00071 * .. Parameters .. 00072 INTEGER NMAX 00073 REAL ONE, ZERO 00074 PARAMETER ( NMAX = 4, ONE = 1.0E0, ZERO = 0.0E0 ) 00075 * .. 00076 * .. Local Scalars .. 00077 INTEGER I, IFST, ILST, INFO, J, M, NT 00078 REAL SCALE 00079 * .. 00080 * .. Local Arrays .. 00081 LOGICAL SEL( NMAX ) 00082 INTEGER IWORK( NMAX ) 00083 REAL A( NMAX, NMAX ), B( NMAX, NMAX ), 00084 $ C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ), 00085 $ WI( NMAX ), WORK( NMAX ), WR( NMAX ) 00086 * .. 00087 * .. External Subroutines .. 00088 EXTERNAL CHKXER, STREXC, STRSEN, STRSNA, STRSYL 00089 * .. 00090 * .. Scalars in Common .. 00091 LOGICAL LERR, OK 00092 CHARACTER*32 SRNAMT 00093 INTEGER INFOT, NOUT 00094 * .. 00095 * .. Common blocks .. 00096 COMMON / INFOC / INFOT, NOUT, OK, LERR 00097 COMMON / SRNAMC / SRNAMT 00098 * .. 00099 * .. Executable Statements .. 00100 * 00101 NOUT = NUNIT 00102 OK = .TRUE. 00103 NT = 0 00104 * 00105 * Initialize A, B and SEL 00106 * 00107 DO 20 J = 1, NMAX 00108 DO 10 I = 1, NMAX 00109 A( I, J ) = ZERO 00110 B( I, J ) = ZERO 00111 10 CONTINUE 00112 20 CONTINUE 00113 DO 30 I = 1, NMAX 00114 A( I, I ) = ONE 00115 SEL( I ) = .TRUE. 00116 30 CONTINUE 00117 * 00118 * Test STRSYL 00119 * 00120 SRNAMT = 'STRSYL' 00121 INFOT = 1 00122 CALL STRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00123 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00124 INFOT = 2 00125 CALL STRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00126 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00127 INFOT = 3 00128 CALL STRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00129 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00130 INFOT = 4 00131 CALL STRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00132 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00133 INFOT = 5 00134 CALL STRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO ) 00135 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00136 INFOT = 7 00137 CALL STRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO ) 00138 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00139 INFOT = 9 00140 CALL STRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO ) 00141 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00142 INFOT = 11 00143 CALL STRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO ) 00144 CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK ) 00145 NT = NT + 8 00146 * 00147 * Test STREXC 00148 * 00149 SRNAMT = 'STREXC' 00150 IFST = 1 00151 ILST = 1 00152 INFOT = 1 00153 CALL STREXC( 'X', 1, A, 1, B, 1, IFST, ILST, WORK, INFO ) 00154 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00155 INFOT = 7 00156 CALL STREXC( 'N', 0, A, 1, B, 1, IFST, ILST, WORK, INFO ) 00157 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00158 INFOT = 4 00159 ILST = 2 00160 CALL STREXC( 'N', 2, A, 1, B, 1, IFST, ILST, WORK, INFO ) 00161 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00162 INFOT = 6 00163 CALL STREXC( 'V', 2, A, 2, B, 1, IFST, ILST, WORK, INFO ) 00164 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00165 INFOT = 7 00166 IFST = 0 00167 ILST = 1 00168 CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO ) 00169 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00170 INFOT = 7 00171 IFST = 2 00172 CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO ) 00173 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00174 INFOT = 8 00175 IFST = 1 00176 ILST = 0 00177 CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO ) 00178 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00179 INFOT = 8 00180 ILST = 2 00181 CALL STREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO ) 00182 CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK ) 00183 NT = NT + 8 00184 * 00185 * Test STRSNA 00186 * 00187 SRNAMT = 'STRSNA' 00188 INFOT = 1 00189 CALL STRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 00190 $ WORK, 1, IWORK, INFO ) 00191 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00192 INFOT = 2 00193 CALL STRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 00194 $ WORK, 1, IWORK, INFO ) 00195 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00196 INFOT = 4 00197 CALL STRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M, 00198 $ WORK, 1, IWORK, INFO ) 00199 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00200 INFOT = 6 00201 CALL STRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M, 00202 $ WORK, 2, IWORK, INFO ) 00203 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00204 INFOT = 8 00205 CALL STRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M, 00206 $ WORK, 2, IWORK, INFO ) 00207 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00208 INFOT = 10 00209 CALL STRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M, 00210 $ WORK, 2, IWORK, INFO ) 00211 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00212 INFOT = 13 00213 CALL STRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M, 00214 $ WORK, 1, IWORK, INFO ) 00215 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00216 INFOT = 13 00217 CALL STRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M, 00218 $ WORK, 2, IWORK, INFO ) 00219 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00220 INFOT = 16 00221 CALL STRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M, 00222 $ WORK, 1, IWORK, INFO ) 00223 CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK ) 00224 NT = NT + 9 00225 * 00226 * Test STRSEN 00227 * 00228 SEL( 1 ) = .FALSE. 00229 SRNAMT = 'STRSEN' 00230 INFOT = 1 00231 CALL STRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ), 00232 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO ) 00233 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00234 INFOT = 2 00235 CALL STRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ), 00236 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO ) 00237 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00238 INFOT = 4 00239 CALL STRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, WR, WI, M, S( 1 ), 00240 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO ) 00241 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00242 INFOT = 6 00243 CALL STRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, WR, WI, M, S( 1 ), 00244 $ SEP( 1 ), WORK, 2, IWORK, 1, INFO ) 00245 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00246 INFOT = 8 00247 CALL STRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, WR, WI, M, S( 1 ), 00248 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO ) 00249 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00250 INFOT = 15 00251 CALL STRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ), 00252 $ SEP( 1 ), WORK, 0, IWORK, 1, INFO ) 00253 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00254 INFOT = 15 00255 CALL STRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ), 00256 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO ) 00257 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00258 INFOT = 15 00259 CALL STRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ), 00260 $ SEP( 1 ), WORK, 3, IWORK, 2, INFO ) 00261 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00262 INFOT = 17 00263 CALL STRSEN( 'E', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ), 00264 $ SEP( 1 ), WORK, 1, IWORK, 0, INFO ) 00265 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00266 INFOT = 17 00267 CALL STRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ), 00268 $ SEP( 1 ), WORK, 4, IWORK, 1, INFO ) 00269 CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK ) 00270 NT = NT + 10 00271 * 00272 * Print a summary line. 00273 * 00274 IF( OK ) THEN 00275 WRITE( NOUT, FMT = 9999 )PATH, NT 00276 ELSE 00277 WRITE( NOUT, FMT = 9998 )PATH 00278 END IF 00279 * 00280 RETURN 00281 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (', 00282 $ I3, ' tests done)' ) 00283 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ex', 00284 $ 'its ***' ) 00285 * 00286 * End of SERREC 00287 * 00288 END