TESTING/LIN/sgtt02.f

   1 *> \brief \b SGTT02
   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 SGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB,
  12 *                          RESID )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       CHARACTER          TRANS
  16 *       INTEGER            LDB, LDX, N, NRHS
  17 *       REAL               RESID
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       REAL               B( LDB, * ), D( * ), DL( * ), DU( * ),
  21 *      $                   X( LDX, * )
  22 *       ..
  23 *
  24 *
  25 *> \par Purpose:
  26 *  =============
  27 *>
  28 *> \verbatim
  29 *>
  30 *> SGTT02 computes the residual for the solution to a tridiagonal
  31 *> system of equations:
  32 *>    RESID = norm(B - op(A)*X) / (norm(A) * norm(X) * EPS),
  33 *> where EPS is the machine epsilon.
  34 *> \endverbatim
  35 *
  36 *  Arguments:
  37 *  ==========
  38 *
  39 *> \param[in] TRANS
  40 *> \verbatim
  41 *>          TRANS is CHARACTER
  42 *>          Specifies the form of the residual.
  43 *>          = 'N':  B - A * X  (No transpose)
  44 *>          = 'T':  B - A'* X  (Transpose)
  45 *>          = 'C':  B - A'* X  (Conjugate transpose = Transpose)
  46 *> \endverbatim
  47 *>
  48 *> \param[in] N
  49 *> \verbatim
  50 *>          N is INTEGTER
  51 *>          The order of the matrix A.  N >= 0.
  52 *> \endverbatim
  53 *>
  54 *> \param[in] NRHS
  55 *> \verbatim
  56 *>          NRHS is INTEGER
  57 *>          The number of right hand sides, i.e., the number of columns
  58 *>          of the matrices B and X.  NRHS >= 0.
  59 *> \endverbatim
  60 *>
  61 *> \param[in] DL
  62 *> \verbatim
  63 *>          DL is REAL array, dimension (N-1)
  64 *>          The (n-1) sub-diagonal elements of A.
  65 *> \endverbatim
  66 *>
  67 *> \param[in] D
  68 *> \verbatim
  69 *>          D is REAL array, dimension (N)
  70 *>          The diagonal elements of A.
  71 *> \endverbatim
  72 *>
  73 *> \param[in] DU
  74 *> \verbatim
  75 *>          DU is REAL array, dimension (N-1)
  76 *>          The (n-1) super-diagonal elements of A.
  77 *> \endverbatim
  78 *>
  79 *> \param[in] X
  80 *> \verbatim
  81 *>          X is REAL array, dimension (LDX,NRHS)
  82 *>          The computed solution vectors X.
  83 *> \endverbatim
  84 *>
  85 *> \param[in] LDX
  86 *> \verbatim
  87 *>          LDX is INTEGER
  88 *>          The leading dimension of the array X.  LDX >= max(1,N).
  89 *> \endverbatim
  90 *>
  91 *> \param[in,out] B
  92 *> \verbatim
  93 *>          B is REAL array, dimension (LDB,NRHS)
  94 *>          On entry, the right hand side vectors for the system of
  95 *>          linear equations.
  96 *>          On exit, B is overwritten with the difference B - op(A)*X.
  97 *> \endverbatim
  98 *>
  99 *> \param[in] LDB
 100 *> \verbatim
 101 *>          LDB is INTEGER
 102 *>          The leading dimension of the array B.  LDB >= max(1,N).
 103 *> \endverbatim
 104 *>
 105 *> \param[out] RESID
 106 *> \verbatim
 107 *>          RESID is REAL
 108 *>          norm(B - op(A)*X) / (norm(A) * norm(X) * EPS)
 109 *> \endverbatim
 110 *
 111 *  Authors:
 112 *  ========
 113 *
 114 *> \author Univ. of Tennessee
 115 *> \author Univ. of California Berkeley
 116 *> \author Univ. of Colorado Denver
 117 *> \author NAG Ltd.
 118 *
 119 *> \date November 2011
 120 *
 121 *> \ingroup single_lin
 122 *
 123 *  =====================================================================
 124       SUBROUTINE SGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB,
 125      $                   RESID )
 126 *
 127 *  -- LAPACK test routine (version 3.4.0) --
 128 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 129 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 130 *     November 2011
 131 *
 132 *     .. Scalar Arguments ..
 133       CHARACTER          TRANS
 134       INTEGER            LDB, LDX, N, NRHS
 135       REAL               RESID
 136 *     ..
 137 *     .. Array Arguments ..
 138       REAL               B( LDB, * ), D( * ), DL( * ), DU( * ),
 139      $                   X( LDX, * )
 140 *     ..
 141 *
 142 *  =====================================================================
 143 *
 144 *     .. Parameters ..
 145       REAL               ONE, ZERO
 146       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 147 *     ..
 148 *     .. Local Scalars ..
 149       INTEGER            J
 150       REAL               ANORM, BNORM, EPS, XNORM
 151 *     ..
 152 *     .. External Functions ..
 153       LOGICAL            LSAME
 154       REAL               SASUM, SLAMCH, SLANGT
 155       EXTERNAL           LSAME, SASUM, SLAMCH, SLANGT
 156 *     ..
 157 *     .. External Subroutines ..
 158       EXTERNAL           SLAGTM
 159 *     ..
 160 *     .. Intrinsic Functions ..
 161       INTRINSIC          MAX
 162 *     ..
 163 *     .. Executable Statements ..
 164 *
 165 *     Quick exit if N = 0 or NRHS = 0
 166 *
 167       RESID = ZERO
 168       IF( N.LE.0 .OR. NRHS.EQ.0 )
 169      $   RETURN
 170 *
 171 *     Compute the maximum over the number of right hand sides of
 172 *        norm(B - op(A)*X) / ( norm(A) * norm(X) * EPS ).
 173 *
 174       IF( LSAME( TRANS, 'N' ) ) THEN
 175          ANORM = SLANGT( '1', N, DL, D, DU )
 176       ELSE
 177          ANORM = SLANGT( 'I', N, DL, D, DU )
 178       END IF
 179 *
 180 *     Exit with RESID = 1/EPS if ANORM = 0.
 181 *
 182       EPS = SLAMCH( 'Epsilon' )
 183       IF( ANORM.LE.ZERO ) THEN
 184          RESID = ONE / EPS
 185          RETURN
 186       END IF
 187 *
 188 *     Compute B - op(A)*X.
 189 *
 190       CALL SLAGTM( TRANS, N, NRHS, -ONE, DL, D, DU, X, LDX, ONE, B,
 191      $             LDB )
 192 *
 193       DO 10 J = 1, NRHS
 194          BNORM = SASUM( N, B( 1, J ), 1 )
 195          XNORM = SASUM( N, X( 1, J ), 1 )
 196          IF( XNORM.LE.ZERO ) THEN
 197             RESID = ONE / EPS
 198          ELSE
 199             RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
 200          END IF
 201    10 CONTINUE
 202 *
 203       RETURN
 204 *
 205 *     End of SGTT02
 206 *
 207       END