1*> \brief \b ZERREC 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 ZERREC( 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*> ZERREC tests the error exits for the routines for eigen- condition 25*> estimation for DOUBLE PRECISION matrices: 26*> ZTRSYL, ZTREXC, ZTRSNA and ZTRSEN. 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*> \ingroup complex16_eig 53* 54* ===================================================================== 55 SUBROUTINE ZERREC( PATH, NUNIT ) 56* 57* -- LAPACK test routine -- 58* -- LAPACK is a software package provided by Univ. of Tennessee, -- 59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 60* 61* .. Scalar Arguments .. 62 CHARACTER*3 PATH 63 INTEGER NUNIT 64* .. 65* 66* ===================================================================== 67* 68* .. Parameters .. 69 INTEGER NMAX, LW 70 PARAMETER ( NMAX = 4, LW = NMAX*( NMAX+2 ) ) 71 DOUBLE PRECISION ONE, ZERO 72 PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 ) 73* .. 74* .. Local Scalars .. 75 INTEGER I, IFST, ILST, INFO, J, M, NT 76 DOUBLE PRECISION SCALE 77* .. 78* .. Local Arrays .. 79 LOGICAL SEL( NMAX ) 80 DOUBLE PRECISION RW( LW ), S( NMAX ), SEP( NMAX ) 81 COMPLEX*16 A( NMAX, NMAX ), B( NMAX, NMAX ), 82 $ C( NMAX, NMAX ), WORK( LW ), X( NMAX ) 83* .. 84* .. External Subroutines .. 85 EXTERNAL CHKXER, ZTREXC, ZTRSEN, ZTRSNA, ZTRSYL 86* .. 87* .. Scalars in Common .. 88 LOGICAL LERR, OK 89 CHARACTER*32 SRNAMT 90 INTEGER INFOT, NOUT 91* .. 92* .. Common blocks .. 93 COMMON / INFOC / INFOT, NOUT, OK, LERR 94 COMMON / SRNAMC / SRNAMT 95* .. 96* .. Executable Statements .. 97* 98 NOUT = NUNIT 99 OK = .TRUE. 100 NT = 0 101* 102* Initialize A, B and SEL 103* 104 DO 20 J = 1, NMAX 105 DO 10 I = 1, NMAX 106 A( I, J ) = ZERO 107 B( I, J ) = ZERO 108 10 CONTINUE 109 20 CONTINUE 110 DO 30 I = 1, NMAX 111 A( I, I ) = ONE 112 SEL( I ) = .TRUE. 113 30 CONTINUE 114* 115* Test ZTRSYL 116* 117 SRNAMT = 'ZTRSYL' 118 INFOT = 1 119 CALL ZTRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 120 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 121 INFOT = 2 122 CALL ZTRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 123 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 124 INFOT = 3 125 CALL ZTRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 126 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 127 INFOT = 4 128 CALL ZTRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO ) 129 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 130 INFOT = 5 131 CALL ZTRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO ) 132 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 133 INFOT = 7 134 CALL ZTRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO ) 135 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 136 INFOT = 9 137 CALL ZTRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO ) 138 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 139 INFOT = 11 140 CALL ZTRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO ) 141 CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK ) 142 NT = NT + 8 143* 144* Test ZTREXC 145* 146 SRNAMT = 'ZTREXC' 147 IFST = 1 148 ILST = 1 149 INFOT = 1 150 CALL ZTREXC( 'X', 1, A, 1, B, 1, IFST, ILST, INFO ) 151 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 152 INFOT = 2 153 CALL ZTREXC( 'N', -1, A, 1, B, 1, IFST, ILST, INFO ) 154 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 155 INFOT = 4 156 ILST = 2 157 CALL ZTREXC( 'N', 2, A, 1, B, 1, IFST, ILST, INFO ) 158 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 159 INFOT = 6 160 CALL ZTREXC( 'V', 2, A, 2, B, 1, IFST, ILST, INFO ) 161 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 162 INFOT = 7 163 IFST = 0 164 ILST = 1 165 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 166 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 167 INFOT = 7 168 IFST = 2 169 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 170 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 171 INFOT = 8 172 IFST = 1 173 ILST = 0 174 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 175 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 176 INFOT = 8 177 ILST = 2 178 CALL ZTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, INFO ) 179 CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK ) 180 NT = NT + 8 181* 182* Test ZTRSNA 183* 184 SRNAMT = 'ZTRSNA' 185 INFOT = 1 186 CALL ZTRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 187 $ WORK, 1, RW, INFO ) 188 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 189 INFOT = 2 190 CALL ZTRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M, 191 $ WORK, 1, RW, INFO ) 192 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 193 INFOT = 4 194 CALL ZTRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M, 195 $ WORK, 1, RW, INFO ) 196 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 197 INFOT = 6 198 CALL ZTRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M, 199 $ WORK, 2, RW, INFO ) 200 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 201 INFOT = 8 202 CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M, 203 $ WORK, 2, RW, INFO ) 204 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 205 INFOT = 10 206 CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M, 207 $ WORK, 2, RW, INFO ) 208 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 209 INFOT = 13 210 CALL ZTRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M, 211 $ WORK, 1, RW, INFO ) 212 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 213 INFOT = 13 214 CALL ZTRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M, 215 $ WORK, 1, RW, INFO ) 216 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 217 INFOT = 16 218 CALL ZTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M, 219 $ WORK, 1, RW, INFO ) 220 CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK ) 221 NT = NT + 9 222* 223* Test ZTRSEN 224* 225 SEL( 1 ) = .FALSE. 226 SRNAMT = 'ZTRSEN' 227 INFOT = 1 228 CALL ZTRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 229 $ WORK, 1, INFO ) 230 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 231 INFOT = 2 232 CALL ZTRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 233 $ WORK, 1, INFO ) 234 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 235 INFOT = 4 236 CALL ZTRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, X, M, S( 1 ), 237 $ SEP( 1 ), WORK, 1, INFO ) 238 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 239 INFOT = 6 240 CALL ZTRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ), 241 $ WORK, 2, INFO ) 242 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 243 INFOT = 8 244 CALL ZTRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, X, M, S( 1 ), SEP( 1 ), 245 $ WORK, 1, INFO ) 246 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 247 INFOT = 14 248 CALL ZTRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, X, M, S( 1 ), SEP( 1 ), 249 $ WORK, 0, INFO ) 250 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 251 INFOT = 14 252 CALL ZTRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ), 253 $ WORK, 1, INFO ) 254 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 255 INFOT = 14 256 CALL ZTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ), 257 $ WORK, 3, INFO ) 258 CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK ) 259 NT = NT + 8 260* 261* Print a summary line. 262* 263 IF( OK ) THEN 264 WRITE( NOUT, FMT = 9999 )PATH, NT 265 ELSE 266 WRITE( NOUT, FMT = 9998 )PATH 267 END IF 268* 269 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (', 270 $ I3, ' tests done)' ) 271 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 272 $ 'exits ***' ) 273 RETURN 274* 275* End of ZERREC 276* 277 END 278