1*> \brief \b ZLAPTM
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 ZLAPTM( 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*       DOUBLE PRECISION   ALPHA, BETA
18*       ..
19*       .. Array Arguments ..
20*       DOUBLE PRECISION   D( * )
21*       COMPLEX*16         B( LDB, * ), E( * ), X( LDX, * )
22*       ..
23*
24*
25*> \par Purpose:
26*  =============
27*>
28*> \verbatim
29*>
30*> ZLAPTM 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 DOUBLE PRECISION
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 DOUBLE PRECISION 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*16 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*16 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 DOUBLE PRECISION
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*16 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*> \ingroup complex16_lin
125*
126*  =====================================================================
127      SUBROUTINE ZLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
128     $                   LDB )
129*
130*  -- LAPACK test routine --
131*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
132*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
133*
134*     .. Scalar Arguments ..
135      CHARACTER          UPLO
136      INTEGER            LDB, LDX, N, NRHS
137      DOUBLE PRECISION   ALPHA, BETA
138*     ..
139*     .. Array Arguments ..
140      DOUBLE PRECISION   D( * )
141      COMPLEX*16         B( LDB, * ), E( * ), X( LDX, * )
142*     ..
143*
144*  =====================================================================
145*
146*     .. Parameters ..
147      DOUBLE PRECISION   ONE, ZERO
148      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
149*     ..
150*     .. Local Scalars ..
151      INTEGER            I, J
152*     ..
153*     .. External Functions ..
154      LOGICAL            LSAME
155      EXTERNAL           LSAME
156*     ..
157*     .. Intrinsic Functions ..
158      INTRINSIC          DCONJG
159*     ..
160*     .. Executable Statements ..
161*
162      IF( N.EQ.0 )
163     $   RETURN
164*
165      IF( BETA.EQ.ZERO ) THEN
166         DO 20 J = 1, NRHS
167            DO 10 I = 1, N
168               B( I, J ) = ZERO
169   10       CONTINUE
170   20    CONTINUE
171      ELSE IF( BETA.EQ.-ONE ) THEN
172         DO 40 J = 1, NRHS
173            DO 30 I = 1, N
174               B( I, J ) = -B( I, J )
175   30       CONTINUE
176   40    CONTINUE
177      END IF
178*
179      IF( ALPHA.EQ.ONE ) THEN
180         IF( LSAME( UPLO, 'U' ) ) THEN
181*
182*           Compute B := B + A*X, where E is the superdiagonal of A.
183*
184            DO 60 J = 1, NRHS
185               IF( N.EQ.1 ) THEN
186                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
187               ELSE
188                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
189     $                        E( 1 )*X( 2, J )
190                  B( N, J ) = B( N, J ) + DCONJG( E( N-1 ) )*
191     $                        X( N-1, J ) + D( N )*X( N, J )
192                  DO 50 I = 2, N - 1
193                     B( I, J ) = B( I, J ) + DCONJG( E( I-1 ) )*
194     $                           X( I-1, J ) + D( I )*X( I, J ) +
195     $                           E( I )*X( I+1, J )
196   50             CONTINUE
197               END IF
198   60       CONTINUE
199         ELSE
200*
201*           Compute B := B + A*X, where E is the subdiagonal of A.
202*
203            DO 80 J = 1, NRHS
204               IF( N.EQ.1 ) THEN
205                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
206               ELSE
207                  B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
208     $                        DCONJG( E( 1 ) )*X( 2, J )
209                  B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) +
210     $                        D( N )*X( N, J )
211                  DO 70 I = 2, N - 1
212                     B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) +
213     $                           D( I )*X( I, J ) +
214     $                           DCONJG( E( I ) )*X( I+1, J )
215   70             CONTINUE
216               END IF
217   80       CONTINUE
218         END IF
219      ELSE IF( ALPHA.EQ.-ONE ) THEN
220         IF( LSAME( UPLO, 'U' ) ) THEN
221*
222*           Compute B := B - A*X, where E is the superdiagonal of A.
223*
224            DO 100 J = 1, NRHS
225               IF( N.EQ.1 ) THEN
226                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
227               ELSE
228                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
229     $                        E( 1 )*X( 2, J )
230                  B( N, J ) = B( N, J ) - DCONJG( E( N-1 ) )*
231     $                        X( N-1, J ) - D( N )*X( N, J )
232                  DO 90 I = 2, N - 1
233                     B( I, J ) = B( I, J ) - DCONJG( E( I-1 ) )*
234     $                           X( I-1, J ) - D( I )*X( I, J ) -
235     $                           E( I )*X( I+1, J )
236   90             CONTINUE
237               END IF
238  100       CONTINUE
239         ELSE
240*
241*           Compute B := B - A*X, where E is the subdiagonal of A.
242*
243            DO 120 J = 1, NRHS
244               IF( N.EQ.1 ) THEN
245                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
246               ELSE
247                  B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
248     $                        DCONJG( E( 1 ) )*X( 2, J )
249                  B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) -
250     $                        D( N )*X( N, J )
251                  DO 110 I = 2, N - 1
252                     B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) -
253     $                           D( I )*X( I, J ) -
254     $                           DCONJG( E( I ) )*X( I+1, J )
255  110             CONTINUE
256               END IF
257  120       CONTINUE
258         END IF
259      END IF
260      RETURN
261*
262*     End of ZLAPTM
263*
264      END
265