Code covered by the BSD License  

Highlights from
slatec

from slatec by Ben Barrowes
The slatec library converted into matlab functions.

[side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc]=csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc);
function [side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc]=csymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc);
%***BEGIN PROLOGUE  CSYMM
%***PURPOSE  Multiply a complex general matrix by a complex symmetric
%            matrix.
%***LIBRARY   SLATEC (BLAS)
%***CATEGORY  D1B6
%***TYPE      COMPLEX (SSYMM-S, DSYMM-D, CSYMM-C)
%***KEYWORDS  LEVEL 3 BLAS, LINEAR ALGEBRA
%***AUTHOR  Dongarra, J., (ANL)
%           Duff, I., (AERE)
%           Du Croz, J., (NAG)
%           Hammarling, S. (NAG)
%***DESCRIPTION
%
%  CSYMM  performs one of the matrix-matrix operations
%
%     C := alpha*A*B + beta*C,
%
%  or
%
%     C := alpha*B*A + beta*C,
%
%  where  alpha and beta are scalars, A is a symmetric matrix and  B and
%  C are m by n matrices.
%
%  Parameters
%  ==========
%
%  SIDE   - CHARACTER*1.
%           On entry,  SIDE  specifies whether  the  symmetric matrix  A
%           appears on the  left or right  in the  operation as follows:
%
%              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
%
%              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
%
%           Unchanged on exit.
%
%  UPLO   - CHARACTER*1.
%           On  entry,   UPLO  specifies  whether  the  uppermlv  or  lower
%           triangular  part  of  the  symmetric  matrix   A  is  to  be
%           referenced as follows:
%
%              UPLO = 'U' or 'u'   Only the uppermlv triangular part of the
%                                  symmetric matrix is to be referenced.
%
%              UPLO = 'L' or 'l'   Only the lower triangular part of the
%                                  symmetric matrix is to be referenced.
%
%           Unchanged on exit.
%
%  M      - INTEGER.
%           On entry,  M  specifies the number of rows of the matrix  C.
%           M  must be at least zero.
%           Unchanged on exit.
%
%  N      - INTEGER.
%           On entry, N specifies the number of columns of the matrix C.
%           N  must be at least zero.
%           Unchanged on exit.
%
%  ALPHA  - COMPLEX         .
%           On entry, ALPHA specifies the scalar alpha.
%           Unchanged on exit.
%
%  A      - COMPLEX          array of DIMENSION ( LDA, ka ), where ka is
%           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
%           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
%           the array  A  must contain the  symmetric matrix,  such that
%           when  UPLO = 'U' or 'u', the leading m by m uppermlv triangular
%           part of the array  A  must contain the uppermlv triangular part
%           of the  symmetric matrix and the  strictly  lower triangular
%           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
%           the leading  m by m  lower triangular part  of the  array  A
%           must  contain  the  lower triangular part  of the  symmetric
%           matrix and the  strictly uppermlv triangular part of  A  is not
%           referenced.
%           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
%           the array  A  must contain the  symmetric matrix,  such that
%           when  UPLO = 'U' or 'u', the leading n by n uppermlv triangular
%           part of the array  A  must contain the uppermlv triangular part
%           of the  symmetric matrix and the  strictly  lower triangular
%           part of  A  is not referenced,  and when  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 uppermlv triangular part of  A  is not
%           referenced.
%           Unchanged on exit.
%
%  LDA    - INTEGER.
%           On entry, LDA specifies the first dimension of A as declared
%           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
%           LDA must be at least  max( 1, m ), otherwise  LDA must be at
%           least max( 1, n ).
%           Unchanged on exit.
%
%  B      - COMPLEX          array of DIMENSION ( LDB, n ).
%           Before entry, the leading  m by n part of the array  B  must
%           contain the matrix B.
%           Unchanged on exit.
%
%  LDB    - INTEGER.
%           On entry, LDB specifies the first dimension of B as declared
%           in  the  calling  (sub)  program.   LDB  must  be  at  least
%           max( 1, m ).
%           Unchanged on exit.
%
%  BETA   - COMPLEX         .
%           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
%           supplied as zero then C need not be set on input.
%           Unchanged on exit.
%
%  C      - COMPLEX          array of DIMENSION ( LDC, n ).
%           Before entry, the leading  m by n  part of the array  C must
%           contain the matrix  C,  except when  beta  is zero, in which
%           case C need not be set on entry.
%           On exit, the array  C  is overwritten by the  m by n updated
%           matrix.
%
%  LDC    - INTEGER.
%           On entry, LDC specifies the first dimension of C as declared
%           in  the  calling  (sub)  program.   LDC  must  be  at  least
%           max( 1, m ).
%           Unchanged on exit.
%
%***REFERENCES  Dongarra, J., Du Croz, J., Duff, I., and Hammarling, S.
%                 A set of level 3 basic linear algebra subprograms.
%                 ACM TOMS, Vol. 16, No. 1, pp. 1-17, March 1990.
%***ROUTINES CALLED  LSAME, XERBLA
%***REVISION HISTORY  (YYMMDD)
%   890208  DATE WRITTEN
%   910605  Modified to meet SLATEC prologue standards.  Only comment
%           lines were modified.  (BKS)
%***end PROLOGUE  CSYMM
%     .. Scalar Arguments ..
%     .. Array Arguments ..
persistent i info j k nrowa one temp1 temp2 uppermlv zero ; 

a_shape=size(a);a=reshape([a(:).',zeros(1,ceil(numel(a)./prod([lda])).*prod([lda])-numel(a))],lda,[]);
b_shape=size(b);b=reshape([b(:).',zeros(1,ceil(numel(b)./prod([ldb])).*prod([ldb])-numel(b))],ldb,[]);
c_shape=size(c);c=reshape([c(:).',zeros(1,ceil(numel(c)./prod([ldc])).*prod([ldc])-numel(c))],ldc,[]);
%     .. External Functions ..
%     .. External Subroutines ..
%     .. Intrinsic Functions ..
%     .. Local Scalars ..
if isempty(uppermlv), uppermlv=false; end;
if isempty(i), i=0; end;
if isempty(info), info=0; end;
if isempty(j), j=0; end;
if isempty(k), k=0; end;
if isempty(nrowa), nrowa=0; end;
if isempty(temp1), temp1=0; end;
if isempty(temp2), temp2=0; end;
%     .. Parameters ..
if isempty(one), one=complex(1.0e+0,0.0e+0) ; end;
if isempty(zero), zero=complex(0.0e+0,0.0e+0) ; end;
%***FIRST EXECUTABLE STATEMENT  CSYMM
%
%     Set NROWA as the number of rows of A.
%
if( lsame(side,'L') )
nrowa = fix(m);
else;
nrowa = fix(n);
end;
[uppermlv ,uplo]=lsame(uplo,'U');
%
%     Test the input parameters.
%
info = 0;
if( (~lsame(side,'L')) && (~lsame(side,'R')) )
info = 1;
elseif ( (~uppermlv) && (~lsame(uplo,'L')) ) ;
info = 2;
elseif( m<0 ) ;
info = 3;
elseif( n<0 ) ;
info = 4;
elseif( lda<max(1,nrowa) ) ;
info = 7;
elseif( ldb<max(1,m) ) ;
info = 9;
elseif( ldc<max(1,m) ) ;
info = 12;
end;
if( info~=0 )
[dumvar1,info]=xerbla('CSYMM ',info);
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
b_shape=zeros(b_shape);b_shape(:)=b(1:numel(b_shape));b=b_shape;
c_shape=zeros(c_shape);c_shape(:)=c(1:numel(c_shape));c=c_shape;
return;
end;
%
%     Quick return if possible.
%
if((m==0) ||(n==0) ||((alpha==zero) &&(beta==one)) )
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
b_shape=zeros(b_shape);b_shape(:)=b(1:numel(b_shape));b=b_shape;
c_shape=zeros(c_shape);c_shape(:)=c(1:numel(c_shape));c=c_shape;
return;
end;
%
%     And when  alpha==zero.
%
if( alpha==zero )
if( beta==zero )
for j = 1 : n;
for i = 1 : m;
c(i,j) = zero;
end; i = fix(m+1);
end; j = fix(n+1);
else;
for j = 1 : n;
for i = 1 : m;
c(i,j) = beta.*c(i,j);
end; i = fix(m+1);
end; j = fix(n+1);
end;
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
b_shape=zeros(b_shape);b_shape(:)=b(1:numel(b_shape));b=b_shape;
c_shape=zeros(c_shape);c_shape(:)=c(1:numel(c_shape));c=c_shape;
return;
end;
%
%     Start the operations.
%
if( ~(lsame(side,'L')) )
%
%        Form  C := alpha*B*A + beta*C.
%
for j = 1 : n;
temp1 = alpha.*a(j,j);
if( beta==zero )
for i = 1 : m;
c(i,j) = temp1.*b(i,j);
end; i = fix(m+1);
else;
for i = 1 : m;
c(i,j) = beta.*c(i,j) + temp1.*b(i,j);
end; i = fix(m+1);
end;
for k = 1 : j - 1;
if( uppermlv )
temp1 = alpha.*a(k,j);
else;
temp1 = alpha.*a(j,k);
end;
for i = 1 : m;
c(i,j) = c(i,j) + temp1.*b(i,k);
end; i = fix(m+1);
end; k = fix(j - 1+1);
for k = j + 1 : n;
if( uppermlv )
temp1 = alpha.*a(j,k);
else;
temp1 = alpha.*a(k,j);
end;
for i = 1 : m;
c(i,j) = c(i,j) + temp1.*b(i,k);
end; i = fix(m+1);
end; k = fix(n+1);
end; j = fix(n+1);
%
%        Form  C := alpha*A*B + beta*C.
%
elseif( uppermlv ) ;
for j = 1 : n;
for i = 1 : m;
temp1 = alpha.*b(i,j);
temp2 = zero;
for k = 1 : i - 1;
c(k,j) = c(k,j) + temp1.*a(k,i);
temp2 = temp2 + b(k,j).*a(k,i);
end; k = fix(i - 1+1);
if( beta==zero )
c(i,j) = temp1.*a(i,i) + alpha.*temp2;
else;
c(i,j) = beta.*c(i,j) + temp1.*a(i,i) + alpha.*temp2;
end;
end; i = fix(m+1);
end; j = fix(n+1);
else;
for j = 1 : n;
for i = m : -1: 1 ;
temp1 = alpha.*b(i,j);
temp2 = zero;
for k = i + 1 : m;
c(k,j) = c(k,j) + temp1.*a(k,i);
temp2 = temp2 + b(k,j).*a(k,i);
end; k = fix(m+1);
if( beta==zero )
c(i,j) = temp1.*a(i,i) + alpha.*temp2;
else;
c(i,j) = beta.*c(i,j) + temp1.*a(i,i) + alpha.*temp2;
end;
end; i = fix(1 -1);
end; j = fix(n+1);
end;
%
%
%     end of CSYMM .
%
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
b_shape=zeros(b_shape);b_shape(:)=b(1:numel(b_shape));b=b_shape;
c_shape=zeros(c_shape);c_shape(:)=c(1:numel(c_shape));c=c_shape;
end
%DECK CSYR2K

Contact us at files@mathworks.com