LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zher ( character  UPLO,
integer  N,
double precision  ALPHA,
complex*16, dimension(*)  X,
integer  INCX,
complex*16, dimension(lda,*)  A,
integer  LDA 
)

ZHER

Purpose: 
 ZHER   performs the hermitian rank 1 operation

    A := alpha*x*x**H + A,

 where alpha is a real scalar, x is an n element vector and A is an
 n by n hermitian matrix.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the upper or lower
           triangular part of the array A is to be referenced as
           follows:

              UPLO = 'U' or 'u'   Only the upper triangular part of A
                                  is to be referenced.

              UPLO = 'L' or 'l'   Only the lower triangular part of A
                                  is to be referenced.
[in]N
          N is INTEGER
           On entry, N specifies the order of the matrix A.
           N must be at least zero.
[in]ALPHA
          ALPHA is DOUBLE PRECISION.
           On entry, ALPHA specifies the scalar alpha.
[in]X
          X is COMPLEX*16 array of dimension at least
           ( 1 + ( n - 1 )*abs( INCX ) ).
           Before entry, the incremented array X must contain the n
           element vector x.
[in]INCX
          INCX is INTEGER
           On entry, INCX specifies the increment for the elements of
           X. INCX must not be zero.
[in,out]A
          A is COMPLEX*16 array of DIMENSION ( LDA, n ).
           Before entry with  UPLO = 'U' or 'u', the leading n by n
           upper triangular part of the array A must contain the upper
           triangular part of the hermitian matrix and the strictly
           lower triangular part of A is not referenced. On exit, the
           upper triangular part of the array A is overwritten by the
           upper triangular part of the updated matrix.
           Before entry with UPLO = 'L' or 'l', the leading n by n
           lower triangular part of the array A must contain the lower
           triangular part of the hermitian matrix and the strictly
           upper triangular part of A is not referenced. On exit, the
           lower triangular part of the array A is overwritten by the
           lower triangular part of the updated matrix.
           Note that the imaginary parts of the diagonal elements need
           not be set, they are assumed to be zero, and on exit they
           are set to zero.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the calling (sub) program. LDA must be at least
           max( 1, n ).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
Further Details: 
  Level 2 Blas routine.

  -- Written on 22-October-1986.
     Jack Dongarra, Argonne National Lab.
     Jeremy Du Croz, Nag Central Office.
     Sven Hammarling, Nag Central Office.
     Richard Hanson, Sandia National Labs.

Definition at line 137 of file zher.f.

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 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: