LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ chpr2()

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, 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]AP
          AP is COMPLEX array, 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.
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 144 of file chpr2.f.

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