131 SUBROUTINE zhpr(UPLO,N,ALPHA,X,INCX,AP)
139 DOUBLE PRECISION ALPHA
144 COMPLEX*16 AP(*),X(*)
151 parameter(zero= (0.0d+0,0.0d+0))
155 INTEGER I,INFO,IX,J,JX,K,KK,KX
165 INTRINSIC dble,dconjg
171 IF (.NOT.lsame(uplo,
'U') .AND. .NOT.lsame(uplo,
'L'))
THEN
173 ELSE IF (n.LT.0)
THEN
175 ELSE IF (incx.EQ.0)
THEN
185 IF ((n.EQ.0) .OR. (alpha.EQ.dble(zero)))
RETURN
191 ELSE IF (incx.NE.1)
THEN
199 IF (lsame(uplo,
'U'))
THEN
205 IF (x(j).NE.zero)
THEN
206 temp = alpha*dconjg(x(j))
209 ap(k) = ap(k) + x(i)*temp
212 ap(kk+j-1) = dble(ap(kk+j-1)) + dble(x(j)*temp)
214 ap(kk+j-1) = dble(ap(kk+j-1))
221 IF (x(jx).NE.zero)
THEN
222 temp = alpha*dconjg(x(jx))
224 DO 30 k = kk,kk + j - 2
225 ap(k) = ap(k) + x(ix)*temp
228 ap(kk+j-1) = dble(ap(kk+j-1)) + dble(x(jx)*temp)
230 ap(kk+j-1) = dble(ap(kk+j-1))
242 IF (x(j).NE.zero)
THEN
243 temp = alpha*dconjg(x(j))
244 ap(kk) = dble(ap(kk)) + dble(temp*x(j))
247 ap(k) = ap(k) + x(i)*temp
251 ap(kk) = dble(ap(kk))
258 IF (x(jx).NE.zero)
THEN
259 temp = alpha*dconjg(x(jx))
260 ap(kk) = dble(ap(kk)) + dble(temp*x(jx))
262 DO 70 k = kk + 1,kk + n - j
264 ap(k) = ap(k) + x(ix)*temp
267 ap(kk) = dble(ap(kk))
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhpr(UPLO, N, ALPHA, X, INCX, AP)
ZHPR