1*> \brief \b CLAPTM
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 CLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
12*                          LDB )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          UPLO
16*       INTEGER            LDB, LDX, N, NRHS
17*       REAL               ALPHA, BETA
18*       ..
19*       .. Array Arguments ..
20*       REAL               D( * )
21*       COMPLEX            B( LDB, * ), E( * ), X( LDX, * )
22*       ..
23*
24*
25*> \par Purpose:
26*  =============
27*>
28*> \verbatim
29*>
30*> CLAPTM multiplies an N by NRHS matrix X by a Hermitian tridiagonal
31*> matrix A and stores the result in a matrix B.  The operation has the
32*> form
33*>
34*>    B := alpha * A * X + beta * B
35*>
36*> where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
37*> \endverbatim
38*
39*  Arguments:
40*  ==========
41*
42*> \param[in] UPLO
43*> \verbatim
44*>          UPLO is CHARACTER
45*>          Specifies whether the superdiagonal or the subdiagonal of the
46*>          tridiagonal matrix A is stored.
47*>          = 'U':  Upper, E is the superdiagonal of A.
48*>          = 'L':  Lower, E is the subdiagonal of A.
49*> \endverbatim
50*>
51*> \param[in] N
52*> \verbatim
53*>          N is INTEGER
54*>          The order of the matrix A.  N >= 0.
55*> \endverbatim
56*>
57*> \param[in] NRHS
58*> \verbatim
59*>          NRHS is INTEGER
60*>          The number of right hand sides, i.e., the number of columns
61*>          of the matrices X and B.
62*> \endverbatim
63*>
64*> \param[in] ALPHA
65*> \verbatim
66*>          ALPHA is REAL
67*>          The scalar alpha.  ALPHA must be 1. or -1.; otherwise,
68*>          it is assumed to be 0.
69*> \endverbatim
70*>
71*> \param[in] D
72*> \verbatim
73*>          D is REAL array, dimension (N)
74*>          The n diagonal elements of the tridiagonal matrix A.
75*> \endverbatim
76*>
77*> \param[in] E
78*> \verbatim
79*>          E is COMPLEX array, dimension (N-1)
80*>          The (n-1) subdiagonal or superdiagonal elements of A.
81*> \endverbatim
82*>
83*> \param[in] X
84*> \verbatim
85*>          X is COMPLEX array, dimension (LDX,NRHS)
86*>          The N by NRHS matrix X.
87*> \endverbatim
88*>
89*> \param[in] LDX
90*> \verbatim
91*>          LDX is INTEGER
92*>          The leading dimension of the array X.  LDX >= max(N,1).
93*> \endverbatim
94*>
95*> \param[in] BETA
96*> \verbatim
97*>          BETA is REAL
98*>          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
99*>          it is assumed to be 1.
100*> \endverbatim
101*>
102*> \param[in,out] B
103*> \verbatim
104*>          B is COMPLEX array, dimension (LDB,NRHS)
105*>          On entry, the N by NRHS matrix B.
106*>          On exit, B is overwritten by the matrix expression
107*>          B := alpha * A * X + beta * B.
108*> \endverbatim
109*>
110*> \param[in] LDB
111*> \verbatim
112*>          LDB is INTEGER
113*>          The leading dimension of the array B.  LDB >= max(N,1).
114*> \endverbatim
115*
116*  Authors:
117*  ========
118*
119*> \author Univ. of Tennessee
120*> \author Univ. of California Berkeley
121*> \author Univ. of Colorado Denver
122*> \author NAG Ltd.
123*
124*> \date December 2016
125*
126*> \ingroup complex_lin
127*
128*  =====================================================================
129      SUBROUTINE CLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
130     $                   LDB )
131*
132*  -- LAPACK test routine (version 3.7.0) --
133*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
134*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
135*     December 2016
136*
137*     .. Scalar Arguments ..
138      CHARACTER          UPLO
139      INTEGER            LDB, LDX, N, NRHS
140      REAL               ALPHA, BETA
141*     ..
142*     .. Array Arguments ..
143      REAL               D( * )
144      COMPLEX            B( LDB, * ), E( * ), X( LDX, * )
145*     ..
146*
147*  =====================================================================
148*
149*     .. Parameters ..
150      REAL               ONE, ZERO
151      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
152*     ..
153*     .. Local Scalars ..
154      INTEGER            I, J
155*     ..
156*     .. External Functions ..
157      LOGICAL            LSAME
158      EXTERNAL           LSAME
159*     ..
160*     .. Intrinsic Functions ..
161      INTRINSIC          CONJG
162*     ..
163*     .. Executable Statements ..
164*
165      IF( N.EQ.0 )
166     $   RETURN
167*
168      IF( BETA.EQ.ZERO ) THEN
169         DO 20 J = 1, NRHS
170            DO 10 I = 1, N
171               B( I, J ) = ZERO
172   10       CONTINUE
173   20    CONTINUE
174      ELSE IF( BETA.EQ.-ONE ) THEN
175         DO 40 J = 1, NRHS
176            DO 30 I = 1, N
177               B( I, J ) = -B( I, J )
178   30       CONTINUE
179   40    CONTINUE
180      END IF
181*
182      IF( ALPHA.EQ.ONE ) THEN
183         IF( LSAME( UPLO, 'U' ) ) THEN
184*
185*           Compute B := B + A*X, where E is the superdiagonal of A.
186*
187            DO 60 J = 1, NRHS
188               IF( N.EQ.1 ) THEN
189                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
190               ELSE
191                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
192     $                        E( 1 )*X( 2, J )
193                  B( N, J ) = B( N, J ) + CONJG( E( N-1 ) )*
194     $                        X( N-1, J ) + D( N )*X( N, J )
195                  DO 50 I = 2, N - 1
196                     B( I, J ) = B( I, J ) + CONJG( E( I-1 ) )*
197     $                           X( I-1, J ) + D( I )*X( I, J ) +
198     $                           E( I )*X( I+1, J )
199   50             CONTINUE
200               END IF
201   60       CONTINUE
202         ELSE
203*
204*           Compute B := B + A*X, where E is the subdiagonal of A.
205*
206            DO 80 J = 1, NRHS
207               IF( N.EQ.1 ) THEN
208                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
209               ELSE
210                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
211     $                        CONJG( E( 1 ) )*X( 2, J )
212                  B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) +
213     $                        D( N )*X( N, J )
214                  DO 70 I = 2, N - 1
215                     B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) +
216     $                           D( I )*X( I, J ) +
217     $                           CONJG( E( I ) )*X( I+1, J )
218   70             CONTINUE
219               END IF
220   80       CONTINUE
221         END IF
222      ELSE IF( ALPHA.EQ.-ONE ) THEN
223         IF( LSAME( UPLO, 'U' ) ) THEN
224*
225*           Compute B := B - A*X, where E is the superdiagonal of A.
226*
227            DO 100 J = 1, NRHS
228               IF( N.EQ.1 ) THEN
229                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
230               ELSE
231                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
232     $                        E( 1 )*X( 2, J )
233                  B( N, J ) = B( N, J ) - CONJG( E( N-1 ) )*
234     $                        X( N-1, J ) - D( N )*X( N, J )
235                  DO 90 I = 2, N - 1
236                     B( I, J ) = B( I, J ) - CONJG( E( I-1 ) )*
237     $                           X( I-1, J ) - D( I )*X( I, J ) -
238     $                           E( I )*X( I+1, J )
239   90             CONTINUE
240               END IF
241  100       CONTINUE
242         ELSE
243*
244*           Compute B := B - A*X, where E is the subdiagonal of A.
245*
246            DO 120 J = 1, NRHS
247               IF( N.EQ.1 ) THEN
248                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
249               ELSE
250                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
251     $                        CONJG( E( 1 ) )*X( 2, J )
252                  B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) -
253     $                        D( N )*X( N, J )
254                  DO 110 I = 2, N - 1
255                     B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) -
256     $                           D( I )*X( I, J ) -
257     $                           CONJG( E( I ) )*X( I+1, J )
258  110             CONTINUE
259               END IF
260  120       CONTINUE
261         END IF
262      END IF
263      RETURN
264*
265*     End of CLAPTM
266*
267      END
268