TESTING/LIN/zerrgt.f

   1 *> \brief \b ZERRGT
   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 ZERRGT( 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 *> ZERRGT tests the error exits for the COMPLEX*16 tridiagonal
  25 *> routines.
  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 complex16_lin
  54 *
  55 *  =====================================================================
  56       SUBROUTINE ZERRGT( 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
  72       PARAMETER          ( NMAX = 2 )
  73 *     ..
  74 *     .. Local Scalars ..
  75       CHARACTER*2        C2
  76       INTEGER            I, INFO
  77       DOUBLE PRECISION   ANORM, RCOND
  78 *     ..
  79 *     .. Local Arrays ..
  80       INTEGER            IP( NMAX )
  81       DOUBLE PRECISION   D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
  82      $                   RW( NMAX )
  83       COMPLEX*16         B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ),
  84      $                   DU2( NMAX ), DUF( NMAX ), E( NMAX ),
  85      $                   EF( NMAX ), W( NMAX ), X( NMAX )
  86 *     ..
  87 *     .. External Functions ..
  88       LOGICAL            LSAMEN
  89       EXTERNAL           LSAMEN
  90 *     ..
  91 *     .. External Subroutines ..
  92       EXTERNAL           ALAESM, CHKXER, ZGTCON, ZGTRFS, ZGTTRF, ZGTTRS,
  93      $                   ZPTCON, ZPTRFS, ZPTTRF, ZPTTRS
  94 *     ..
  95 *     .. Scalars in Common ..
  96       LOGICAL            LERR, OK
  97       CHARACTER*32       SRNAMT
  98       INTEGER            INFOT, NOUT
  99 *     ..
 100 *     .. Common blocks ..
 101       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 102       COMMON             / SRNAMC / SRNAMT
 103 *     ..
 104 *     .. Executable Statements ..
 105 *
 106       NOUT = NUNIT
 107       WRITE( NOUT, FMT = * )
 108       C2 = PATH( 2: 3 )
 109       DO 10 I = 1, NMAX
 110          D( I ) = 1.D0
 111          E( I ) = 2.D0
 112          DL( I ) = 3.D0
 113          DU( I ) = 4.D0
 114    10 CONTINUE
 115       ANORM = 1.0D0
 116       OK = .TRUE.
 117 *
 118       IF( LSAMEN( 2, C2, 'GT' ) ) THEN
 119 *
 120 *        Test error exits for the general tridiagonal routines.
 121 *
 122 *        ZGTTRF
 123 *
 124          SRNAMT = 'ZGTTRF'
 125          INFOT = 1
 126          CALL ZGTTRF( -1, DL, E, DU, DU2, IP, INFO )
 127          CALL CHKXER( 'ZGTTRF', INFOT, NOUT, LERR, OK )
 128 *
 129 *        ZGTTRS
 130 *
 131          SRNAMT = 'ZGTTRS'
 132          INFOT = 1
 133          CALL ZGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO )
 134          CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
 135          INFOT = 2
 136          CALL ZGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO )
 137          CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
 138          INFOT = 3
 139          CALL ZGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO )
 140          CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
 141          INFOT = 10
 142          CALL ZGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO )
 143          CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
 144 *
 145 *        ZGTRFS
 146 *
 147          SRNAMT = 'ZGTRFS'
 148          INFOT = 1
 149          CALL ZGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
 150      $                X, 1, R1, R2, W, RW, INFO )
 151          CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
 152          INFOT = 2
 153          CALL ZGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
 154      $                1, X, 1, R1, R2, W, RW, INFO )
 155          CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
 156          INFOT = 3
 157          CALL ZGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
 158      $                1, X, 1, R1, R2, W, RW, INFO )
 159          CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
 160          INFOT = 13
 161          CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
 162      $                X, 2, R1, R2, W, RW, INFO )
 163          CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
 164          INFOT = 15
 165          CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2,
 166      $                X, 1, R1, R2, W, RW, INFO )
 167          CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
 168 *
 169 *        ZGTCON
 170 *
 171          SRNAMT = 'ZGTCON'
 172          INFOT = 1
 173          CALL ZGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W,
 174      $                INFO )
 175          CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
 176          INFOT = 2
 177          CALL ZGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W,
 178      $                INFO )
 179          CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
 180          INFOT = 8
 181          CALL ZGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W,
 182      $                INFO )
 183          CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
 184 *
 185       ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
 186 *
 187 *        Test error exits for the positive definite tridiagonal
 188 *        routines.
 189 *
 190 *        ZPTTRF
 191 *
 192          SRNAMT = 'ZPTTRF'
 193          INFOT = 1
 194          CALL ZPTTRF( -1, D, E, INFO )
 195          CALL CHKXER( 'ZPTTRF', INFOT, NOUT, LERR, OK )
 196 *
 197 *        ZPTTRS
 198 *
 199          SRNAMT = 'ZPTTRS'
 200          INFOT = 1
 201          CALL ZPTTRS( '/', 1, 0, D, E, X, 1, INFO )
 202          CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
 203          INFOT = 2
 204          CALL ZPTTRS( 'U', -1, 0, D, E, X, 1, INFO )
 205          CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
 206          INFOT = 3
 207          CALL ZPTTRS( 'U', 0, -1, D, E, X, 1, INFO )
 208          CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
 209          INFOT = 7
 210          CALL ZPTTRS( 'U', 2, 1, D, E, X, 1, INFO )
 211          CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
 212 *
 213 *        ZPTRFS
 214 *
 215          SRNAMT = 'ZPTRFS'
 216          INFOT = 1
 217          CALL ZPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
 218      $                RW, INFO )
 219          CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
 220          INFOT = 2
 221          CALL ZPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
 222      $                RW, INFO )
 223          CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
 224          INFOT = 3
 225          CALL ZPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
 226      $                RW, INFO )
 227          CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
 228          INFOT = 9
 229          CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W,
 230      $                RW, INFO )
 231          CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
 232          INFOT = 11
 233          CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W,
 234      $                RW, INFO )
 235          CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
 236 *
 237 *        ZPTCON
 238 *
 239          SRNAMT = 'ZPTCON'
 240          INFOT = 1
 241          CALL ZPTCON( -1, D, E, ANORM, RCOND, RW, INFO )
 242          CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK )
 243          INFOT = 4
 244          CALL ZPTCON( 0, D, E, -ANORM, RCOND, RW, INFO )
 245          CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK )
 246       END IF
 247 *
 248 *     Print a summary line.
 249 *
 250       CALL ALAESM( PATH, OK, NOUT )
 251 *
 252       RETURN
 253 *
 254 *     End of ZERRGT
 255 *
 256       END