001:       SUBROUTINE CLAGTM( 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:       COMPLEX            B( LDB, * ), D( * ), DL( * ), DU( * ),
016:      $                   X( LDX, * )
017: *     ..
018: *
019: *  Purpose
020: *  =======
021: *
022: *  CLAGTM 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**T * X + beta * B
037: *          = 'C':  Conjugate transpose, B := alpha * A**H * X + beta * B
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) COMPLEX array, dimension (N-1)
051: *          The (n-1) sub-diagonal elements of T.
052: *
053: *  D       (input) COMPLEX array, dimension (N)
054: *          The diagonal elements of T.
055: *
056: *  DU      (input) COMPLEX array, dimension (N-1)
057: *          The (n-1) super-diagonal elements of T.
058: *
059: *  X       (input) COMPLEX 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) COMPLEX 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: *     .. Intrinsic Functions ..
090:       INTRINSIC          CONJG
091: *     ..
092: *     .. Executable Statements ..
093: *
094:       IF( N.EQ.0 )
095:      $   RETURN
096: *
097: *     Multiply B by BETA if BETA.NE.1.
098: *
099:       IF( BETA.EQ.ZERO ) THEN
100:          DO 20 J = 1, NRHS
101:             DO 10 I = 1, N
102:                B( I, J ) = ZERO
103:    10       CONTINUE
104:    20    CONTINUE
105:       ELSE IF( BETA.EQ.-ONE ) THEN
106:          DO 40 J = 1, NRHS
107:             DO 30 I = 1, N
108:                B( I, J ) = -B( I, J )
109:    30       CONTINUE
110:    40    CONTINUE
111:       END IF
112: *
113:       IF( ALPHA.EQ.ONE ) THEN
114:          IF( LSAME( TRANS, 'N' ) ) THEN
115: *
116: *           Compute B := B + A*X
117: *
118:             DO 60 J = 1, NRHS
119:                IF( N.EQ.1 ) THEN
120:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
121:                ELSE
122:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
123:      $                        DU( 1 )*X( 2, J )
124:                   B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) +
125:      $                        D( N )*X( N, J )
126:                   DO 50 I = 2, N - 1
127:                      B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) +
128:      $                           D( I )*X( I, J ) + DU( I )*X( I+1, J )
129:    50             CONTINUE
130:                END IF
131:    60       CONTINUE
132:          ELSE IF( LSAME( TRANS, 'T' ) ) THEN
133: *
134: *           Compute B := B + A**T * X
135: *
136:             DO 80 J = 1, NRHS
137:                IF( N.EQ.1 ) THEN
138:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
139:                ELSE
140:                   B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
141:      $                        DL( 1 )*X( 2, J )
142:                   B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) +
143:      $                        D( N )*X( N, J )
144:                   DO 70 I = 2, N - 1
145:                      B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) +
146:      $                           D( I )*X( I, J ) + DL( I )*X( I+1, J )
147:    70             CONTINUE
148:                END IF
149:    80       CONTINUE
150:          ELSE IF( LSAME( TRANS, 'C' ) ) THEN
151: *
152: *           Compute B := B + A**H * X
153: *
154:             DO 100 J = 1, NRHS
155:                IF( N.EQ.1 ) THEN
156:                   B( 1, J ) = B( 1, J ) + CONJG( D( 1 ) )*X( 1, J )
157:                ELSE
158:                   B( 1, J ) = B( 1, J ) + CONJG( D( 1 ) )*X( 1, J ) +
159:      $                        CONJG( DL( 1 ) )*X( 2, J )
160:                   B( N, J ) = B( N, J ) + CONJG( DU( N-1 ) )*
161:      $                        X( N-1, J ) + CONJG( D( N ) )*X( N, J )
162:                   DO 90 I = 2, N - 1
163:                      B( I, J ) = B( I, J ) + CONJG( DU( I-1 ) )*
164:      $                           X( I-1, J ) + CONJG( D( I ) )*
165:      $                           X( I, J ) + CONJG( DL( I ) )*
166:      $                           X( I+1, J )
167:    90             CONTINUE
168:                END IF
169:   100       CONTINUE
170:          END IF
171:       ELSE IF( ALPHA.EQ.-ONE ) THEN
172:          IF( LSAME( TRANS, 'N' ) ) THEN
173: *
174: *           Compute B := B - A*X
175: *
176:             DO 120 J = 1, NRHS
177:                IF( N.EQ.1 ) THEN
178:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
179:                ELSE
180:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
181:      $                        DU( 1 )*X( 2, J )
182:                   B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) -
183:      $                        D( N )*X( N, J )
184:                   DO 110 I = 2, N - 1
185:                      B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) -
186:      $                           D( I )*X( I, J ) - DU( I )*X( I+1, J )
187:   110             CONTINUE
188:                END IF
189:   120       CONTINUE
190:          ELSE IF( LSAME( TRANS, 'T' ) ) THEN
191: *
192: *           Compute B := B - A'*X
193: *
194:             DO 140 J = 1, NRHS
195:                IF( N.EQ.1 ) THEN
196:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
197:                ELSE
198:                   B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
199:      $                        DL( 1 )*X( 2, J )
200:                   B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) -
201:      $                        D( N )*X( N, J )
202:                   DO 130 I = 2, N - 1
203:                      B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) -
204:      $                           D( I )*X( I, J ) - DL( I )*X( I+1, J )
205:   130             CONTINUE
206:                END IF
207:   140       CONTINUE
208:          ELSE IF( LSAME( TRANS, 'C' ) ) THEN
209: *
210: *           Compute B := B - A'*X
211: *
212:             DO 160 J = 1, NRHS
213:                IF( N.EQ.1 ) THEN
214:                   B( 1, J ) = B( 1, J ) - CONJG( D( 1 ) )*X( 1, J )
215:                ELSE
216:                   B( 1, J ) = B( 1, J ) - CONJG( D( 1 ) )*X( 1, J ) -
217:      $                        CONJG( DL( 1 ) )*X( 2, J )
218:                   B( N, J ) = B( N, J ) - CONJG( DU( N-1 ) )*
219:      $                        X( N-1, J ) - CONJG( D( N ) )*X( N, J )
220:                   DO 150 I = 2, N - 1
221:                      B( I, J ) = B( I, J ) - CONJG( DU( I-1 ) )*
222:      $                           X( I-1, J ) - CONJG( D( I ) )*
223:      $                           X( I, J ) - CONJG( DL( I ) )*
224:      $                           X( I+1, J )
225:   150             CONTINUE
226:                END IF
227:   160       CONTINUE
228:          END IF
229:       END IF
230:       RETURN
231: *
232: *     End of CLAGTM
233: *
234:       END
235: