1*> \brief \b CERRGE 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 CERRGE( 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*> CERRGE tests the error exits for the COMPLEX routines 25*> for general 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 December 2016 52* 53*> \ingroup complex_lin 54* 55* ===================================================================== 56 SUBROUTINE CERRGE( PATH, NUNIT ) 57* 58* -- LAPACK test routine (version 3.7.0) -- 59* -- LAPACK is a software package provided by Univ. of Tennessee, -- 60* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 61* December 2016 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, CCOND, 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, CGBCON, CGBEQU, CGBRFS, CGBTF2, CGBTRF, 91 $ CGBTRS, CGECON, CGEEQU, CGERFS, CGETF2, CGETRF, 92 $ CGETRI, CGETRS, CHKXER 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 OK = .TRUE. 127* 128* Test error exits of the routines that use the LU decomposition 129* of a general matrix. 130* 131 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 132* 133* CGETRF 134* 135 SRNAMT = 'CGETRF' 136 INFOT = 1 137 CALL CGETRF( -1, 0, A, 1, IP, INFO ) 138 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 139 INFOT = 2 140 CALL CGETRF( 0, -1, A, 1, IP, INFO ) 141 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 142 INFOT = 4 143 CALL CGETRF( 2, 1, A, 1, IP, INFO ) 144 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 145* 146* CGETF2 147* 148 SRNAMT = 'CGETF2' 149 INFOT = 1 150 CALL CGETF2( -1, 0, A, 1, IP, INFO ) 151 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 152 INFOT = 2 153 CALL CGETF2( 0, -1, A, 1, IP, INFO ) 154 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 155 INFOT = 4 156 CALL CGETF2( 2, 1, A, 1, IP, INFO ) 157 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 158* 159* CGETRI 160* 161 SRNAMT = 'CGETRI' 162 INFOT = 1 163 CALL CGETRI( -1, A, 1, IP, W, 1, INFO ) 164 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 165 INFOT = 3 166 CALL CGETRI( 2, A, 1, IP, W, 2, INFO ) 167 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 168 INFOT = 6 169 CALL CGETRI( 2, A, 2, IP, W, 1, INFO ) 170 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 171* 172* CGETRS 173* 174 SRNAMT = 'CGETRS' 175 INFOT = 1 176 CALL CGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 177 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 178 INFOT = 2 179 CALL CGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 180 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 181 INFOT = 3 182 CALL CGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 183 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 184 INFOT = 5 185 CALL CGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 186 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 187 INFOT = 8 188 CALL CGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 189 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 190* 191* CGERFS 192* 193 SRNAMT = 'CGERFS' 194 INFOT = 1 195 CALL CGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 196 $ R, INFO ) 197 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 198 INFOT = 2 199 CALL CGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 200 $ W, R, INFO ) 201 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 202 INFOT = 3 203 CALL CGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 204 $ W, R, INFO ) 205 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 206 INFOT = 5 207 CALL CGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 208 $ R, INFO ) 209 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 210 INFOT = 7 211 CALL CGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 212 $ R, INFO ) 213 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 214 INFOT = 10 215 CALL CGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 216 $ R, INFO ) 217 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 218 INFOT = 12 219 CALL CGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 220 $ R, INFO ) 221 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 222* 223* CGECON 224* 225 SRNAMT = 'CGECON' 226 INFOT = 1 227 CALL CGECON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO ) 228 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 229 INFOT = 2 230 CALL CGECON( '1', -1, A, 1, ANRM, RCOND, W, R, INFO ) 231 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 232 INFOT = 4 233 CALL CGECON( '1', 2, A, 1, ANRM, RCOND, W, R, INFO ) 234 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 235* 236* CGEEQU 237* 238 SRNAMT = 'CGEEQU' 239 INFOT = 1 240 CALL CGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 241 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 242 INFOT = 2 243 CALL CGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 244 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 245 INFOT = 4 246 CALL CGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 247 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 248* 249* Test error exits of the routines that use the LU decomposition 250* of a general band matrix. 251* 252 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 253* 254* CGBTRF 255* 256 SRNAMT = 'CGBTRF' 257 INFOT = 1 258 CALL CGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 259 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 260 INFOT = 2 261 CALL CGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 262 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 263 INFOT = 3 264 CALL CGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 265 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 266 INFOT = 4 267 CALL CGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 268 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 269 INFOT = 6 270 CALL CGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 271 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 272* 273* CGBTF2 274* 275 SRNAMT = 'CGBTF2' 276 INFOT = 1 277 CALL CGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 278 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 279 INFOT = 2 280 CALL CGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 281 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 282 INFOT = 3 283 CALL CGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 284 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 285 INFOT = 4 286 CALL CGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 287 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 288 INFOT = 6 289 CALL CGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 290 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 291* 292* CGBTRS 293* 294 SRNAMT = 'CGBTRS' 295 INFOT = 1 296 CALL CGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 297 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 298 INFOT = 2 299 CALL CGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 300 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 301 INFOT = 3 302 CALL CGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 303 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 304 INFOT = 4 305 CALL CGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 306 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 307 INFOT = 5 308 CALL CGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 309 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 310 INFOT = 7 311 CALL CGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 312 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 313 INFOT = 10 314 CALL CGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 315 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 316* 317* CGBRFS 318* 319 SRNAMT = 'CGBRFS' 320 INFOT = 1 321 CALL CGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 322 $ R2, W, R, INFO ) 323 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 324 INFOT = 2 325 CALL CGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 326 $ R2, W, R, INFO ) 327 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 328 INFOT = 3 329 CALL CGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 330 $ R2, W, R, INFO ) 331 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 332 INFOT = 4 333 CALL CGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 334 $ R2, W, R, INFO ) 335 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 336 INFOT = 5 337 CALL CGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 338 $ R2, W, R, INFO ) 339 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 340 INFOT = 7 341 CALL CGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 342 $ R2, W, R, INFO ) 343 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 344 INFOT = 9 345 CALL CGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 346 $ R2, W, R, INFO ) 347 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 348 INFOT = 12 349 CALL CGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 350 $ R2, W, R, INFO ) 351 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 352 INFOT = 14 353 CALL CGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 354 $ R2, W, R, INFO ) 355 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 356* 357* CGBCON 358* 359 SRNAMT = 'CGBCON' 360 INFOT = 1 361 CALL CGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 362 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 363 INFOT = 2 364 CALL CGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 365 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 366 INFOT = 3 367 CALL CGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 368 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 369 INFOT = 4 370 CALL CGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, R, INFO ) 371 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 372 INFOT = 6 373 CALL CGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, R, INFO ) 374 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 375* 376* CGBEQU 377* 378 SRNAMT = 'CGBEQU' 379 INFOT = 1 380 CALL CGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 381 $ INFO ) 382 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 383 INFOT = 2 384 CALL CGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 385 $ INFO ) 386 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 387 INFOT = 3 388 CALL CGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 389 $ INFO ) 390 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 391 INFOT = 4 392 CALL CGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 393 $ INFO ) 394 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 395 INFOT = 6 396 CALL CGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 397 $ INFO ) 398 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 399 END IF 400* 401* Print a summary line. 402* 403 CALL ALAESM( PATH, OK, NOUT ) 404* 405 RETURN 406* 407* End of CERRGE 408* 409 END 410