SRC/dlagtm.f

   1 *> \brief \b DLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download DLAGTM + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlagtm.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlagtm.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlagtm.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
  22 *                          B, LDB )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       CHARACTER          TRANS
  26 *       INTEGER            LDB, LDX, N, NRHS
  27 *       DOUBLE PRECISION   ALPHA, BETA
  28 *       ..
  29 *       .. Array Arguments ..
  30 *       DOUBLE PRECISION   B( LDB, * ), D( * ), DL( * ), DU( * ),
  31 *      $                   X( LDX, * )
  32 *       ..
  33 *
  34 *
  35 *> \par Purpose:
  36 *  =============
  37 *>
  38 *> \verbatim
  39 *>
  40 *> DLAGTM performs a matrix-vector product of the form
  41 *>
  42 *>    B := alpha * A * X + beta * B
  43 *>
  44 *> where A is a tridiagonal matrix of order N, B and X are N by NRHS
  45 *> matrices, and alpha and beta are real scalars, each of which may be
  46 *> 0., 1., or -1.
  47 *> \endverbatim
  48 *
  49 *  Arguments:
  50 *  ==========
  51 *
  52 *> \param[in] TRANS
  53 *> \verbatim
  54 *>          TRANS is CHARACTER*1
  55 *>          Specifies the operation applied to A.
  56 *>          = 'N':  No transpose, B := alpha * A * X + beta * B
  57 *>          = 'T':  Transpose,    B := alpha * A'* X + beta * B
  58 *>          = 'C':  Conjugate transpose = Transpose
  59 *> \endverbatim
  60 *>
  61 *> \param[in] N
  62 *> \verbatim
  63 *>          N is INTEGER
  64 *>          The order of the matrix A.  N >= 0.
  65 *> \endverbatim
  66 *>
  67 *> \param[in] NRHS
  68 *> \verbatim
  69 *>          NRHS is INTEGER
  70 *>          The number of right hand sides, i.e., the number of columns
  71 *>          of the matrices X and B.
  72 *> \endverbatim
  73 *>
  74 *> \param[in] ALPHA
  75 *> \verbatim
  76 *>          ALPHA is DOUBLE PRECISION
  77 *>          The scalar alpha.  ALPHA must be 0., 1., or -1.; otherwise,
  78 *>          it is assumed to be 0.
  79 *> \endverbatim
  80 *>
  81 *> \param[in] DL
  82 *> \verbatim
  83 *>          DL is DOUBLE PRECISION array, dimension (N-1)
  84 *>          The (n-1) sub-diagonal elements of T.
  85 *> \endverbatim
  86 *>
  87 *> \param[in] D
  88 *> \verbatim
  89 *>          D is DOUBLE PRECISION array, dimension (N)
  90 *>          The diagonal elements of T.
  91 *> \endverbatim
  92 *>
  93 *> \param[in] DU
  94 *> \verbatim
  95 *>          DU is DOUBLE PRECISION array, dimension (N-1)
  96 *>          The (n-1) super-diagonal elements of T.
  97 *> \endverbatim
  98 *>
  99 *> \param[in] X
 100 *> \verbatim
 101 *>          X is DOUBLE PRECISION array, dimension (LDX,NRHS)
 102 *>          The N by NRHS matrix X.
 103 *> \endverbatim
 104 *>
 105 *> \param[in] LDX
 106 *> \verbatim
 107 *>          LDX is INTEGER
 108 *>          The leading dimension of the array X.  LDX >= max(N,1).
 109 *> \endverbatim
 110 *>
 111 *> \param[in] BETA
 112 *> \verbatim
 113 *>          BETA is DOUBLE PRECISION
 114 *>          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
 115 *>          it is assumed to be 1.
 116 *> \endverbatim
 117 *>
 118 *> \param[in,out] B
 119 *> \verbatim
 120 *>          B is DOUBLE PRECISION array, dimension (LDB,NRHS)
 121 *>          On entry, the N by NRHS matrix B.
 122 *>          On exit, B is overwritten by the matrix expression
 123 *>          B := alpha * A * X + beta * B.
 124 *> \endverbatim
 125 *>
 126 *> \param[in] LDB
 127 *> \verbatim
 128 *>          LDB is INTEGER
 129 *>          The leading dimension of the array B.  LDB >= max(N,1).
 130 *> \endverbatim
 131 *
 132 *  Authors:
 133 *  ========
 134 *
 135 *> \author Univ. of Tennessee
 136 *> \author Univ. of California Berkeley
 137 *> \author Univ. of Colorado Denver
 138 *> \author NAG Ltd.
 139 *
 140 *> \date September 2012
 141 *
 142 *> \ingroup doubleOTHERauxiliary
 143 *
 144 *  =====================================================================
 145       SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
 146      $                   B, LDB )
 147 *
 148 *  -- LAPACK auxiliary routine (version 3.4.2) --
 149 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 150 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 151 *     September 2012
 152 *
 153 *     .. Scalar Arguments ..
 154       CHARACTER          TRANS
 155       INTEGER            LDB, LDX, N, NRHS
 156       DOUBLE PRECISION   ALPHA, BETA
 157 *     ..
 158 *     .. Array Arguments ..
 159       DOUBLE PRECISION   B( LDB, * ), D( * ), DL( * ), DU( * ),
 160      $                   X( LDX, * )
 161 *     ..
 162 *
 163 *  =====================================================================
 164 *
 165 *     .. Parameters ..
 166       DOUBLE PRECISION   ONE, ZERO
 167       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 168 *     ..
 169 *     .. Local Scalars ..
 170       INTEGER            I, J
 171 *     ..
 172 *     .. External Functions ..
 173       LOGICAL            LSAME
 174       EXTERNAL           LSAME
 175 *     ..
 176 *     .. Executable Statements ..
 177 *
 178       IF( N.EQ.0 )
 179      $   RETURN
 180 *
 181 *     Multiply B by BETA if BETA.NE.1.
 182 *
 183       IF( BETA.EQ.ZERO ) THEN
 184          DO 20 J = 1, NRHS
 185             DO 10 I = 1, N
 186                B( I, J ) = ZERO
 187    10       CONTINUE
 188    20    CONTINUE
 189       ELSE IF( BETA.EQ.-ONE ) THEN
 190          DO 40 J = 1, NRHS
 191             DO 30 I = 1, N
 192                B( I, J ) = -B( I, J )
 193    30       CONTINUE
 194    40    CONTINUE
 195       END IF
 196 *
 197       IF( ALPHA.EQ.ONE ) THEN
 198          IF( LSAME( TRANS, 'N' ) ) THEN
 199 *
 200 *           Compute B := B + A*X
 201 *
 202             DO 60 J = 1, NRHS
 203                IF( N.EQ.1 ) THEN
 204                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
 205                ELSE
 206                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
 207      $                        DU( 1 )*X( 2, J )
 208                   B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
 209      $                        D( N )*X( N, J )
 210                   DO 50 I = 2, N - 1
 211                      B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
 212      $                           D( I )*X( I, J ) + DU( I )*X( I+1, J )
 213    50             CONTINUE
 214                END IF
 215    60       CONTINUE
 216          ELSE
 217 *
 218 *           Compute B := B + A**T*X
 219 *
 220             DO 80 J = 1, NRHS
 221                IF( N.EQ.1 ) THEN
 222                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
 223                ELSE
 224                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
 225      $                        DL( 1 )*X( 2, J )
 226                   B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
 227      $                        D( N )*X( N, J )
 228                   DO 70 I = 2, N - 1
 229                      B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
 230      $                           D( I )*X( I, J ) + DL( I )*X( I+1, J )
 231    70             CONTINUE
 232                END IF
 233    80       CONTINUE
 234          END IF
 235       ELSE IF( ALPHA.EQ.-ONE ) THEN
 236          IF( LSAME( TRANS, 'N' ) ) THEN
 237 *
 238 *           Compute B := B - A*X
 239 *
 240             DO 100 J = 1, NRHS
 241                IF( N.EQ.1 ) THEN
 242                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
 243                ELSE
 244                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
 245      $                        DU( 1 )*X( 2, J )
 246                   B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
 247      $                        D( N )*X( N, J )
 248                   DO 90 I = 2, N - 1
 249                      B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
 250      $                           D( I )*X( I, J ) - DU( I )*X( I+1, J )
 251    90             CONTINUE
 252                END IF
 253   100       CONTINUE
 254          ELSE
 255 *
 256 *           Compute B := B - A**T*X
 257 *
 258             DO 120 J = 1, NRHS
 259                IF( N.EQ.1 ) THEN
 260                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
 261                ELSE
 262                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
 263      $                        DL( 1 )*X( 2, J )
 264                   B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
 265      $                        D( N )*X( N, J )
 266                   DO 110 I = 2, N - 1
 267                      B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
 268      $                           D( I )*X( I, J ) - DL( I )*X( I+1, J )
 269   110             CONTINUE
 270                END IF
 271   120       CONTINUE
 272          END IF
 273       END IF
 274       RETURN
 275 *
 276 *     End of DLAGTM
 277 *
 278       END