![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZERREC 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 ZERREC( 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 *> ZERREC tests the error exits for the routines for eigen- condition 00025 *> estimation for DOUBLE PRECISION matrices: 00026 *> ZTRSYL, CTREXC, CTRSNA and CTRSEN. 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 complex16_eig 00055 * 00056 * ===================================================================== 00057 SUBROUTINE ZERREC( 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, LW 00073 PARAMETER ( NMAX = 4, LW = NMAX*( NMAX+2 ) ) 00074 DOUBLE PRECISION ONE, ZERO 00075 PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) 00076 * .. 00077 * .. Local Scalars .. 00078 INTEGER I, IFST, ILST, INFO, J, M, NT 00079 DOUBLE PRECISION SCALE 00080 * .. 00081 * .. Local Arrays .. 00082 LOGICAL SEL( NMAX ) 00083 DOUBLE PRECISION RW( LW ), S( NMAX ), SEP( NMAX ) 00084 COMPLEX*16 A( NMAX, NMAX ), B( NMAX, NMAX ), 00085 $ C( NMAX, NMAX ), WORK( LW ), X( NMAX ) 00086 * .. 00087 * .. External Subroutines .. 00088 EXTERNAL CHKXER, ZTREXC, ZTRSEN, ZTRSNA, ZTRSYL 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 ZTRSYL 00119 * 00120 SRNAMT = 'ZTRSYL' 00121 INFOT = 1 00122 CALL ZTRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00123 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00124 INFOT = 2 00125 CALL ZTRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00126 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00127 INFOT = 3 00128 CALL ZTRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00129 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00130 INFOT = 4 00131 CALL ZTRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 00132 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00133 INFOT = 5 00134 CALL ZTRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO ) 00135 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00136 INFOT = 7 00137 CALL ZTRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO ) 00138 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00139 INFOT = 9 00140 CALL ZTRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO ) 00141 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00142 INFOT = 11 00143 CALL ZTRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO ) 00144 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 00145 NT = NT + 8 00146 * 00147 * Test ZTREXC 00148 * 00149 SRNAMT = 'ZTREXC' 00150 IFST = 1 00151 ILST = 1 00152 INFOT = 1 00153 CALL ZTREXC( 'X', 1, A, 1, B, 1, IFST, ILST, INFO ) 00154 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00155 INFOT = 7 00156 CALL ZTREXC( 'N', 0, A, 1, B, 1, IFST, ILST, INFO ) 00157 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00158 INFOT = 4 00159 ILST = 2 00160 CALL ZTREXC( 'N', 2, A, 1, B, 1, IFST, ILST, INFO ) 00161 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00162 INFOT = 6 00163 CALL ZTREXC( 'V', 2, A, 2, B, 1, IFST, ILST, INFO ) 00164 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00165 INFOT = 7 00166 IFST = 0 00167 ILST = 1 00168 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 00169 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00170 INFOT = 7 00171 IFST = 2 00172 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 00173 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00174 INFOT = 8 00175 IFST = 1 00176 ILST = 0 00177 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 00178 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00179 INFOT = 8 00180 ILST = 2 00181 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 00182 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 00183 NT = NT + 8 00184 * 00185 * Test ZTRSNA 00186 * 00187 SRNAMT = 'ZTRSNA' 00188 INFOT = 1 00189 CALL ZTRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 00190 $ WORK, 1, RW, INFO ) 00191 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00192 INFOT = 2 00193 CALL ZTRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 00194 $ WORK, 1, RW, INFO ) 00195 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00196 INFOT = 4 00197 CALL ZTRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M, 00198 $ WORK, 1, RW, INFO ) 00199 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00200 INFOT = 6 00201 CALL ZTRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M, 00202 $ WORK, 2, RW, INFO ) 00203 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00204 INFOT = 8 00205 CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M, 00206 $ WORK, 2, RW, INFO ) 00207 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00208 INFOT = 10 00209 CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M, 00210 $ WORK, 2, RW, INFO ) 00211 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00212 INFOT = 13 00213 CALL ZTRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M, 00214 $ WORK, 1, RW, INFO ) 00215 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00216 INFOT = 13 00217 CALL ZTRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M, 00218 $ WORK, 1, RW, INFO ) 00219 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00220 INFOT = 16 00221 CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M, 00222 $ WORK, 1, RW, INFO ) 00223 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 00224 NT = NT + 9 00225 * 00226 * Test ZTRSEN 00227 * 00228 SEL( 1 ) = .FALSE. 00229 SRNAMT = 'ZTRSEN' 00230 INFOT = 1 00231 CALL ZTRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 00232 $ WORK, 1, INFO ) 00233 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00234 INFOT = 2 00235 CALL ZTRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 00236 $ WORK, 1, INFO ) 00237 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00238 INFOT = 4 00239 CALL ZTRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, X, M, S( 1 ), 00240 $ SEP( 1 ), WORK, 1, INFO ) 00241 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00242 INFOT = 6 00243 CALL ZTRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 00244 $ WORK, 2, INFO ) 00245 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00246 INFOT = 8 00247 CALL ZTRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, X, M, S( 1 ), SEP( 1 ), 00248 $ WORK, 1, INFO ) 00249 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00250 INFOT = 14 00251 CALL ZTRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, X, M, S( 1 ), SEP( 1 ), 00252 $ WORK, 0, INFO ) 00253 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00254 INFOT = 14 00255 CALL ZTRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ), 00256 $ WORK, 1, INFO ) 00257 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00258 INFOT = 14 00259 CALL ZTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ), 00260 $ WORK, 3, INFO ) 00261 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 00262 NT = NT + 8 00263 * 00264 * Print a summary line. 00265 * 00266 IF( OK ) THEN 00267 WRITE( NOUT, FMT = 9999 )PATH, NT 00268 ELSE 00269 WRITE( NOUT, FMT = 9998 )PATH 00270 END IF 00271 * 00272 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (', 00273 $ I3, ' tests done)' ) 00274 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 00275 $ 'exits ***' ) 00276 RETURN 00277 * 00278 * End of ZERREC 00279 * 00280 END