001:       SUBROUTINE SLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
002:      $                   B, LDB )
003: *
004: *  -- LAPACK auxiliary routine (version 3.2) --
005: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
006: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
007: *     November 2006
008: *
009: *     .. Scalar Arguments ..
010:       CHARACTER          TRANS
011:       INTEGER            LDB, LDX, N, NRHS
012:       REAL               ALPHA, BETA
013: *     ..
014: *     .. Array Arguments ..
015:       REAL               B( LDB, * ), D( * ), DL( * ), DU( * ),
016:      $                   X( LDX, * )
017: *     ..
018: *
019: *  Purpose
020: *  =======
021: *
022: *  SLAGTM performs a matrix-vector product of the form
023: *
024: *     B := alpha * A * X + beta * B
025: *
026: *  where A is a tridiagonal matrix of order N, B and X are N by NRHS
027: *  matrices, and alpha and beta are real scalars, each of which may be
028: *  0., 1., or -1.
029: *
030: *  Arguments
031: *  =========
032: *
033: *  TRANS   (input) CHARACTER*1
034: *          Specifies the operation applied to A.
035: *          = 'N':  No transpose, B := alpha * A * X + beta * B
036: *          = 'T':  Transpose,    B := alpha * A'* X + beta * B
037: *          = 'C':  Conjugate transpose = Transpose
038: *
039: *  N       (input) INTEGER
040: *          The order of the matrix A.  N >= 0.
041: *
042: *  NRHS    (input) INTEGER
043: *          The number of right hand sides, i.e., the number of columns
044: *          of the matrices X and B.
045: *
046: *  ALPHA   (input) REAL
047: *          The scalar alpha.  ALPHA must be 0., 1., or -1.; otherwise,
048: *          it is assumed to be 0.
049: *
050: *  DL      (input) REAL array, dimension (N-1)
051: *          The (n-1) sub-diagonal elements of T.
052: *
053: *  D       (input) REAL array, dimension (N)
054: *          The diagonal elements of T.
055: *
056: *  DU      (input) REAL array, dimension (N-1)
057: *          The (n-1) super-diagonal elements of T.
058: *
059: *  X       (input) REAL array, dimension (LDX,NRHS)
060: *          The N by NRHS matrix X.
061: *  LDX     (input) INTEGER
062: *          The leading dimension of the array X.  LDX >= max(N,1).
063: *
064: *  BETA    (input) REAL
065: *          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
066: *          it is assumed to be 1.
067: *
068: *  B       (input/output) REAL array, dimension (LDB,NRHS)
069: *          On entry, the N by NRHS matrix B.
070: *          On exit, B is overwritten by the matrix expression
071: *          B := alpha * A * X + beta * B.
072: *
073: *  LDB     (input) INTEGER
074: *          The leading dimension of the array B.  LDB >= max(N,1).
075: *
076: *  =====================================================================
077: *
078: *     .. Parameters ..
079:       REAL               ONE, ZERO
080:       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
081: *     ..
082: *     .. Local Scalars ..
083:       INTEGER            I, J
084: *     ..
085: *     .. External Functions ..
086:       LOGICAL            LSAME
087:       EXTERNAL           LSAME
088: *     ..
089: *     .. Executable Statements ..
090: *
091:       IF( N.EQ.0 )
092:      $   RETURN
093: *
094: *     Multiply B by BETA if BETA.NE.1.
095: *
096:       IF( BETA.EQ.ZERO ) THEN
097:          DO 20 J = 1, NRHS
098:             DO 10 I = 1, N
099:                B( I, J ) = ZERO
100:    10       CONTINUE
101:    20    CONTINUE
102:       ELSE IF( BETA.EQ.-ONE ) THEN
103:          DO 40 J = 1, NRHS
104:             DO 30 I = 1, N
105:                B( I, J ) = -B( I, J )
106:    30       CONTINUE
107:    40    CONTINUE
108:       END IF
109: *
110:       IF( ALPHA.EQ.ONE ) THEN
111:          IF( LSAME( TRANS, 'N' ) ) THEN
112: *
113: *           Compute B := B + A*X
114: *
115:             DO 60 J = 1, NRHS
116:                IF( N.EQ.1 ) THEN
117:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
118:                ELSE
119:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
120:      $                        DU( 1 )*X( 2, J )
121:                   B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
122:      $                        D( N )*X( N, J )
123:                   DO 50 I = 2, N - 1
124:                      B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
125:      $                           D( I )*X( I, J ) + DU( I )*X( I+1, J )
126:    50             CONTINUE
127:                END IF
128:    60       CONTINUE
129:          ELSE
130: *
131: *           Compute B := B + A'*X
132: *
133:             DO 80 J = 1, NRHS
134:                IF( N.EQ.1 ) THEN
135:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
136:                ELSE
137:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
138:      $                        DL( 1 )*X( 2, J )
139:                   B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
140:      $                        D( N )*X( N, J )
141:                   DO 70 I = 2, N - 1
142:                      B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
143:      $                           D( I )*X( I, J ) + DL( I )*X( I+1, J )
144:    70             CONTINUE
145:                END IF
146:    80       CONTINUE
147:          END IF
148:       ELSE IF( ALPHA.EQ.-ONE ) THEN
149:          IF( LSAME( TRANS, 'N' ) ) THEN
150: *
151: *           Compute B := B - A*X
152: *
153:             DO 100 J = 1, NRHS
154:                IF( N.EQ.1 ) THEN
155:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
156:                ELSE
157:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
158:      $                        DU( 1 )*X( 2, J )
159:                   B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
160:      $                        D( N )*X( N, J )
161:                   DO 90 I = 2, N - 1
162:                      B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
163:      $                           D( I )*X( I, J ) - DU( I )*X( I+1, J )
164:    90             CONTINUE
165:                END IF
166:   100       CONTINUE
167:          ELSE
168: *
169: *           Compute B := B - A'*X
170: *
171:             DO 120 J = 1, NRHS
172:                IF( N.EQ.1 ) THEN
173:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
174:                ELSE
175:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
176:      $                        DL( 1 )*X( 2, J )
177:                   B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
178:      $                        D( N )*X( N, J )
179:                   DO 110 I = 2, N - 1
180:                      B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
181:      $                           D( I )*X( I, J ) - DL( I )*X( I+1, J )
182:   110             CONTINUE
183:                END IF
184:   120       CONTINUE
185:          END IF
186:       END IF
187:       RETURN
188: *
189: *     End of SLAGTM
190: *
191:       END
192: