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

◆ 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)
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: