| [uplo,n,alpha,x,incx,y,incy,a,lda]=cher2(uplo,n,alpha,x,incx,y,incy,a,lda); |
function [uplo,n,alpha,x,incx,y,incy,a,lda]=cher2(uplo,n,alpha,x,incx,y,incy,a,lda);
%***BEGIN PROLOGUE CHER2
%***PURPOSE Perform Hermitian rank 2 update of a complex Hermitian
% matrix.
%***LIBRARY SLATEC (BLAS)
%***CATEGORY D1B4
%***TYPE COMPLEX (SHER2-S, DHER2-D, CHER2-C)
%***KEYWORDS LEVEL 2 BLAS, LINEAR ALGEBRA
%***AUTHOR Dongarra, J. J., (ANL)
% Du Croz, J., (NAG)
% Hammarling, S., (NAG)
% Hanson, R. J., (SNLA)
%***DESCRIPTION
%
% CHER2 performs the hermitian rank 2 operation
%
% A := alpha*x*conjg( y') + conjg( alpha)*y*conjg( x') + A,
%
% where alpha is a scalar, x and y are n element vectors and A is an n
% by n hermitian matrix.
%
% Parameters
% ==========
%
% UPLO - 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.
%
% Unchanged on exit.
%
% N - INTEGER.
% On entry, N specifies the order of the matrix A.
% N must be at least zero.
% Unchanged on exit.
%
% ALPHA - COMPLEX .
% On entry, ALPHA specifies the scalar alpha.
% Unchanged on exit.
%
% X - COMPLEX array of dimension at least
% ( 1 + ( n - 1 )*abs( INCX ) ).
% Before entry, the incremented array X must contain the n
% element vector x.
% Unchanged on exit.
%
% INCX - INTEGER.
% On entry, INCX specifies the increment for the elements of
% X. INCX must not be zero.
% Unchanged on exit.
%
% Y - COMPLEX array of dimension at least
% ( 1 + ( n - 1 )*abs( INCY ) ).
% Before entry, the incremented array Y must contain the n
% element vector y.
% Unchanged on exit.
%
% INCY - INTEGER.
% On entry, INCY specifies the increment for the elements of
% Y. INCY must not be zero.
% Unchanged on exit.
%
% A - COMPLEX array of 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 hermitian 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 hermitian 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.
% 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.
%
% LDA - 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 ).
% Unchanged on exit.
%
%***REFERENCES Dongarra, J. J., Du Croz, J., Hammarling, S., and
% Hanson, R. J. An extended set of Fortran basic linear
% algebra subprograms. ACM TOMS, Vol. 14, No. 1,
% pp. 1-17, March 1988.
%***ROUTINES CALLED LSAME, XERBLA
%***REVISION HISTORY (YYMMDD)
% 861022 DATE WRITTEN
% 910605 Modified to meet SLATEC prologue standards. Only comment
% lines were modified. (BKS)
%***end PROLOGUE CHER2
% .. Scalar Arguments ..
% .. Array Arguments ..
persistent i info ix iy j jx jy kx ky temp1 temp2 zero ;
a_shape=size(a);a=reshape([a(:).',zeros(1,ceil(numel(a)./prod([lda])).*prod([lda])-numel(a))],lda,[]);
x_shape=size(x);x=reshape(x,1,[]);
y_shape=size(y);y=reshape(y,1,[]);
% .. Parameters ..
if isempty(zero), zero=complex(0.0e+0,0.0e+0) ; end;
% .. Local Scalars ..
if isempty(temp1), temp1=0; end;
if isempty(temp2), temp2=0; end;
if isempty(i), i=0; end;
if isempty(info), info=0; end;
if isempty(ix), ix=0; end;
if isempty(iy), iy=0; end;
if isempty(j), j=0; end;
if isempty(jx), jx=0; end;
if isempty(jy), jy=0; end;
if isempty(kx), kx=0; end;
if isempty(ky), ky=0; end;
% .. External Functions ..
% .. External Subroutines ..
% .. Intrinsic Functions ..
% intrinsic conjg , max , real ::;
%***FIRST EXECUTABLE STATEMENT CHER2
%
% Test the input parameters.
%
info = 0;
if( ~lsame(uplo,'U') && ~lsame(uplo,'L') )
info = 1;
elseif( n<0 ) ;
info = 2;
elseif( incx==0 ) ;
info = 5;
elseif( incy==0 ) ;
info = 7;
elseif( lda<max(1,n) ) ;
info = 9;
end;
if( info~=0 )
[dumvar1,info]=xerbla('CHER2 ',info);
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
x_shape=zeros(x_shape);x_shape(:)=x(1:numel(x_shape));x=x_shape;
y_shape=zeros(y_shape);y_shape(:)=y(1:numel(y_shape));y=y_shape;
return;
end;
%
% Quick return if possible.
%
if((n==0) ||(alpha==zero) )
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
x_shape=zeros(x_shape);x_shape(:)=x(1:numel(x_shape));x=x_shape;
y_shape=zeros(y_shape);y_shape(:)=y(1:numel(y_shape));y=y_shape;
return;
end;
%
% Set up the start points in X and Y if the increments are not both
% unity.
%
if((incx~=1) ||(incy~=1) )
if( incx>0 )
kx = 1;
else;
kx = fix(1 -(n-1).*incx);
end;
if( incy>0 )
ky = 1;
else;
ky = fix(1 -(n-1).*incy);
end;
jx = fix(kx);
jy = fix(ky);
end;
%
% 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') )
%
% Form A when A is stored in the upper triangle.
%
if((incx==1) &&(incy==1) )
for j = 1 : n;
if((x(j)~=zero) ||(y(j)~=zero) )
temp1 = alpha.*conj(y(j));
temp2 = conj(alpha.*x(j));
for i = 1 : j - 1;
a(i,j) = a(i,j) + x(i).*temp1 + y(i).*temp2;
end; i = fix(j - 1+1);
a(j,j) = real(a(j,j)) + real(x(j).*temp1+y(j).*temp2);
else;
a(j,j) = real(a(j,j));
end;
end; j = fix(n+1);
else;
for j = 1 : n;
if((x(jx)~=zero) ||(y(jy)~=zero) )
temp1 = alpha.*conj(y(jy));
temp2 = conj(alpha.*x(jx));
ix = fix(kx);
iy = fix(ky);
for i = 1 : j - 1;
a(i,j) = a(i,j) + x(ix).*temp1 + y(iy).*temp2;
ix = fix(ix + incx);
iy = fix(iy + incy);
end; i = fix(j - 1+1);
a(j,j) = real(a(j,j)) + real(x(jx).*temp1+y(jy).*temp2);
else;
a(j,j) = real(a(j,j));
end;
jx = fix(jx + incx);
jy = fix(jy + incy);
end; j = fix(n+1);
end;
%
% Form A when A is stored in the lower triangle.
%
elseif((incx==1) &&(incy==1) ) ;
for j = 1 : n;
if((x(j)~=zero) ||(y(j)~=zero) )
temp1 = alpha.*conj(y(j));
temp2 = conj(alpha.*x(j));
a(j,j) = real(a(j,j)) + real(x(j).*temp1+y(j).*temp2);
for i = j + 1 : n;
a(i,j) = a(i,j) + x(i).*temp1 + y(i).*temp2;
end; i = fix(n+1);
else;
a(j,j) = real(a(j,j));
end;
end; j = fix(n+1);
else;
for j = 1 : n;
if((x(jx)~=zero) ||(y(jy)~=zero) )
temp1 = alpha.*conj(y(jy));
temp2 = conj(alpha.*x(jx));
a(j,j) = real(a(j,j)) + real(x(jx).*temp1+y(jy).*temp2);
ix = fix(jx);
iy = fix(jy);
for i = j + 1 : n;
ix = fix(ix + incx);
iy = fix(iy + incy);
a(i,j) = a(i,j) + x(ix).*temp1 + y(iy).*temp2;
end; i = fix(n+1);
else;
a(j,j) = real(a(j,j));
end;
jx = fix(jx + incx);
jy = fix(jy + incy);
end; j = fix(n+1);
end;
%
%
% end of CHER2 .
%
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
x_shape=zeros(x_shape);x_shape(:)=x(1:numel(x_shape));x=x_shape;
y_shape=zeros(y_shape);y_shape(:)=y(1:numel(y_shape));y=y_shape;
end
%DECK CHER2K
|
|