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