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*> \ingroup complex_lin 52* 53* ===================================================================== 54 SUBROUTINE CERRGE( PATH, NUNIT ) 55* 56* -- LAPACK test routine -- 57* -- LAPACK is a software package provided by Univ. of Tennessee, -- 58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 59* 60* .. Scalar Arguments .. 61 CHARACTER*3 PATH 62 INTEGER NUNIT 63* .. 64* 65* ===================================================================== 66* 67* .. Parameters .. 68 INTEGER NMAX 69 PARAMETER ( NMAX = 4 ) 70* .. 71* .. Local Scalars .. 72 CHARACTER*2 C2 73 INTEGER I, INFO, J 74 REAL ANRM, CCOND, RCOND 75* .. 76* .. Local Arrays .. 77 INTEGER IP( NMAX ) 78 REAL R( NMAX ), R1( NMAX ), R2( NMAX ) 79 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 80 $ W( 2*NMAX ), X( NMAX ) 81* .. 82* .. External Functions .. 83 LOGICAL LSAMEN 84 EXTERNAL LSAMEN 85* .. 86* .. External Subroutines .. 87 EXTERNAL ALAESM, CGBCON, CGBEQU, CGBRFS, CGBTF2, CGBTRF, 88 $ CGBTRS, CGECON, CGEEQU, CGERFS, CGETF2, CGETRF, 89 $ CGETRI, CGETRS, CHKXER 90* .. 91* .. Scalars in Common .. 92 LOGICAL LERR, OK 93 CHARACTER*32 SRNAMT 94 INTEGER INFOT, NOUT 95* .. 96* .. Common blocks .. 97 COMMON / INFOC / INFOT, NOUT, OK, LERR 98 COMMON / SRNAMC / SRNAMT 99* .. 100* .. Intrinsic Functions .. 101 INTRINSIC CMPLX, REAL 102* .. 103* .. Executable Statements .. 104* 105 NOUT = NUNIT 106 WRITE( NOUT, FMT = * ) 107 C2 = PATH( 2: 3 ) 108* 109* Set the variables to innocuous values. 110* 111 DO 20 J = 1, NMAX 112 DO 10 I = 1, NMAX 113 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 114 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 115 10 CONTINUE 116 B( J ) = 0. 117 R1( J ) = 0. 118 R2( J ) = 0. 119 W( J ) = 0. 120 X( J ) = 0. 121 IP( J ) = J 122 20 CONTINUE 123 OK = .TRUE. 124* 125* Test error exits of the routines that use the LU decomposition 126* of a general matrix. 127* 128 IF( LSAMEN( 2, C2, 'GE' ) ) THEN 129* 130* CGETRF 131* 132 SRNAMT = 'CGETRF' 133 INFOT = 1 134 CALL CGETRF( -1, 0, A, 1, IP, INFO ) 135 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 136 INFOT = 2 137 CALL CGETRF( 0, -1, A, 1, IP, INFO ) 138 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 139 INFOT = 4 140 CALL CGETRF( 2, 1, A, 1, IP, INFO ) 141 CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK ) 142* 143* CGETF2 144* 145 SRNAMT = 'CGETF2' 146 INFOT = 1 147 CALL CGETF2( -1, 0, A, 1, IP, INFO ) 148 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 149 INFOT = 2 150 CALL CGETF2( 0, -1, A, 1, IP, INFO ) 151 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 152 INFOT = 4 153 CALL CGETF2( 2, 1, A, 1, IP, INFO ) 154 CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK ) 155* 156* CGETRI 157* 158 SRNAMT = 'CGETRI' 159 INFOT = 1 160 CALL CGETRI( -1, A, 1, IP, W, 1, INFO ) 161 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 162 INFOT = 3 163 CALL CGETRI( 2, A, 1, IP, W, 2, INFO ) 164 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 165 INFOT = 6 166 CALL CGETRI( 2, A, 2, IP, W, 1, INFO ) 167 CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK ) 168* 169* CGETRS 170* 171 SRNAMT = 'CGETRS' 172 INFOT = 1 173 CALL CGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO ) 174 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 175 INFOT = 2 176 CALL CGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO ) 177 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 178 INFOT = 3 179 CALL CGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO ) 180 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 181 INFOT = 5 182 CALL CGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO ) 183 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 184 INFOT = 8 185 CALL CGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO ) 186 CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK ) 187* 188* CGERFS 189* 190 SRNAMT = 'CGERFS' 191 INFOT = 1 192 CALL CGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W, 193 $ R, INFO ) 194 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 195 INFOT = 2 196 CALL CGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 197 $ W, R, INFO ) 198 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 199 INFOT = 3 200 CALL CGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, 201 $ W, R, INFO ) 202 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 203 INFOT = 5 204 CALL CGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W, 205 $ R, INFO ) 206 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 207 INFOT = 7 208 CALL CGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W, 209 $ R, INFO ) 210 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 211 INFOT = 10 212 CALL CGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W, 213 $ R, INFO ) 214 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 215 INFOT = 12 216 CALL CGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W, 217 $ R, INFO ) 218 CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK ) 219* 220* CGECON 221* 222 SRNAMT = 'CGECON' 223 INFOT = 1 224 CALL CGECON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO ) 225 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 226 INFOT = 2 227 CALL CGECON( '1', -1, A, 1, ANRM, RCOND, W, R, INFO ) 228 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 229 INFOT = 4 230 CALL CGECON( '1', 2, A, 1, ANRM, RCOND, W, R, INFO ) 231 CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK ) 232* 233* CGEEQU 234* 235 SRNAMT = 'CGEEQU' 236 INFOT = 1 237 CALL CGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 238 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 239 INFOT = 2 240 CALL CGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 241 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 242 INFOT = 4 243 CALL CGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO ) 244 CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK ) 245* 246* Test error exits of the routines that use the LU decomposition 247* of a general band matrix. 248* 249 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 250* 251* CGBTRF 252* 253 SRNAMT = 'CGBTRF' 254 INFOT = 1 255 CALL CGBTRF( -1, 0, 0, 0, A, 1, IP, INFO ) 256 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 257 INFOT = 2 258 CALL CGBTRF( 0, -1, 0, 0, A, 1, IP, INFO ) 259 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 260 INFOT = 3 261 CALL CGBTRF( 1, 1, -1, 0, A, 1, IP, INFO ) 262 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 263 INFOT = 4 264 CALL CGBTRF( 1, 1, 0, -1, A, 1, IP, INFO ) 265 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 266 INFOT = 6 267 CALL CGBTRF( 2, 2, 1, 1, A, 3, IP, INFO ) 268 CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK ) 269* 270* CGBTF2 271* 272 SRNAMT = 'CGBTF2' 273 INFOT = 1 274 CALL CGBTF2( -1, 0, 0, 0, A, 1, IP, INFO ) 275 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 276 INFOT = 2 277 CALL CGBTF2( 0, -1, 0, 0, A, 1, IP, INFO ) 278 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 279 INFOT = 3 280 CALL CGBTF2( 1, 1, -1, 0, A, 1, IP, INFO ) 281 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 282 INFOT = 4 283 CALL CGBTF2( 1, 1, 0, -1, A, 1, IP, INFO ) 284 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 285 INFOT = 6 286 CALL CGBTF2( 2, 2, 1, 1, A, 3, IP, INFO ) 287 CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK ) 288* 289* CGBTRS 290* 291 SRNAMT = 'CGBTRS' 292 INFOT = 1 293 CALL CGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO ) 294 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 295 INFOT = 2 296 CALL CGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO ) 297 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 298 INFOT = 3 299 CALL CGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO ) 300 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 301 INFOT = 4 302 CALL CGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO ) 303 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 304 INFOT = 5 305 CALL CGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO ) 306 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 307 INFOT = 7 308 CALL CGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO ) 309 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 310 INFOT = 10 311 CALL CGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO ) 312 CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK ) 313* 314* CGBRFS 315* 316 SRNAMT = 'CGBRFS' 317 INFOT = 1 318 CALL CGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 319 $ R2, W, R, INFO ) 320 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 321 INFOT = 2 322 CALL CGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 323 $ R2, W, R, INFO ) 324 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 325 INFOT = 3 326 CALL CGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 327 $ R2, W, R, INFO ) 328 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 329 INFOT = 4 330 CALL CGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, 331 $ R2, W, R, INFO ) 332 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 333 INFOT = 5 334 CALL CGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, 335 $ R2, W, R, INFO ) 336 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 337 INFOT = 7 338 CALL CGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1, 339 $ R2, W, R, INFO ) 340 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 341 INFOT = 9 342 CALL CGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1, 343 $ R2, W, R, INFO ) 344 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 345 INFOT = 12 346 CALL CGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1, 347 $ R2, W, R, INFO ) 348 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 349 INFOT = 14 350 CALL CGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1, 351 $ R2, W, R, INFO ) 352 CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK ) 353* 354* CGBCON 355* 356 SRNAMT = 'CGBCON' 357 INFOT = 1 358 CALL CGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 359 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 360 INFOT = 2 361 CALL CGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 362 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 363 INFOT = 3 364 CALL CGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, R, INFO ) 365 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 366 INFOT = 4 367 CALL CGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, R, INFO ) 368 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 369 INFOT = 6 370 CALL CGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, R, INFO ) 371 CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK ) 372* 373* CGBEQU 374* 375 SRNAMT = 'CGBEQU' 376 INFOT = 1 377 CALL CGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 378 $ INFO ) 379 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 380 INFOT = 2 381 CALL CGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 382 $ INFO ) 383 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 384 INFOT = 3 385 CALL CGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, 386 $ INFO ) 387 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 388 INFOT = 4 389 CALL CGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, 390 $ INFO ) 391 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 392 INFOT = 6 393 CALL CGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM, 394 $ INFO ) 395 CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK ) 396 END IF 397* 398* Print a summary line. 399* 400 CALL ALAESM( PATH, OK, NOUT ) 401* 402 RETURN 403* 404* End of CERRGE 405* 406 END 407