LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cher2 ( character  UPLO,
integer  N,
complex  ALPHA,
complex, dimension(*)  X,
integer  INCX,
complex, dimension(*)  Y,
integer  INCY,
complex, dimension(lda,*)  A,
integer  LDA 
)

CHER2

Purpose: 
 CHER2  performs the hermitian rank 2 operation

    A := alpha*x*y**H + conjg( alpha )*y*x**H + A,

 where alpha is a scalar, x and y are n element vectors 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 COMPLEX
           On entry, ALPHA specifies the scalar alpha.
[in]X
          X is COMPLEX 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]Y
          Y is COMPLEX array of dimension at least
           ( 1 + ( n - 1 )*abs( INCY ) ).
           Before entry, the incremented array Y must contain the n
           element vector y.
[in]INCY
          INCY is INTEGER
           On entry, INCY specifies the increment for the elements of
           Y. INCY must not be zero.
[in,out]A
          A is COMPLEX 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 152 of file cher2.f.

152 *
153 * -- Reference BLAS level2 routine (version 3.4.0) --
154 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156 * November 2011
157 *
158 * .. Scalar Arguments ..
159  COMPLEX alpha
160  INTEGER incx,incy,lda,n
161  CHARACTER uplo
162 * ..
163 * .. Array Arguments ..
164  COMPLEX a(lda,*),x(*),y(*)
165 * ..
166 *
167 * =====================================================================
168 *
169 * .. Parameters ..
170  COMPLEX zero
171  parameter(zero= (0.0e+0,0.0e+0))
172 * ..
173 * .. Local Scalars ..
174  COMPLEX temp1,temp2
175  INTEGER i,info,ix,iy,j,jx,jy,kx,ky
176 * ..
177 * .. External Functions ..
178  LOGICAL lsame
179  EXTERNAL lsame
180 * ..
181 * .. External Subroutines ..
182  EXTERNAL xerbla
183 * ..
184 * .. Intrinsic Functions ..
185  INTRINSIC conjg,max,real
186 * ..
187 *
188 * Test the input parameters.
189 *
190  info = 0
191  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
192  info = 1
193  ELSE IF (n.LT.0) THEN
194  info = 2
195  ELSE IF (incx.EQ.0) THEN
196  info = 5
197  ELSE IF (incy.EQ.0) THEN
198  info = 7
199  ELSE IF (lda.LT.max(1,n)) THEN
200  info = 9
201  END IF
202  IF (info.NE.0) THEN
203  CALL xerbla('CHER2 ',info)
204  RETURN
205  END IF
206 *
207 * Quick return if possible.
208 *
209  IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
210 *
211 * Set up the start points in X and Y if the increments are not both
212 * unity.
213 *
214  IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
215  IF (incx.GT.0) THEN
216  kx = 1
217  ELSE
218  kx = 1 - (n-1)*incx
219  END IF
220  IF (incy.GT.0) THEN
221  ky = 1
222  ELSE
223  ky = 1 - (n-1)*incy
224  END IF
225  jx = kx
226  jy = ky
227  END IF
228 *
229 * Start the operations. In this version the elements of A are
230 * accessed sequentially with one pass through the triangular part
231 * of A.
232 *
233  IF (lsame(uplo,'U')) THEN
234 *
235 * Form A when A is stored in the upper triangle.
236 *
237  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
238  DO 20 j = 1,n
239  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
240  temp1 = alpha*conjg(y(j))
241  temp2 = conjg(alpha*x(j))
242  DO 10 i = 1,j - 1
243  a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
244  10 CONTINUE
245  a(j,j) = REAL(A(J,J)) +
246  + REAL(x(j)*temp1+y(j)*temp2)
247  ELSE
248  a(j,j) = REAL(a(j,j))
249  END IF
250  20 CONTINUE
251  ELSE
252  DO 40 j = 1,n
253  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
254  temp1 = alpha*conjg(y(jy))
255  temp2 = conjg(alpha*x(jx))
256  ix = kx
257  iy = ky
258  DO 30 i = 1,j - 1
259  a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
260  ix = ix + incx
261  iy = iy + incy
262  30 CONTINUE
263  a(j,j) = REAL(A(J,J)) +
264  + REAL(x(jx)*temp1+y(jy)*temp2)
265  ELSE
266  a(j,j) = REAL(a(j,j))
267  END IF
268  jx = jx + incx
269  jy = jy + incy
270  40 CONTINUE
271  END IF
272  ELSE
273 *
274 * Form A when A is stored in the lower triangle.
275 *
276  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
277  DO 60 j = 1,n
278  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
279  temp1 = alpha*conjg(y(j))
280  temp2 = conjg(alpha*x(j))
281  a(j,j) = REAL(A(J,J)) +
282  + REAL(x(j)*temp1+y(j)*temp2)
283  DO 50 i = j + 1,n
284  a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
285  50 CONTINUE
286  ELSE
287  a(j,j) = REAL(a(j,j))
288  END IF
289  60 CONTINUE
290  ELSE
291  DO 80 j = 1,n
292  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
293  temp1 = alpha*conjg(y(jy))
294  temp2 = conjg(alpha*x(jx))
295  a(j,j) = REAL(A(J,J)) +
296  + REAL(x(jx)*temp1+y(jy)*temp2)
297  ix = jx
298  iy = jy
299  DO 70 i = j + 1,n
300  ix = ix + incx
301  iy = iy + incy
302  a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
303  70 CONTINUE
304  ELSE
305  a(j,j) = REAL(a(j,j))
306  END IF
307  jx = jx + incx
308  jy = jy + incy
309  80 CONTINUE
310  END IF
311  END IF
312 *
313  RETURN
314 *
315 * End of CHER2 .
316 *
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: