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