LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cher2()

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, 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, 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, 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.
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 149 of file cher2.f.

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