1*> \brief \b CERRSY 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 CERRSY( 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*> CERRSY tests the error exits for the COMPLEX routines 25*> for symmetric indefinite matrices. 26*> \endverbatim 27* 28* Arguments: 29* ========== 30* 31*> \param[in] PATH 32*> \verbatim 33*> PATH is CHARACTER*3 34*> The LAPACK path name for the routines to be tested. 35*> \endverbatim 36*> 37*> \param[in] NUNIT 38*> \verbatim 39*> NUNIT is INTEGER 40*> The unit number for output. 41*> \endverbatim 42* 43* Authors: 44* ======== 45* 46*> \author Univ. of Tennessee 47*> \author Univ. of California Berkeley 48*> \author Univ. of Colorado Denver 49*> \author NAG Ltd. 50* 51*> \date April 2012 52* 53*> \ingroup complex_lin 54* 55* ===================================================================== 56 SUBROUTINE CERRSY( PATH, NUNIT ) 57* 58* -- LAPACK test routine (version 3.4.1) -- 59* -- LAPACK is a software package provided by Univ. of Tennessee, -- 60* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 61* April 2012 62* 63* .. Scalar Arguments .. 64 CHARACTER*3 PATH 65 INTEGER NUNIT 66* .. 67* 68* ===================================================================== 69* 70* .. Parameters .. 71 INTEGER NMAX 72 PARAMETER ( NMAX = 4 ) 73* .. 74* .. Local Scalars .. 75 CHARACTER*2 C2 76 INTEGER I, INFO, J 77 REAL ANRM, RCOND 78* .. 79* .. Local Arrays .. 80 INTEGER IP( NMAX ) 81 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 82 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 83 $ W( 2*NMAX ), X( NMAX ) 84* .. 85* .. External Functions .. 86 LOGICAL LSAMEN 87 EXTERNAL LSAMEN 88* .. 89* .. External Subroutines .. 90 EXTERNAL ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI, 91 $ CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI, 92 $ CSYTRI2, CSYTRS 93* .. 94* .. Scalars in Common .. 95 LOGICAL LERR, OK 96 CHARACTER*32 SRNAMT 97 INTEGER INFOT, NOUT 98* .. 99* .. Common blocks .. 100 COMMON / INFOC / INFOT, NOUT, OK, LERR 101 COMMON / SRNAMC / SRNAMT 102* .. 103* .. Intrinsic Functions .. 104 INTRINSIC CMPLX, REAL 105* .. 106* .. Executable Statements .. 107* 108 NOUT = NUNIT 109 WRITE( NOUT, FMT = * ) 110 C2 = PATH( 2: 3 ) 111* 112* Set the variables to innocuous values. 113* 114 DO 20 J = 1, NMAX 115 DO 10 I = 1, NMAX 116 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 117 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 118 10 CONTINUE 119 B( J ) = 0. 120 R1( J ) = 0. 121 R2( J ) = 0. 122 W( J ) = 0. 123 X( J ) = 0. 124 IP( J ) = J 125 20 CONTINUE 126 ANRM = 1.0 127 OK = .TRUE. 128* 129 IF( LSAMEN( 2, C2, 'SY' ) ) THEN 130* 131* Test error exits of the routines that use factorization 132* of a symmetric indefinite matrix with patrial 133* (Bunch-Kaufman) pivoting. 134* 135* CSYTRF 136* 137 SRNAMT = 'CSYTRF' 138 INFOT = 1 139 CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO ) 140 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 141 INFOT = 2 142 CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO ) 143 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 144 INFOT = 4 145 CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO ) 146 CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK ) 147* 148* CSYTF2 149* 150 SRNAMT = 'CSYTF2' 151 INFOT = 1 152 CALL CSYTF2( '/', 0, A, 1, IP, INFO ) 153 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 154 INFOT = 2 155 CALL CSYTF2( 'U', -1, A, 1, IP, INFO ) 156 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 157 INFOT = 4 158 CALL CSYTF2( 'U', 2, A, 1, IP, INFO ) 159 CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK ) 160* 161* CSYTRI 162* 163 SRNAMT = 'CSYTRI' 164 INFOT = 1 165 CALL CSYTRI( '/', 0, A, 1, IP, W, INFO ) 166 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 167 INFOT = 2 168 CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO ) 169 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 170 INFOT = 4 171 CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO ) 172 CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK ) 173* 174* CSYTRI2 175* 176 SRNAMT = 'CSYTRI2' 177 INFOT = 1 178 CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO ) 179 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 180 INFOT = 2 181 CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO ) 182 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 183 INFOT = 4 184 CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO ) 185 CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK ) 186* 187* CSYTRS 188* 189 SRNAMT = 'CSYTRS' 190 INFOT = 1 191 CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 192 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 193 INFOT = 2 194 CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO ) 195 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 196 INFOT = 3 197 CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO ) 198 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 199 INFOT = 5 200 CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO ) 201 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 202 INFOT = 8 203 CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO ) 204 CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK ) 205* 206* CSYRFS 207* 208 SRNAMT = 'CSYRFS' 209 INFOT = 1 210 CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 211 $ R, INFO ) 212 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 213 INFOT = 2 214 CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 215 $ W, R, INFO ) 216 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 217 INFOT = 3 218 CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 219 $ W, R, INFO ) 220 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 221 INFOT = 5 222 CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 223 $ R, INFO ) 224 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 225 INFOT = 7 226 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 227 $ R, INFO ) 228 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 229 INFOT = 10 230 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 231 $ R, INFO ) 232 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 233 INFOT = 12 234 CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 235 $ R, INFO ) 236 CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK ) 237* 238* CSYCON 239* 240 SRNAMT = 'CSYCON' 241 INFOT = 1 242 CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO ) 243 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 244 INFOT = 2 245 CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO ) 246 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 247 INFOT = 4 248 CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO ) 249 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 250 INFOT = 6 251 CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO ) 252 CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK ) 253* 254 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 255* 256* Test error exits of the routines that use factorization 257* of a symmetric indefinite packed matrix with patrial 258* (Bunch-Kaufman) pivoting. 259* 260* CSPTRF 261* 262 SRNAMT = 'CSPTRF' 263 INFOT = 1 264 CALL CSPTRF( '/', 0, A, IP, INFO ) 265 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 266 INFOT = 2 267 CALL CSPTRF( 'U', -1, A, IP, INFO ) 268 CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK ) 269* 270* CSPTRI 271* 272 SRNAMT = 'CSPTRI' 273 INFOT = 1 274 CALL CSPTRI( '/', 0, A, IP, W, INFO ) 275 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 276 INFOT = 2 277 CALL CSPTRI( 'U', -1, A, IP, W, INFO ) 278 CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK ) 279* 280* CSPTRS 281* 282 SRNAMT = 'CSPTRS' 283 INFOT = 1 284 CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO ) 285 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 286 INFOT = 2 287 CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO ) 288 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 289 INFOT = 3 290 CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO ) 291 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 292 INFOT = 7 293 CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO ) 294 CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK ) 295* 296* CSPRFS 297* 298 SRNAMT = 'CSPRFS' 299 INFOT = 1 300 CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 301 $ INFO ) 302 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 303 INFOT = 2 304 CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 305 $ INFO ) 306 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 307 INFOT = 3 308 CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R, 309 $ INFO ) 310 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 311 INFOT = 8 312 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R, 313 $ INFO ) 314 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 315 INFOT = 10 316 CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R, 317 $ INFO ) 318 CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK ) 319* 320* CSPCON 321* 322 SRNAMT = 'CSPCON' 323 INFOT = 1 324 CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO ) 325 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 326 INFOT = 2 327 CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO ) 328 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 329 INFOT = 5 330 CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO ) 331 CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK ) 332 END IF 333* 334* Print a summary line. 335* 336 CALL ALAESM( PATH, OK, NOUT ) 337* 338 RETURN 339* 340* End of CERRSY 341* 342 END 343