1      SUBROUTINE ZSYMVF(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
2*
3*  -- LAPACK auxiliary routine (version 3.1) --
4*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5*     November 2006
6*
7*     .. Scalar Arguments ..
8      CHARACTER          UPLO
9      INTEGER            INCX, INCY, LDA, N
10      COMPLEX*16         ALPHA, BETA
11*     ..
12*     .. Array Arguments ..
13      COMPLEX*16         A( LDA, * ), X( * ), Y( * )
14*     ..
15*
16*  Purpose
17*  =======
18*
19*  ZSYMV  performs the matrix-vector  operation
20*
21*     y := alpha*A*x + beta*y,
22*
23*  where alpha and beta are scalars, x and y are n element vectors and
24*  A is an n by n symmetric matrix.
25*
26*  Arguments
27*  ==========
28*
29*  UPLO     (input) CHARACTER*1
30*           On entry, UPLO specifies whether the upper or lower
31*           triangular part of the array A is to be referenced as
32*           follows:
33*
34*              UPLO = 'U' or 'u'   Only the upper triangular part of A
35*                                  is to be referenced.
36*
37*              UPLO = 'L' or 'l'   Only the lower triangular part of A
38*                                  is to be referenced.
39*
40*           Unchanged on exit.
41*
42*  N        (input) INTEGER
43*           On entry, N specifies the order of the matrix A.
44*           N must be at least zero.
45*           Unchanged on exit.
46*
47*  ALPHA    (input) COMPLEX*16
48*           On entry, ALPHA specifies the scalar alpha.
49*           Unchanged on exit.
50*
51*  A        (input) COMPLEX*16 array, dimension ( LDA, N )
52*           Before entry, with  UPLO = 'U' or 'u', the leading n by n
53*           upper triangular part of the array A must contain the upper
54*           triangular part of the symmetric matrix and the strictly
55*           lower triangular part of A is not referenced.
56*           Before entry, with UPLO = 'L' or 'l', the leading n by n
57*           lower triangular part of the array A must contain the lower
58*           triangular part of the symmetric matrix and the strictly
59*           upper triangular part of A is not referenced.
60*           Unchanged on exit.
61*
62*  LDA      (input) INTEGER
63*           On entry, LDA specifies the first dimension of A as declared
64*           in the calling (sub) program. LDA must be at least
65*           max( 1, N ).
66*           Unchanged on exit.
67*
68*  X        (input) COMPLEX*16 array, dimension at least
69*           ( 1 + ( N - 1 )*abs( INCX ) ).
70*           Before entry, the incremented array X must contain the N-
71*           element vector x.
72*           Unchanged on exit.
73*
74*  INCX     (input) INTEGER
75*           On entry, INCX specifies the increment for the elements of
76*           X. INCX must not be zero.
77*           Unchanged on exit.
78*
79*  BETA     (input) COMPLEX*16
80*           On entry, BETA specifies the scalar beta. When BETA is
81*           supplied as zero then Y need not be set on input.
82*           Unchanged on exit.
83*
84*  Y        (input/output) COMPLEX*16 array, dimension at least
85*           ( 1 + ( N - 1 )*abs( INCY ) ).
86*           Before entry, the incremented array Y must contain the n
87*           element vector y. On exit, Y is overwritten by the updated
88*           vector y.
89*
90*  INCY     (input) INTEGER
91*           On entry, INCY specifies the increment for the elements of
92*           Y. INCY must not be zero.
93*           Unchanged on exit.
94*
95* =====================================================================
96*
97*     .. Parameters ..
98      COMPLEX*16         ONE
99      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
100      COMPLEX*16         ZERO
101      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
102*     ..
103*     .. Local Scalars ..
104      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
105      COMPLEX*16         TEMP1, TEMP2
106*     ..
107*     .. External Functions ..
108      LOGICAL            LSAME
109      EXTERNAL           LSAME
110*     ..
111*     .. External Subroutines ..
112      EXTERNAL           XERBLA
113*     ..
114*     .. Intrinsic Functions ..
115      INTRINSIC          MAX
116*     ..
117*     .. Executable Statements ..
118*
119*     Test the input parameters.
120*
121      INFO = 0
122      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
123         INFO = 1
124      ELSE IF( N.LT.0 ) THEN
125         INFO = 2
126      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
127         INFO = 5
128      ELSE IF( INCX.EQ.0 ) THEN
129         INFO = 7
130      ELSE IF( INCY.EQ.0 ) THEN
131         INFO = 10
132      END IF
133      IF( INFO.NE.0 ) THEN
134         CALL XERBLA( 'ZSYMV ', INFO )
135         RETURN
136      END IF
137*
138*     Quick return if possible.
139*
140      IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
141     $   RETURN
142*
143*     Set up the start points in  X  and  Y.
144*
145      IF( INCX.GT.0 ) THEN
146         KX = 1
147      ELSE
148         KX = 1 - ( N-1 )*INCX
149      END IF
150      IF( INCY.GT.0 ) THEN
151         KY = 1
152      ELSE
153         KY = 1 - ( N-1 )*INCY
154      END IF
155*
156*     Start the operations. In this version the elements of A are
157*     accessed sequentially with one pass through the triangular part
158*     of A.
159*
160*     First form  y := beta*y.
161*
162      IF( BETA.NE.ONE ) THEN
163         IF( INCY.EQ.1 ) THEN
164            IF( BETA.EQ.ZERO ) THEN
165               DO 10 I = 1, N
166                  Y( I ) = ZERO
167   10          CONTINUE
168            ELSE
169               DO 20 I = 1, N
170                  Y( I ) = BETA*Y( I )
171   20          CONTINUE
172            END IF
173         ELSE
174            IY = KY
175            IF( BETA.EQ.ZERO ) THEN
176               DO 30 I = 1, N
177                  Y( IY ) = ZERO
178                  IY = IY + INCY
179   30          CONTINUE
180            ELSE
181               DO 40 I = 1, N
182                  Y( IY ) = BETA*Y( IY )
183                  IY = IY + INCY
184   40          CONTINUE
185            END IF
186         END IF
187      END IF
188      IF( ALPHA.EQ.ZERO )
189     $   RETURN
190      IF( LSAME( UPLO, 'U' ) ) THEN
191*
192*        Form  y  when A is stored in upper triangle.
193*
194         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
195            DO 60 J = 1, N
196               TEMP1 = ALPHA*X( J )
197               TEMP2 = ZERO
198               DO 50 I = 1, J - 1
199                  Y( I ) = Y( I ) + TEMP1*A( I, J )
200                  TEMP2 = TEMP2 + A( I, J )*X( I )
201   50          CONTINUE
202               Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2
203   60       CONTINUE
204         ELSE
205            JX = KX
206            JY = KY
207            DO 80 J = 1, N
208               TEMP1 = ALPHA*X( JX )
209               TEMP2 = ZERO
210               IX = KX
211               IY = KY
212               DO 70 I = 1, J - 1
213                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
214                  TEMP2 = TEMP2 + A( I, J )*X( IX )
215                  IX = IX + INCX
216                  IY = IY + INCY
217   70          CONTINUE
218               Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2
219               JX = JX + INCX
220               JY = JY + INCY
221   80       CONTINUE
222         END IF
223      ELSE
224*
225*        Form  y  when A is stored in lower triangle.
226*
227         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
228            DO 100 J = 1, N
229               TEMP1 = ALPHA*X( J )
230               TEMP2 = ZERO
231               Y( J ) = Y( J ) + TEMP1*A( J, J )
232               DO 90 I = J + 1, N
233                  Y( I ) = Y( I ) + TEMP1*A( I, J )
234                  TEMP2 = TEMP2 + A( I, J )*X( I )
235   90          CONTINUE
236               Y( J ) = Y( J ) + ALPHA*TEMP2
237  100       CONTINUE
238         ELSE
239            JX = KX
240            JY = KY
241            DO 120 J = 1, N
242               TEMP1 = ALPHA*X( JX )
243               TEMP2 = ZERO
244               Y( JY ) = Y( JY ) + TEMP1*A( J, J )
245               IX = JX
246               IY = JY
247               DO 110 I = J + 1, N
248                  IX = IX + INCX
249                  IY = IY + INCY
250                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
251                  TEMP2 = TEMP2 + A( I, J )*X( IX )
252  110          CONTINUE
253               Y( JY ) = Y( JY ) + ALPHA*TEMP2
254               JX = JX + INCX
255               JY = JY + INCY
256  120       CONTINUE
257         END IF
258      END IF
259*
260      RETURN
261*
262*     End of ZSYMV
263*
264      END
265