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