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