TESTING/LIN/derrge.f

   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