Code covered by the BSD License  

Highlights from
slatec

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

[ap,n,kpvt,det,inert,work,job]=dspdi(ap,n,kpvt,det,inert,work,job);
function [ap,n,kpvt,det,inert,work,job]=dspdi(ap,n,kpvt,det,inert,work,job);
%***BEGIN PROLOGUE  DSPDI
%***PURPOSE  Compute the determinant, inertia, inverse of a real
%            symmetric matrix stored in packed form using the factors
%            from DSPFA.
%***LIBRARY   SLATEC (LINPACK)
%***CATEGORY  D2B1A, D3B1A
%***TYPE      doubleprecision (SSPDI-S, DSPDI-D, CHPDI-C, CSPDI-C)
%***KEYWORDS  DETERMINANT, INVERSE, LINEAR ALGEBRA, LINPACK, MATRIX,
%             PACKED, SYMMETRIC
%***AUTHOR  Bunch, J., (UCSD)
%***DESCRIPTION
%
%     DSPDI computes the determinant, inertia and inverse
%     of a doubleprecision symmetric matrix using the factors from
%     DSPFA, where the matrix is stored in packed form.
%
%     On Entry
%
%        AP      doubleprecision (N*(N+1)/2)
%                the output from DSPFA.
%
%        N       INTEGER
%                the order of the matrix A.
%
%        KPVT    INTEGER(N)
%                the pivot vector from DSPFA.
%
%        WORK    doubleprecision(N)
%                work vector.  Contents ignored.
%
%        JOB     INTEGER
%                JOB has the decimal expansion  ABC  where
%                   if  C .NE. 0, the inverse is computed,
%                   if  B .NE. 0, the determinant is computed,
%                   if  A .NE. 0, the inertia is computed.
%
%                For example, JOB = 111  gives all three.
%
%     On Return
%
%        Variables not requested by JOB are not used.
%
%        AP     contains the upper triangle of the inverse of
%               the original matrix, stored in packed form.
%               The columns of the upper triangle are stored
%               sequentially in a one-dimensional array.
%
%        DET    doubleprecision(2)
%               determinant of original matrix.
%               DETERMINANT = DET(1) * 10.0**DET(2)
%               with 1.0 .LE. ABS(DET(1)) .LT. 10.0
%               or DET(1) = 0.0.
%
%        INERT  INTEGER(3)
%               the inertia of the original matrix.
%               INERT(1)  =  number of positive eigenvalues.
%               INERT(2)  =  number of negative eigenvalues.
%               INERT(3)  =  number of zero eigenvalues.
%
%     Error Condition
%
%        A division by zero will occur if the inverse is requested
%        and  DSPCO  has set RCOND .EQ. 0.0
%        or  DSPFA  has set  INFO .NE. 0 .
%
%***REFERENCES  J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
%                 Stewart, LINPACK Users' Guide, SIAM, 1979.
%***ROUTINES CALLED  DAXPY, DCOPY, DDOT, DSWAP
%***REVISION HISTORY  (YYMMDD)
%   780814  DATE WRITTEN
%   890531  Changed all specific intrinsics to generic.  (WRB)
%   890831  Modified array declarations.  (WRB)
%   891107  Modified routine equivalence list.  (WRB)
%   891107  REVISION DATE from Version 3.2
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900326  Removed duplicate information from DESCRIPTION section.
%           (WRB)
%   920501  Reformatted the REFERENCES section.  (WRB)
%***end PROLOGUE  DSPDI
persistent ak akkp1 akp1 d ij ik ikp1 iks j jb jk jkp1 k kk kkp1 km1 ks ksj kskp1 kstep nodet noert noinv t temp ten ; 

ap_shape=size(ap);ap=reshape(ap,1,[]);
work_shape=size(work);work=reshape(work,1,[]);
kpvt_shape=size(kpvt);kpvt=reshape(kpvt,1,[]);
%
if isempty(akkp1), akkp1=0; end;
if isempty(temp), temp=0; end;
if isempty(ten), ten=0; end;
if isempty(d), d=0; end;
if isempty(t), t=0; end;
if isempty(ak), ak=0; end;
if isempty(akp1), akp1=0; end;
if isempty(ij), ij=0; end;
if isempty(ik), ik=0; end;
if isempty(ikp1), ikp1=0; end;
if isempty(iks), iks=0; end;
if isempty(j), j=0; end;
if isempty(jb), jb=0; end;
if isempty(jk), jk=0; end;
if isempty(jkp1), jkp1=0; end;
if isempty(k), k=0; end;
if isempty(kk), kk=0; end;
if isempty(kkp1), kkp1=0; end;
if isempty(km1), km1=0; end;
if isempty(ks), ks=0; end;
if isempty(ksj), ksj=0; end;
if isempty(kskp1), kskp1=0; end;
if isempty(kstep), kstep=0; end;
if isempty(noinv), noinv=false; end;
if isempty(nodet), nodet=false; end;
if isempty(noert), noert=false; end;
%***FIRST EXECUTABLE STATEMENT  DSPDI
noinv = rem(job,10)==0;
nodet = rem(job,100)./10==0;
noert = rem(job,1000)./100==0;
%
if( ~(nodet && noert) )
if( ~(noert) )
inert(1) = 0;
inert(2) = 0;
inert(3) = 0;
end;
if( ~(nodet) )
det(1) = 1.0d0;
det(2) = 0.0d0;
ten = 10.0d0;
end;
t = 0.0d0;
ik = 0;
for k = 1 : n;
kk = fix(ik + k);
d = ap(kk);
%
%           CHECK IF 1 BY 1
%
if( kpvt(k)<=0 )
%
%              2 BY 2 BLOCK
%              use DET (D  S)  =  (D/T * C - T) * T  ,  T = ABS(S)
%                      (S  C)
%              TO AVOID UNDERFLOW/OVERFLOW TROUBLES.
%              TAKE TWO PASSES THROUGH SCALING.  USE  T  FOR FLAG.
%
if( t==0.0d0 )
ikp1 = fix(ik + k);
kkp1 = fix(ikp1 + k);
t = abs(ap(kkp1));
d =(d./t).*ap(kkp1+1) - t;
else;
d = t;
t = 0.0d0;
end;
end;
%
if( ~(noert) )
if( d>0.0d0 )
inert(1) = fix(inert(1) + 1);
end;
if( d<0.0d0 )
inert(2) = fix(inert(2) + 1);
end;
if( d==0.0d0 )
inert(3) = fix(inert(3) + 1);
end;
end;
%
if( ~(nodet) )
det(1) = d.*det(1);
if( det(1)~=0.0d0 )
while( abs(det(1))<1.0d0 );
det(1) = ten.*det(1);
det(2) = det(2) - 1.0d0;
end;
while( abs(det(1))>=ten );
det(1) = det(1)./ten;
det(2) = det(2) + 1.0d0;
end;
end;
end;
ik = fix(ik + k);
end; k = fix(n+1);
end;
%
%     COMPUTE INVERSE(A)
%
if( ~(noinv) )
k = 1;
ik = 0;
while( k<=n );
km1 = fix(k - 1);
kk = fix(ik + k);
ikp1 = fix(ik + k);
kkp1 = fix(ikp1 + k);
if( kpvt(k)<0 )
%
%              2 BY 2
%
t = abs(ap(kkp1));
ak = ap(kk)./t;
akp1 = ap(kkp1+1)./t;
akkp1 = ap(kkp1)./t;
d = t.*(ak.*akp1-1.0d0);
ap(kk) = akp1./d;
ap(kkp1+1) = ak./d;
ap(kkp1) = -akkp1./d;
if( km1>=1 )
[km1,ap(sub2ind(size(ap),max(ikp1+1,1)):end),dumvar3,work]=dcopy(km1,ap(sub2ind(size(ap),max(ikp1+1,1)):end),1,work,1);
ij = 0;
for j = 1 : km1;
jkp1 = fix(ikp1 + j);
[ap(jkp1) ,j,ap(sub2ind(size(ap),max(ij+1,1)):end),dumvar4,work]=ddot(j,ap(sub2ind(size(ap),max(ij+1,1)):end),1,work,1);
[dumvar1,work(j),dumvar3,dumvar4,dumvar5]=daxpy(j-1,work(j),ap(sub2ind(size(ap),max(ij+1,1)):end),1,ap(sub2ind(size(ap),max(ikp1+1,1)):end),1);   dumvar3i=find((ap(sub2ind(size(ap),max(ij+1,1)):end))~=(dumvar3));dumvar5i=find((ap(sub2ind(size(ap),max(ikp1+1,1)):end))~=(dumvar5));   ap(ij+1-1+dumvar3i)=dumvar3(dumvar3i); ap(ikp1+1-1+dumvar5i)=dumvar5(dumvar5i); 
ij = fix(ij + j);
end; j = fix(km1+1);
ap(kkp1+1) = ap(kkp1+1) + ddot(km1,work,1,ap(sub2ind(size(ap),max(ikp1+1,1)):end),1);
ap(kkp1) = ap(kkp1) + ddot(km1,ap(sub2ind(size(ap),max(ik+1,1)):end),1,ap(sub2ind(size(ap),max(ikp1+1,1)):end),1);
[km1,ap(sub2ind(size(ap),max(ik+1,1)):end),dumvar3,work]=dcopy(km1,ap(sub2ind(size(ap),max(ik+1,1)):end),1,work,1);
ij = 0;
for j = 1 : km1;
jk = fix(ik + j);
[ap(jk) ,j,ap(sub2ind(size(ap),max(ij+1,1)):end),dumvar4,work]=ddot(j,ap(sub2ind(size(ap),max(ij+1,1)):end),1,work,1);
[dumvar1,work(j),dumvar3,dumvar4,dumvar5]=daxpy(j-1,work(j),ap(sub2ind(size(ap),max(ij+1,1)):end),1,ap(sub2ind(size(ap),max(ik+1,1)):end),1);   dumvar3i=find((ap(sub2ind(size(ap),max(ij+1,1)):end))~=(dumvar3));dumvar5i=find((ap(sub2ind(size(ap),max(ik+1,1)):end))~=(dumvar5));   ap(ij+1-1+dumvar3i)=dumvar3(dumvar3i); ap(ik+1-1+dumvar5i)=dumvar5(dumvar5i); 
ij = fix(ij + j);
end; j = fix(km1+1);
ap(kk) = ap(kk) + ddot(km1,work,1,ap(sub2ind(size(ap),max(ik+1,1)):end),1);
end;
kstep = 2;
else;
%
%              1 BY 1
%
ap(kk) = 1.0d0./ap(kk);
if( km1>=1 )
[km1,ap(sub2ind(size(ap),max(ik+1,1)):end),dumvar3,work]=dcopy(km1,ap(sub2ind(size(ap),max(ik+1,1)):end),1,work,1);
ij = 0;
for j = 1 : km1;
jk = fix(ik + j);
[ap(jk) ,j,ap(sub2ind(size(ap),max(ij+1,1)):end),dumvar4,work]=ddot(j,ap(sub2ind(size(ap),max(ij+1,1)):end),1,work,1);
[dumvar1,work(j),dumvar3,dumvar4,dumvar5]=daxpy(j-1,work(j),ap(sub2ind(size(ap),max(ij+1,1)):end),1,ap(sub2ind(size(ap),max(ik+1,1)):end),1);   dumvar3i=find((ap(sub2ind(size(ap),max(ij+1,1)):end))~=(dumvar3));dumvar5i=find((ap(sub2ind(size(ap),max(ik+1,1)):end))~=(dumvar5));   ap(ij+1-1+dumvar3i)=dumvar3(dumvar3i); ap(ik+1-1+dumvar5i)=dumvar5(dumvar5i); 
ij = fix(ij + j);
end; j = fix(km1+1);
ap(kk) = ap(kk) + ddot(km1,work,1,ap(sub2ind(size(ap),max(ik+1,1)):end),1);
end;
kstep = 1;
end;
%
%           SWAP
%
ks = fix(abs(kpvt(k)));
if( ks~=k )
iks =fix(fix((ks.*(ks-1))./2));
[ks,dumvar2,dumvar3,dumvar4]=dswap(ks,ap(sub2ind(size(ap),max(iks+1,1)):end),1,ap(sub2ind(size(ap),max(ik+1,1)):end),1);   dumvar2i=find((ap(sub2ind(size(ap),max(iks+1,1)):end))~=(dumvar2));dumvar4i=find((ap(sub2ind(size(ap),max(ik+1,1)):end))~=(dumvar4));   ap(iks+1-1+dumvar2i)=dumvar2(dumvar2i); ap(ik+1-1+dumvar4i)=dumvar4(dumvar4i); 
ksj = fix(ik + ks);
for jb = ks : k;
j = fix(k + ks - jb);
jk = fix(ik + j);
temp = ap(jk);
ap(jk) = ap(ksj);
ap(ksj) = temp;
ksj = fix(ksj -(j-1));
end; jb = fix(k+1);
if( kstep~=1 )
kskp1 = fix(ikp1 + ks);
temp = ap(kskp1);
ap(kskp1) = ap(kkp1);
ap(kkp1) = temp;
end;
end;
ik = fix(ik + k);
if( kstep==2 )
ik = fix(ik + k + 1);
end;
k = fix(k + kstep);
end;
end;
ap_shape=zeros(ap_shape);ap_shape(:)=ap(1:numel(ap_shape));ap=ap_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
kpvt_shape=zeros(kpvt_shape);kpvt_shape(:)=kpvt(1:numel(kpvt_shape));kpvt=kpvt_shape;
end %subroutine dspdi
%DECK DSPENC

Contact us at files@mathworks.com