| [a,lda,n,kpvt,b]=chisl(a,lda,n,kpvt,b); |
function [a,lda,n,kpvt,b]=chisl(a,lda,n,kpvt,b);
%***BEGIN PROLOGUE CHISL
%***PURPOSE Solve the complex Hermitian system using factors obtained
% from CHIFA.
%***LIBRARY SLATEC (LINPACK)
%***CATEGORY D2D1A
%***TYPE COMPLEX (SSISL-S, DSISL-D, CHISL-C, CSISL-C)
%***KEYWORDS HERMITIAN, LINEAR ALGEBRA, LINPACK, MATRIX, SOLVE
%***AUTHOR Bunch, J., (UCSD)
%***DESCRIPTION
%
% CHISL solves the complex Hermitian system
% A * X = B
% using the factors computed by CHIFA.
%
% On Entry
%
% A COMPLEX(LDA,N)
% the output from CHIFA.
%
% LDA INTEGER
% the leading dimension of the array A .
%
% N INTEGER
% the order of the matrix A .
%
% KVPT INTEGER(N)
% the pivot vector from CHIFA.
%
% B COMPLEX(N)
% the right hand side vector.
%
% On Return
%
% B the solution vector X .
%
% Error Condition
%
% A division by zero may occur if CHICO has set RCOND .EQ. 0.0
% or CHIFA has set INFO .NE. 0 .
%
% To compute INVERSE(A) * C where C is a matrix
% with P columns
% CALL CHIFA(A,LDA,N,KVPT,INFO)
% IF (INFO .NE. 0) GO TO ...
% DO 10 J = 1, p
% CALL CHISL(A,LDA,N,KVPT,C(1,J))
% 10 CONTINUE
%
%***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
% Stewart, LINPACK Users' Guide, SIAM, 1979.
%***ROUTINES CALLED CAXPY, CDOTC
%***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 CHISL
persistent ak akm1 bk bkm1 denom k kp temp ;
kpvt_shape=size(kpvt);kpvt=reshape(kpvt,1,[]);
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,1,[]);
%
if isempty(ak), ak=0; end;
if isempty(akm1), akm1=0; end;
if isempty(bk), bk=0; end;
if isempty(bkm1), bkm1=0; end;
if isempty(denom), denom=0; end;
if isempty(temp), temp=0; end;
if isempty(k), k=0; end;
if isempty(kp), kp=0; end;
%
% LOOP BACKWARD APPLYING THE TRANSFORMATIONS AND
% D INVERSE TO B.
%
%***FIRST EXECUTABLE STATEMENT CHISL
k = fix(n);
while( k~=0 );
if( kpvt(k)<0 )
%
% 2 X 2 PIVOT BLOCK.
%
if( k~=2 )
kp = fix(abs(kpvt(k)));
if( kp~=k-1 )
%
% INTERCHANGE.
%
temp = b(k-1);
b(k-1) = b(kp);
b(kp) = temp;
end;
%
% APPLY THE TRANSFORMATION.
%
[dumvar1,dumvar2,a(sub2ind(size(a),1,k):end),dumvar4,dumvar5]=caxpy(k-2,b(k),a(sub2ind(size(a),1,k):end),1,b(sub2ind(size(b),max(1,1)):end),1); dumvar2i=find((b(k))~=(dumvar2));dumvar5i=find((b(sub2ind(size(b),max(1,1)):end))~=(dumvar5)); b(k-1+dumvar2i)=dumvar2(dumvar2i); b(1-1+dumvar5i)=dumvar5(dumvar5i);
[dumvar1,dumvar2,a(sub2ind(size(a),1,k-1):end),dumvar4,dumvar5]=caxpy(k-2,b(k-1),a(sub2ind(size(a),1,k-1):end),1,b(sub2ind(size(b),max(1,1)):end),1); dumvar2i=find((b(k-1))~=(dumvar2));dumvar5i=find((b(sub2ind(size(b),max(1,1)):end))~=(dumvar5)); b(k-1-1+dumvar2i)=dumvar2(dumvar2i); b(1-1+dumvar5i)=dumvar5(dumvar5i);
end;
%
% APPLY D INVERSE.
%
ak = a(k,k)./conj(a(k-1,k));
akm1 = a(k-1,k-1)./a(k-1,k);
bk = b(k)./conj(a(k-1,k));
bkm1 = b(k-1)./a(k-1,k);
denom = ak.*akm1 - 1.0e0;
b(k) =(akm1.*bk-bkm1)./denom;
b(k-1) =(ak.*bkm1-bk)./denom;
k = fix(k - 2);
else;
%
% 1 X 1 PIVOT BLOCK.
%
if( k~=1 )
kp = fix(kpvt(k));
if( kp~=k )
%
% INTERCHANGE.
%
temp = b(k);
b(k) = b(kp);
b(kp) = temp;
end;
%
% APPLY THE TRANSFORMATION.
%
[dumvar1,dumvar2,a(sub2ind(size(a),1,k):end),dumvar4,dumvar5]=caxpy(k-1,b(k),a(sub2ind(size(a),1,k):end),1,b(sub2ind(size(b),max(1,1)):end),1); dumvar2i=find((b(k))~=(dumvar2));dumvar5i=find((b(sub2ind(size(b),max(1,1)):end))~=(dumvar5)); b(k-1+dumvar2i)=dumvar2(dumvar2i); b(1-1+dumvar5i)=dumvar5(dumvar5i);
end;
%
% APPLY D INVERSE.
%
b(k) = b(k)./a(k,k);
k = fix(k - 1);
end;
end;
%
% LOOP FORWARD APPLYING THE TRANSFORMATIONS.
%
k = 1;
while( k<=n );
if( kpvt(k)<0 )
%
% 2 X 2 PIVOT BLOCK.
%
if( k~=1 )
%
% APPLY THE TRANSFORMATION.
%
b(k) = b(k) + cdotc(k-1,a(sub2ind(size(a),1,k):end),1,b(sub2ind(size(b),max(1,1)):end),1);
b(k+1) = b(k+1) + cdotc(k-1,a(sub2ind(size(a),1,k+1):end),1,b(sub2ind(size(b),max(1,1)):end),1);
kp = fix(abs(kpvt(k)));
if( kp~=k )
%
% INTERCHANGE.
%
temp = b(k);
b(k) = b(kp);
b(kp) = temp;
end;
end;
k = fix(k + 2);
else;
%
% 1 X 1 PIVOT BLOCK.
%
if( k~=1 )
%
% APPLY THE TRANSFORMATION.
%
b(k) = b(k) + cdotc(k-1,a(sub2ind(size(a),1,k):end),1,b(sub2ind(size(b),max(1,1)):end),1);
kp = fix(kpvt(k));
if( kp~=k )
%
% INTERCHANGE.
%
temp = b(k);
b(k) = b(kp);
b(kp) = temp;
end;
end;
k = fix(k + 1);
end;
end;
kpvt_shape=zeros(kpvt_shape);kpvt_shape(:)=kpvt(1:numel(kpvt_shape));kpvt=kpvt_shape;
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;
end %subroutine chisl
%DECK CHKDER
|
|