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