146 SUBROUTINE zhpr2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
159 COMPLEX*16 AP(*),X(*),Y(*)
166 parameter(zero= (0.0d+0,0.0d+0))
169 COMPLEX*16 TEMP1,TEMP2
170 INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
180 INTRINSIC dble,dconjg
186 IF (.NOT.lsame(uplo,
'U') .AND. .NOT.lsame(uplo,
'L'))
THEN
188 ELSE IF (n.LT.0)
THEN
190 ELSE IF (incx.EQ.0)
THEN
192 ELSE IF (incy.EQ.0)
THEN
196 CALL xerbla(
'ZHPR2 ',info)
202 IF ((n.EQ.0) .OR. (alpha.EQ.zero))
RETURN
207 IF ((incx.NE.1) .OR. (incy.NE.1))
THEN
226 IF (lsame(uplo,
'U'))
THEN
230 IF ((incx.EQ.1) .AND. (incy.EQ.1))
THEN
232 IF ((x(j).NE.zero) .OR. (y(j).NE.zero))
THEN
233 temp1 = alpha*dconjg(y(j))
234 temp2 = dconjg(alpha*x(j))
237 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
240 ap(kk+j-1) = dble(ap(kk+j-1)) +
241 + dble(x(j)*temp1+y(j)*temp2)
243 ap(kk+j-1) = dble(ap(kk+j-1))
249 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero))
THEN
250 temp1 = alpha*dconjg(y(jy))
251 temp2 = dconjg(alpha*x(jx))
254 DO 30 k = kk,kk + j - 2
255 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
259 ap(kk+j-1) = dble(ap(kk+j-1)) +
260 + dble(x(jx)*temp1+y(jy)*temp2)
262 ap(kk+j-1) = dble(ap(kk+j-1))
273 IF ((incx.EQ.1) .AND. (incy.EQ.1))
THEN
275 IF ((x(j).NE.zero) .OR. (y(j).NE.zero))
THEN
276 temp1 = alpha*dconjg(y(j))
277 temp2 = dconjg(alpha*x(j))
278 ap(kk) = dble(ap(kk)) +
279 + dble(x(j)*temp1+y(j)*temp2)
282 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
286 ap(kk) = dble(ap(kk))
292 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero))
THEN
293 temp1 = alpha*dconjg(y(jy))
294 temp2 = dconjg(alpha*x(jx))
295 ap(kk) = dble(ap(kk)) +
296 + dble(x(jx)*temp1+y(jy)*temp2)
299 DO 70 k = kk + 1,kk + n - j
302 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
305 ap(kk) = dble(ap(kk))
subroutine zhpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
ZHPR2
subroutine xerbla(SRNAME, INFO)
XERBLA