dsyr2(3f) - [BLAS:DOUBLE_BLAS_LEVEL2]
subroutine dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda)
.. Scalar Arguments ..
double precision,intent(in) :: alpha
integer,intent(in) :: incx,incy,lda,n
character,intent(in) :: uplo
..
.. Array Arguments ..
double precision,intent(inout) :: a(lda,*)
double precision,intent(in) :: x(*),y(*)
..
DSYR2 performs the symmetric rank 2 operation
A := alpha*x*y**T + alpha*y*x**T + A,
where alpha is a scalar, x and y are n element vectors and A is an n by n symmetric matrix.
UPLO
UPLO is CHARACTER*1
On entry, UPLO specifies whether the upper or lower
triangular part of the array A is to be referenced as
follows:
UPLO = 'U' or 'u' Only the upper triangular part of A
is to be referenced.
UPLO = 'L' or 'l' Only the lower triangular part of A
is to be referenced.
N
N is INTEGER
On entry, N specifies the order of the matrix A.
N must be at least zero.
ALPHA
ALPHA is DOUBLE PRECISION.
On entry, ALPHA specifies the scalar alpha.
X
X is DOUBLE PRECISION array, dimension at least
( 1 + ( n - 1 )*abs( INCX ) ).
Before entry, the incremented array X must contain the n
element vector x.
INCX
INCX is INTEGER
On entry, INCX specifies the increment for the elements of
X. INCX must not be zero.
Y
Y is DOUBLE PRECISION array, dimension at least
( 1 + ( n - 1 )*abs( INCY ) ).
Before entry, the incremented array Y must contain the n
element vector y.
INCY
INCY is INTEGER
On entry, INCY specifies the increment for the elements of
Y. INCY must not be zero.
A
A is DOUBLE PRECISION array, dimension ( LDA, N )
Before entry with UPLO = 'U' or 'u', the leading n by n
upper triangular part of the array A must contain the upper
triangular part of the symmetric matrix and the strictly
lower triangular part of A is not referenced. On exit, the
upper triangular part of the array A is overwritten by the
upper triangular part of the updated matrix.
Before entry with UPLO = 'L' or 'l', the leading n by n
lower triangular part of the array A must contain the lower
triangular part of the symmetric matrix and the strictly
upper triangular part of A is not referenced. On exit, the
lower triangular part of the array A is overwritten by the
lower triangular part of the updated matrix.
LDA
LDA is INTEGER
On entry, LDA specifies the first dimension of A as declared
in the calling (sub) program. LDA must be at least
max( 1, n ).
date:December 2016
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.
Online html documentation available at
http://www.netlib.org/lapack/explore-html/
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=1), | intent(in) | :: | uplo | |||
| integer, | intent(in) | :: | n | |||
| double precision, | intent(in) | :: | alpha | |||
| double precision, | intent(in) | :: | x(*) | |||
| integer, | intent(in) | :: | incx | |||
| double precision, | intent(in) | :: | y(*) | |||
| integer, | intent(in) | :: | incy | |||
| double precision, | intent(inout) | :: | a(lda,*) | |||
| integer, | intent(in) | :: | lda |
| Type | Visibility | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|---|
| integer, | public | :: | i | ||||
| integer, | public | :: | info | ||||
| integer, | public | :: | ix | ||||
| integer, | public | :: | iy | ||||
| integer, | public | :: | j | ||||
| integer, | public | :: | jx | ||||
| integer, | public | :: | jy | ||||
| integer, | public | :: | kx | ||||
| integer, | public | :: | ky | ||||
| double precision, | public | :: | temp1 | ||||
| double precision, | public | :: | temp2 | ||||
| double precision, | public, | parameter | :: | zero | = | 0.0d+0 |
subroutine dsyr2(uplo,n,alpha,x,incx,y,incy,a,lda)
implicit none
!
! -- Reference BLAS level2 routine (version 3.7.0) --
! -- Reference BLAS is a software package provided by Univ. of Tennessee, --
! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! December 2016
!
! .. Scalar Arguments ..
double precision,intent(in) :: alpha
integer,intent(in) :: incx,incy,lda,n
character,intent(in) :: uplo
! ..
! .. Array Arguments ..
double precision,intent(inout) :: a(lda,*)
double precision,intent(in) :: x(*),y(*)
! ..
!
! =====================================================================
!
! .. Parameters ..
double precision zero
parameter (zero=0.0d+0)
! ..
! .. Local Scalars ..
double precision temp1,temp2
integer i,info,ix,iy,j,jx,jy,kx,ky
! ..
! .. External Functions ..
! ..
! .. External Subroutines ..
! ..
! .. Intrinsic Functions ..
intrinsic max
! ..
!
! Test the input parameters.
!
info = 0
if (.not.lsame(uplo,'U') .and. .not.lsame(uplo,'L')) then
info = 1
elseif (n.lt.0) then
info = 2
elseif (incx.eq.0) then
info = 5
elseif (incy.eq.0) then
info = 7
elseif (lda.lt.max(1,n)) then
info = 9
endif
if (info.ne.0) then
call xerbla('DSYR2 ',info)
return
endif
!
! Quick return if possible.
!
if ((n.eq.0) .or. (alpha.eq.zero)) return
!
! Set up the start points in X and Y if the increments are not both
! unity.
!
if ((incx.ne.1) .or. (incy.ne.1)) then
if (incx.gt.0) then
kx = 1
else
kx = 1 - (n-1)*incx
endif
if (incy.gt.0) then
ky = 1
else
ky = 1 - (n-1)*incy
endif
jx = kx
jy = ky
endif
!
! Start the operations. In this version the elements of A are
! accessed sequentially with one pass through the triangular part
! of A.
!
if (lsame(uplo,'U')) then
!
! Form A when A is stored in the upper triangle.
!
if ((incx.eq.1) .and. (incy.eq.1)) then
do j = 1,n
if ((x(j).ne.zero) .or. (y(j).ne.zero)) then
temp1 = alpha*y(j)
temp2 = alpha*x(j)
do i = 1,j
a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
enddo
endif
enddo
else
do j = 1,n
if ((x(jx).ne.zero) .or. (y(jy).ne.zero)) then
temp1 = alpha*y(jy)
temp2 = alpha*x(jx)
ix = kx
iy = ky
do i = 1,j
a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
ix = ix + incx
iy = iy + incy
enddo
endif
jx = jx + incx
jy = jy + incy
enddo
endif
else
!
! Form A when A is stored in the lower triangle.
!
if ((incx.eq.1) .and. (incy.eq.1)) then
do j = 1,n
if ((x(j).ne.zero) .or. (y(j).ne.zero)) then
temp1 = alpha*y(j)
temp2 = alpha*x(j)
do i = j,n
a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
enddo
endif
enddo
else
do j = 1,n
if ((x(jx).ne.zero) .or. (y(jy).ne.zero)) then
temp1 = alpha*y(jy)
temp2 = alpha*x(jx)
ix = jx
iy = jy
do i = j,n
a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
ix = ix + incx
iy = iy + incy
enddo
endif
jx = jx + incx
jy = jy + incy
enddo
endif
endif
!
end subroutine dsyr2