LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine chpr2 ( character  UPLO,
integer  N,
complex  ALPHA,
complex, dimension(*)  X,
integer  INCX,
complex, dimension(*)  Y,
integer  INCY,
complex, dimension(*)  AP 
)

CHPR2

Purpose: 
 CHPR2  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, supplied in packed form.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the upper or lower
           triangular part of the matrix A is supplied in the packed
           array AP as follows:

              UPLO = 'U' or 'u'   The upper triangular part of A is
                                  supplied in AP.

              UPLO = 'L' or 'l'   The lower triangular part of A is
                                  supplied in AP.
[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]AP
          AP is COMPLEX array of DIMENSION at least
           ( ( n*( n + 1 ) )/2 ).
           Before entry with  UPLO = 'U' or 'u', the array AP must
           contain the upper triangular part of the hermitian matrix
           packed sequentially, column by column, so that AP( 1 )
           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
           and a( 2, 2 ) respectively, and so on. On exit, the array
           AP is overwritten by the upper triangular part of the
           updated matrix.
           Before entry with UPLO = 'L' or 'l', the array AP must
           contain the lower triangular part of the hermitian matrix
           packed sequentially, column by column, so that AP( 1 )
           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
           and a( 3, 1 ) respectively, and so on. On exit, the array
           AP 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.
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 147 of file chpr2.f.

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