LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ chpr()

 subroutine chpr ( character uplo, integer n, real alpha, complex, dimension(*) x, integer incx, complex, dimension(*) ap )

CHPR

Purpose:
``` CHPR    performs the hermitian rank 1 operation

A := alpha*x*x**H + A,

where alpha is a real scalar, x is an n element vector 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 REAL 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,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.```
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 129 of file chpr.f.

130*
131* -- Reference BLAS level2 routine --
132* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
133* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134*
135* .. Scalar Arguments ..
136 REAL ALPHA
137 INTEGER INCX,N
138 CHARACTER UPLO
139* ..
140* .. Array Arguments ..
141 COMPLEX AP(*),X(*)
142* ..
143*
144* =====================================================================
145*
146* .. Parameters ..
147 COMPLEX ZERO
148 parameter(zero= (0.0e+0,0.0e+0))
149* ..
150* .. Local Scalars ..
151 COMPLEX TEMP
152 INTEGER I,INFO,IX,J,JX,K,KK,KX
153* ..
154* .. External Functions ..
155 LOGICAL LSAME
156 EXTERNAL lsame
157* ..
158* .. External Subroutines ..
159 EXTERNAL xerbla
160* ..
161* .. Intrinsic Functions ..
162 INTRINSIC conjg,real
163* ..
164*
165* Test the input parameters.
166*
167 info = 0
168 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
169 info = 1
170 ELSE IF (n.LT.0) THEN
171 info = 2
172 ELSE IF (incx.EQ.0) THEN
173 info = 5
174 END IF
175 IF (info.NE.0) THEN
176 CALL xerbla('CHPR ',info)
177 RETURN
178 END IF
179*
180* Quick return if possible.
181*
182 IF ((n.EQ.0) .OR. (alpha.EQ.real(zero))) RETURN
183*
184* Set the start point in X if the increment is not unity.
185*
186 IF (incx.LE.0) THEN
187 kx = 1 - (n-1)*incx
188 ELSE IF (incx.NE.1) THEN
189 kx = 1
190 END IF
191*
192* Start the operations. In this version the elements of the array AP
193* are accessed sequentially with one pass through AP.
194*
195 kk = 1
196 IF (lsame(uplo,'U')) THEN
197*
198* Form A when upper triangle is stored in AP.
199*
200 IF (incx.EQ.1) THEN
201 DO 20 j = 1,n
202 IF (x(j).NE.zero) THEN
203 temp = alpha*conjg(x(j))
204 k = kk
205 DO 10 i = 1,j - 1
206 ap(k) = ap(k) + x(i)*temp
207 k = k + 1
208 10 CONTINUE
209 ap(kk+j-1) = real(ap(kk+j-1)) + real(x(j)*temp)
210 ELSE
211 ap(kk+j-1) = real(ap(kk+j-1))
212 END IF
213 kk = kk + j
214 20 CONTINUE
215 ELSE
216 jx = kx
217 DO 40 j = 1,n
218 IF (x(jx).NE.zero) THEN
219 temp = alpha*conjg(x(jx))
220 ix = kx
221 DO 30 k = kk,kk + j - 2
222 ap(k) = ap(k) + x(ix)*temp
223 ix = ix + incx
224 30 CONTINUE
225 ap(kk+j-1) = real(ap(kk+j-1)) + real(x(jx)*temp)
226 ELSE
227 ap(kk+j-1) = real(ap(kk+j-1))
228 END IF
229 jx = jx + incx
230 kk = kk + j
231 40 CONTINUE
232 END IF
233 ELSE
234*
235* Form A when lower triangle is stored in AP.
236*
237 IF (incx.EQ.1) THEN
238 DO 60 j = 1,n
239 IF (x(j).NE.zero) THEN
240 temp = alpha*conjg(x(j))
241 ap(kk) = real(ap(kk)) + real(temp*x(j))
242 k = kk + 1
243 DO 50 i = j + 1,n
244 ap(k) = ap(k) + x(i)*temp
245 k = k + 1
246 50 CONTINUE
247 ELSE
248 ap(kk) = real(ap(kk))
249 END IF
250 kk = kk + n - j + 1
251 60 CONTINUE
252 ELSE
253 jx = kx
254 DO 80 j = 1,n
255 IF (x(jx).NE.zero) THEN
256 temp = alpha*conjg(x(jx))
257 ap(kk) = real(ap(kk)) + real(temp*x(jx))
258 ix = jx
259 DO 70 k = kk + 1,kk + n - j
260 ix = ix + incx
261 ap(k) = ap(k) + x(ix)*temp
262 70 CONTINUE
263 ELSE
264 ap(kk) = real(ap(kk))
265 END IF
266 jx = jx + incx
267 kk = kk + n - j + 1
268 80 CONTINUE
269 END IF
270 END IF
271*
272 RETURN
273*
274* End of CHPR
275*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: