1*> \brief \b CERREC 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CERREC( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> CERREC tests the error exits for the routines for eigen- condition 25*> estimation for REAL matrices: 26*> CTRSYL, CTREXC, CTRSNA and CTRSEN. 27*> \endverbatim 28* 29* Arguments: 30* ========== 31* 32*> \param[in] PATH 33*> \verbatim 34*> PATH is CHARACTER*3 35*> The LAPACK path name for the routines to be tested. 36*> \endverbatim 37*> 38*> \param[in] NUNIT 39*> \verbatim 40*> NUNIT is INTEGER 41*> The unit number for output. 42*> \endverbatim 43* 44* Authors: 45* ======== 46* 47*> \author Univ. of Tennessee 48*> \author Univ. of California Berkeley 49*> \author Univ. of Colorado Denver 50*> \author NAG Ltd. 51* 52*> \date November 2011 53* 54*> \ingroup complex_eig 55* 56* ===================================================================== 57 SUBROUTINE CERREC( PATH, NUNIT ) 58* 59* -- LAPACK test routine (version 3.4.0) -- 60* -- LAPACK is a software package provided by Univ. of Tennessee, -- 61* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 62* November 2011 63* 64* .. Scalar Arguments .. 65 CHARACTER*3 PATH 66 INTEGER NUNIT 67* .. 68* 69* ===================================================================== 70* 71* .. Parameters .. 72 INTEGER NMAX, LW 73 PARAMETER ( NMAX = 4, LW = NMAX*( NMAX+2 ) ) 74 REAL ONE, ZERO 75 PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 ) 76* .. 77* .. Local Scalars .. 78 INTEGER I, IFST, ILST, INFO, J, M, NT 79 REAL SCALE 80* .. 81* .. Local Arrays .. 82 LOGICAL SEL( NMAX ) 83 REAL RW( LW ), S( NMAX ), SEP( NMAX ) 84 COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ), 85 $ C( NMAX, NMAX ), WORK( LW ), X( NMAX ) 86* .. 87* .. External Subroutines .. 88 EXTERNAL CHKXER, CTREXC, CTRSEN, CTRSNA, CTRSYL 89* .. 90* .. Scalars in Common .. 91 LOGICAL LERR, OK 92 CHARACTER*32 SRNAMT 93 INTEGER INFOT, NOUT 94* .. 95* .. Common blocks .. 96 COMMON / INFOC / INFOT, NOUT, OK, LERR 97 COMMON / SRNAMC / SRNAMT 98* .. 99* .. Executable Statements .. 100* 101 NOUT = NUNIT 102 OK = .TRUE. 103 NT = 0 104* 105* Initialize A, B and SEL 106* 107 DO 20 J = 1, NMAX 108 DO 10 I = 1, NMAX 109 A( I, J ) = ZERO 110 B( I, J ) = ZERO 111 10 CONTINUE 112 20 CONTINUE 113 DO 30 I = 1, NMAX 114 A( I, I ) = ONE 115 SEL( I ) = .TRUE. 116 30 CONTINUE 117* 118* Test CTRSYL 119* 120 SRNAMT = 'CTRSYL' 121 INFOT = 1 122 CALL CTRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 123 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 124 INFOT = 2 125 CALL CTRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 126 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 127 INFOT = 3 128 CALL CTRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 129 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 130 INFOT = 4 131 CALL CTRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 132 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 133 INFOT = 5 134 CALL CTRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO ) 135 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 136 INFOT = 7 137 CALL CTRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO ) 138 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 139 INFOT = 9 140 CALL CTRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO ) 141 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 142 INFOT = 11 143 CALL CTRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO ) 144 CALL CHKXER( 'CTRSYL', INFOT, NOUT, LERR, OK ) 145 NT = NT + 8 146* 147* Test CTREXC 148* 149 SRNAMT = 'CTREXC' 150 IFST = 1 151 ILST = 1 152 INFOT = 1 153 CALL CTREXC( 'X', 1, A, 1, B, 1, IFST, ILST, INFO ) 154 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 155 INFOT = 7 156 CALL CTREXC( 'N', 0, A, 1, B, 1, IFST, ILST, INFO ) 157 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 158 INFOT = 4 159 ILST = 2 160 CALL CTREXC( 'N', 2, A, 1, B, 1, IFST, ILST, INFO ) 161 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 162 INFOT = 6 163 CALL CTREXC( 'V', 2, A, 2, B, 1, IFST, ILST, INFO ) 164 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 165 INFOT = 7 166 IFST = 0 167 ILST = 1 168 CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 169 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 170 INFOT = 7 171 IFST = 2 172 CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 173 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 174 INFOT = 8 175 IFST = 1 176 ILST = 0 177 CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 178 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 179 INFOT = 8 180 ILST = 2 181 CALL CTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 182 CALL CHKXER( 'CTREXC', INFOT, NOUT, LERR, OK ) 183 NT = NT + 8 184* 185* Test CTRSNA 186* 187 SRNAMT = 'CTRSNA' 188 INFOT = 1 189 CALL CTRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 190 $ WORK, 1, RW, INFO ) 191 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 192 INFOT = 2 193 CALL CTRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 194 $ WORK, 1, RW, INFO ) 195 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 196 INFOT = 4 197 CALL CTRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M, 198 $ WORK, 1, RW, INFO ) 199 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 200 INFOT = 6 201 CALL CTRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M, 202 $ WORK, 2, RW, INFO ) 203 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 204 INFOT = 8 205 CALL CTRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M, 206 $ WORK, 2, RW, INFO ) 207 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 208 INFOT = 10 209 CALL CTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M, 210 $ WORK, 2, RW, INFO ) 211 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 212 INFOT = 13 213 CALL CTRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M, 214 $ WORK, 1, RW, INFO ) 215 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 216 INFOT = 13 217 CALL CTRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M, 218 $ WORK, 1, RW, INFO ) 219 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 220 INFOT = 16 221 CALL CTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M, 222 $ WORK, 1, RW, INFO ) 223 CALL CHKXER( 'CTRSNA', INFOT, NOUT, LERR, OK ) 224 NT = NT + 9 225* 226* Test CTRSEN 227* 228 SEL( 1 ) = .FALSE. 229 SRNAMT = 'CTRSEN' 230 INFOT = 1 231 CALL CTRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 232 $ WORK, 1, INFO ) 233 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 234 INFOT = 2 235 CALL CTRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 236 $ WORK, 1, INFO ) 237 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 238 INFOT = 4 239 CALL CTRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, X, M, S( 1 ), 240 $ SEP( 1 ), WORK, 1, INFO ) 241 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 242 INFOT = 6 243 CALL CTRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 244 $ WORK, 2, INFO ) 245 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 246 INFOT = 8 247 CALL CTRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, X, M, S( 1 ), SEP( 1 ), 248 $ WORK, 1, INFO ) 249 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 250 INFOT = 14 251 CALL CTRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, X, M, S( 1 ), SEP( 1 ), 252 $ WORK, 0, INFO ) 253 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 254 INFOT = 14 255 CALL CTRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ), 256 $ WORK, 1, INFO ) 257 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 258 INFOT = 14 259 CALL CTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ), 260 $ WORK, 3, INFO ) 261 CALL CHKXER( 'CTRSEN', INFOT, NOUT, LERR, OK ) 262 NT = NT + 8 263* 264* Print a summary line. 265* 266 IF( OK ) THEN 267 WRITE( NOUT, FMT = 9999 )PATH, NT 268 ELSE 269 WRITE( NOUT, FMT = 9998 )PATH 270 END IF 271* 272 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (', 273 $ I3, ' tests done)' ) 274 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 275 $ 'exits ***' ) 276 RETURN 277* 278* End of CERREC 279* 280 END 281