| [uplo,n,alpha,ap,x,incx,beta,y,incy]=sspmv(uplo,n,alpha,ap,x,incx,beta,y,incy); |
function [uplo,n,alpha,ap,x,incx,beta,y,incy]=sspmv(uplo,n,alpha,ap,x,incx,beta,y,incy);
%***BEGIN PROLOGUE SSPMV
%***PURPOSE Perform the matrix-vector operation.
%***LIBRARY SLATEC (BLAS)
%***CATEGORY D1B4
%***TYPE SINGLE PRECISION (SSPMV-S, DSPMV-D, CSPMV-C)
%***KEYWORDS LEVEL 2 BLAS, LINEAR ALGEBRA
%***AUTHOR Dongarra, J. J., (ANL)
% Du Croz, J., (NAG)
% Hammarling, S., (NAG)
% Hanson, R. J., (SNLA)
%***DESCRIPTION
%
% SSPMV performs the matrix-vector operation
%
% y := alpha*A*x + beta*y,
%
% where alpha and beta are scalars, x and y are n element vectors and
% A is an n by n symmetric matrix, supplied in packed form.
%
% Parameters
% ==========
%
% UPLO - 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.
%
% 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 - REAL .
% On entry, ALPHA specifies the scalar alpha.
% Unchanged on exit.
%
% AP - REAL array of 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 symmetric 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.
% Before entry with UPLO = 'L' or 'l', the array AP must
% contain the lower triangular part of the symmetric 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.
% Unchanged on exit.
%
% X - REAL 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.
%
% BETA - REAL .
% On entry, BETA specifies the scalar beta. When BETA is
% supplied as zero then Y need not be set on input.
% Unchanged on exit.
%
% Y - REAL array of dimension at least
% ( 1 + ( n - 1 )*abs( INCY ) ).
% Before entry, the incremented array Y must contain the n
% element vector y. On exit, Y is overwritten by the updated
% vector y.
%
% INCY - INTEGER.
% On entry, INCY specifies the increment for the elements of
% Y. INCY must not be zero.
% 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 SSPMV
% .. Scalar Arguments ..
% .. Array Arguments ..
persistent i info ix iy j jx jy k kk kx ky one temp1 temp2 zero ;
ap_shape=size(ap);ap=reshape(ap,1,[]);
x_shape=size(x);x=reshape(x,1,[]);
y_shape=size(y);y=reshape(y,1,[]);
% .. Parameters ..
if isempty(one), one=1.0e+0; end;
if isempty(zero), zero=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(k), k=0; end;
if isempty(kk), kk=0; end;
if isempty(kx), kx=0; end;
if isempty(ky), ky=0; end;
% .. External Functions ..
% .. External Subroutines ..
%***FIRST EXECUTABLE STATEMENT SSPMV
%
% Test the input parameters.
%
info = 0;
if( ~lsame(uplo,'U') && ~lsame(uplo,'L') )
info = 1;
elseif( n<0 ) ;
info = 2;
elseif( incx==0 ) ;
info = 6;
elseif( incy==0 ) ;
info = 9;
end;
if( info~=0 )
[dumvar1,info]=xerbla('SSPMV ',info);
ap_shape=zeros(ap_shape);ap_shape(:)=ap(1:numel(ap_shape));ap=ap_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) &&(beta==one)) )
ap_shape=zeros(ap_shape);ap_shape(:)=ap(1:numel(ap_shape));ap=ap_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( 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;
%
% Start the operations. In this version the elements of the array AP
% are accessed sequentially with one pass through AP.
%
% First form y := beta*y.
%
if( beta~=one )
if( incy~=1 )
iy = fix(ky);
if( beta==zero )
for i = 1 : n;
y(iy) = zero;
iy = fix(iy + incy);
end; i = fix(n+1);
else;
for i = 1 : n;
y(iy) = beta.*y(iy);
iy = fix(iy + incy);
end; i = fix(n+1);
end;
elseif( beta==zero ) ;
for i = 1 : n;
y(i) = zero;
end; i = fix(n+1);
else;
for i = 1 : n;
y(i) = beta.*y(i);
end; i = fix(n+1);
end;
end;
if( alpha==zero )
ap_shape=zeros(ap_shape);ap_shape(:)=ap(1:numel(ap_shape));ap=ap_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;
kk = 1;
if( lsame(uplo,'U') )
%
% Form y when AP contains the upper triangle.
%
if((incx==1) &&(incy==1) )
for j = 1 : n;
temp1 = alpha.*x(j);
temp2 = zero;
k = fix(kk);
for i = 1 : j - 1;
y(i) = y(i) + temp1.*ap(k);
temp2 = temp2 + ap(k).*x(i);
k = fix(k + 1);
end; i = fix(j - 1+1);
y(j) = y(j) + temp1.*ap(kk+j-1) + alpha.*temp2;
kk = fix(kk + j);
end; j = fix(n+1);
else;
jx = fix(kx);
jy = fix(ky);
for j = 1 : n;
temp1 = alpha.*x(jx);
temp2 = zero;
ix = fix(kx);
iy = fix(ky);
for k = kk : kk + j - 2;
y(iy) = y(iy) + temp1.*ap(k);
temp2 = temp2 + ap(k).*x(ix);
ix = fix(ix + incx);
iy = fix(iy + incy);
end; k = fix(kk + j - 2+1);
y(jy) = y(jy) + temp1.*ap(kk+j-1) + alpha.*temp2;
jx = fix(jx + incx);
jy = fix(jy + incy);
kk = fix(kk + j);
end; j = fix(n+1);
end;
%
% Form y when AP contains the lower triangle.
%
elseif((incx==1) &&(incy==1) ) ;
for j = 1 : n;
temp1 = alpha.*x(j);
temp2 = zero;
y(j) = y(j) + temp1.*ap(kk);
k = fix(kk + 1);
for i = j + 1 : n;
y(i) = y(i) + temp1.*ap(k);
temp2 = temp2 + ap(k).*x(i);
k = fix(k + 1);
end; i = fix(n+1);
y(j) = y(j) + alpha.*temp2;
kk = fix(kk +(n-j+1));
end; j = fix(n+1);
else;
jx = fix(kx);
jy = fix(ky);
for j = 1 : n;
temp1 = alpha.*x(jx);
temp2 = zero;
y(jy) = y(jy) + temp1.*ap(kk);
ix = fix(jx);
iy = fix(jy);
for k = kk + 1 : kk + n - j;
ix = fix(ix + incx);
iy = fix(iy + incy);
y(iy) = y(iy) + temp1.*ap(k);
temp2 = temp2 + ap(k).*x(ix);
end; k = fix(kk + n - j+1);
y(jy) = y(jy) + alpha.*temp2;
jx = fix(jx + incx);
jy = fix(jy + incy);
kk = fix(kk +(n-j+1));
end; j = fix(n+1);
end;
%
%
% end of SSPMV .
%
ap_shape=zeros(ap_shape);ap_shape(:)=ap(1:numel(ap_shape));ap=ap_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 SSPR2
|
|