1*> \brief \b ZHER
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 ZHER(UPLO,N,ALPHA,X,INCX,A,LDA)
12*
13*       .. Scalar Arguments ..
14*       DOUBLE PRECISION ALPHA
15*       INTEGER INCX,LDA,N
16*       CHARACTER UPLO
17*       ..
18*       .. Array Arguments ..
19*       COMPLEX*16 A(LDA,*),X(*)
20*       ..
21*
22*
23*> \par Purpose:
24*  =============
25*>
26*> \verbatim
27*>
28*> ZHER   performs the hermitian rank 1 operation
29*>
30*>    A := alpha*x*x**H + A,
31*>
32*> where alpha is a real scalar, x is an n element vector and A is an
33*> n by n hermitian matrix.
34*> \endverbatim
35*
36*  Arguments:
37*  ==========
38*
39*> \param[in] UPLO
40*> \verbatim
41*>          UPLO is CHARACTER*1
42*>           On entry, UPLO specifies whether the upper or lower
43*>           triangular part of the array A is to be referenced as
44*>           follows:
45*>
46*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
47*>                                  is to be referenced.
48*>
49*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
50*>                                  is to be referenced.
51*> \endverbatim
52*>
53*> \param[in] N
54*> \verbatim
55*>          N is INTEGER
56*>           On entry, N specifies the order of the matrix A.
57*>           N must be at least zero.
58*> \endverbatim
59*>
60*> \param[in] ALPHA
61*> \verbatim
62*>          ALPHA is DOUBLE PRECISION.
63*>           On entry, ALPHA specifies the scalar alpha.
64*> \endverbatim
65*>
66*> \param[in] X
67*> \verbatim
68*>          X is COMPLEX*16 array of 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*> \endverbatim
73*>
74*> \param[in] INCX
75*> \verbatim
76*>          INCX is INTEGER
77*>           On entry, INCX specifies the increment for the elements of
78*>           X. INCX must not be zero.
79*> \endverbatim
80*>
81*> \param[in,out] A
82*> \verbatim
83*>          A is COMPLEX*16 array of DIMENSION ( LDA, n ).
84*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
85*>           upper triangular part of the array A must contain the upper
86*>           triangular part of the hermitian matrix and the strictly
87*>           lower triangular part of A is not referenced. On exit, the
88*>           upper triangular part of the array A is overwritten by the
89*>           upper triangular part of the updated matrix.
90*>           Before entry with UPLO = 'L' or 'l', the leading n by n
91*>           lower triangular part of the array A must contain the lower
92*>           triangular part of the hermitian matrix and the strictly
93*>           upper triangular part of A is not referenced. On exit, the
94*>           lower triangular part of the array A is overwritten by the
95*>           lower triangular part of the updated matrix.
96*>           Note that the imaginary parts of the diagonal elements need
97*>           not be set, they are assumed to be zero, and on exit they
98*>           are set to zero.
99*> \endverbatim
100*>
101*> \param[in] LDA
102*> \verbatim
103*>          LDA is INTEGER
104*>           On entry, LDA specifies the first dimension of A as declared
105*>           in the calling (sub) program. LDA must be at least
106*>           max( 1, n ).
107*> \endverbatim
108*
109*  Authors:
110*  ========
111*
112*> \author Univ. of Tennessee
113*> \author Univ. of California Berkeley
114*> \author Univ. of Colorado Denver
115*> \author NAG Ltd.
116*
117*> \date November 2011
118*
119*> \ingroup complex16_blas_level2
120*
121*> \par Further Details:
122*  =====================
123*>
124*> \verbatim
125*>
126*>  Level 2 Blas routine.
127*>
128*>  -- Written on 22-October-1986.
129*>     Jack Dongarra, Argonne National Lab.
130*>     Jeremy Du Croz, Nag Central Office.
131*>     Sven Hammarling, Nag Central Office.
132*>     Richard Hanson, Sandia National Labs.
133*> \endverbatim
134*>
135*  =====================================================================
136      SUBROUTINE ZHER(UPLO,N,ALPHA,X,INCX,A,LDA)
137*
138*  -- Reference BLAS level2 routine (version 3.4.0) --
139*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
140*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
141*     November 2011
142*
143*     .. Scalar Arguments ..
144      DOUBLE PRECISION ALPHA
145      INTEGER INCX,LDA,N
146      CHARACTER UPLO
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      COMPLEX*16 TEMP
160      INTEGER I,INFO,IX,J,JX,KX
161*     ..
162*     .. External Functions ..
163      LOGICAL LSAME
164      EXTERNAL LSAME
165*     ..
166*     .. External Subroutines ..
167      EXTERNAL XERBLA
168*     ..
169*     .. Intrinsic Functions ..
170      INTRINSIC DBLE,DCONJG,MAX
171*     ..
172*
173*     Test the input parameters.
174*
175      INFO = 0
176      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
177          INFO = 1
178      ELSE IF (N.LT.0) THEN
179          INFO = 2
180      ELSE IF (INCX.EQ.0) THEN
181          INFO = 5
182      ELSE IF (LDA.LT.MAX(1,N)) THEN
183          INFO = 7
184      END IF
185      IF (INFO.NE.0) THEN
186          CALL XERBLA('ZHER  ',INFO)
187          RETURN
188      END IF
189*
190*     Quick return if possible.
191*
192      IF ((N.EQ.0) .OR. (ALPHA.EQ.DBLE(ZERO))) RETURN
193*
194*     Set the start point in X if the increment is not unity.
195*
196      IF (INCX.LE.0) THEN
197          KX = 1 - (N-1)*INCX
198      ELSE IF (INCX.NE.1) THEN
199          KX = 1
200      END IF
201*
202*     Start the operations. In this version the elements of A are
203*     accessed sequentially with one pass through the triangular part
204*     of A.
205*
206      IF (LSAME(UPLO,'U')) THEN
207*
208*        Form  A  when A is stored in upper triangle.
209*
210          IF (INCX.EQ.1) THEN
211              DO 20 J = 1,N
212                  IF (X(J).NE.ZERO) THEN
213                      TEMP = ALPHA*DCONJG(X(J))
214                      DO 10 I = 1,J - 1
215                          A(I,J) = A(I,J) + X(I)*TEMP
216   10                 CONTINUE
217                      A(J,J) = DBLE(A(J,J)) + DBLE(X(J)*TEMP)
218                  ELSE
219                      A(J,J) = DBLE(A(J,J))
220                  END IF
221   20         CONTINUE
222          ELSE
223              JX = KX
224              DO 40 J = 1,N
225                  IF (X(JX).NE.ZERO) THEN
226                      TEMP = ALPHA*DCONJG(X(JX))
227                      IX = KX
228                      DO 30 I = 1,J - 1
229                          A(I,J) = A(I,J) + X(IX)*TEMP
230                          IX = IX + INCX
231   30                 CONTINUE
232                      A(J,J) = DBLE(A(J,J)) + DBLE(X(JX)*TEMP)
233                  ELSE
234                      A(J,J) = DBLE(A(J,J))
235                  END IF
236                  JX = JX + INCX
237   40         CONTINUE
238          END IF
239      ELSE
240*
241*        Form  A  when A is stored in lower triangle.
242*
243          IF (INCX.EQ.1) THEN
244              DO 60 J = 1,N
245                  IF (X(J).NE.ZERO) THEN
246                      TEMP = ALPHA*DCONJG(X(J))
247                      A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(J))
248                      DO 50 I = J + 1,N
249                          A(I,J) = A(I,J) + X(I)*TEMP
250   50                 CONTINUE
251                  ELSE
252                      A(J,J) = DBLE(A(J,J))
253                  END IF
254   60         CONTINUE
255          ELSE
256              JX = KX
257              DO 80 J = 1,N
258                  IF (X(JX).NE.ZERO) THEN
259                      TEMP = ALPHA*DCONJG(X(JX))
260                      A(J,J) = DBLE(A(J,J)) + DBLE(TEMP*X(JX))
261                      IX = JX
262                      DO 70 I = J + 1,N
263                          IX = IX + INCX
264                          A(I,J) = A(I,J) + X(IX)*TEMP
265   70                 CONTINUE
266                  ELSE
267                      A(J,J) = DBLE(A(J,J))
268                  END IF
269                  JX = JX + INCX
270   80         CONTINUE
271          END IF
272      END IF
273*
274      RETURN
275*
276*     End of ZHER  .
277*
278      END
279c $Id$
280