| [nm,n,ar,ai,w,matz,zr,zi,fv1,fv2,fm1,ierr]=ch(nm,n,ar,ai,w,matz,zr,zi,fv1,fv2,fm1,ierr); |
function [nm,n,ar,ai,w,matz,zr,zi,fv1,fv2,fm1,ierr]=ch(nm,n,ar,ai,w,matz,zr,zi,fv1,fv2,fm1,ierr);
%***BEGIN PROLOGUE CH
%***PURPOSE Compute the eigenvalues and, optionally, the eigenvectors
% of a complex Hermitian matrix.
%***LIBRARY SLATEC (EISPACK)
%***CATEGORY D4A3
%***TYPE COMPLEX (RS-S, CH-C)
%***KEYWORDS EIGENVALUES, EIGENVECTORS, EISPACK
%***AUTHOR Smith, B. T., et al.
%***DESCRIPTION
%
% This subroutine calls the recommended sequence of
% subroutines from the eigensystem subroutine package (EISPACK)
% to find the eigenvalues and eigenvectors (if desired)
% of a COMPLEX HERMITIAN matrix.
%
% On INPUT
%
% NM must be set to the row dimension of the two-dimensional
% array parameters, AR, AI, ZR and ZI, as declared in the
% calling program dimension statement. NM is an INTEGER
% variable.
%
% N is the order of the matrix A=(AR,AI). N is an INTEGER
% variable. N must be less than or equal to NM.
%
% AR and AI contain the real and imaginary parts, respectively,
% of the complex Hermitian matrix. AR and AI are
% two-dimensional REAL arrays, dimensioned AR(NM,N)
% and AI(NM,N).
%
% MATZ is an INTEGER variable set equal to zero if only
% eigenvalues are desired. Otherwise, it is set to any
% non-zero integer for both eigenvalues and eigenvectors.
%
% On OUTPUT
%
% W contains the eigenvalues in ascending order.
% W is a one-dimensional REAL array, dimensioned W(N).
%
% ZR and ZI contain the real and imaginary parts, respectively,
% of the eigenvectors if MATZ is not zero. ZR and ZI are
% two-dimensional REAL arrays, dimensioned ZR(NM,N) and
% ZI(NM,N).
%
% IERR is an INTEGER flag set to
% Zero for normal return,
% 10*N if N is greater than NM,
% J if the J-th eigenvalue has not been
% determined after a total of 30 iterations.
% The eigenvalues should be correct for indices
% 1, 2, ..., IERR-1, but no eigenvectors are
% computed.
%
% FV1 and FV2 are one-dimensional REAL arrays used for
% temporary storage, dimensioned FV1(N) and FV2(N).
%
% FM1 is a two-dimensional REAL array used for temporary
% storage, dimensioned FM1(2,N).
%
% Questions and comments should be directed to B. S. Garbow,
% APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
% ------------------------------------------------------------------
%
%***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
% Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
% system Routines - EISPACK Guide, Springer-Verlag,
% 1976.
%***ROUTINES CALLED HTRIBK, HTRIDI, TQL2, TQLRAT
%***REVISION HISTORY (YYMMDD)
% 760101 DATE WRITTEN
% 890831 Modified array declarations. (WRB)
% 890831 REVISION DATE from Version 3.2
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 920501 Reformatted the REFERENCES section. (WRB)
%***end PROLOGUE CH
%
persistent i j ;
if isempty(i), i=0; end;
if isempty(j), j=0; end;
ar_shape=size(ar);ar=reshape([ar(:).',zeros(1,ceil(numel(ar)./prod([nm])).*prod([nm])-numel(ar))],nm,[]);
ai_shape=size(ai);ai=reshape([ai(:).',zeros(1,ceil(numel(ai)./prod([nm])).*prod([nm])-numel(ai))],nm,[]);
w_shape=size(w);w=reshape(w,1,[]);
zr_shape=size(zr);zr=reshape([zr(:).',zeros(1,ceil(numel(zr)./prod([nm])).*prod([nm])-numel(zr))],nm,[]);
zi_shape=size(zi);zi=reshape([zi(:).',zeros(1,ceil(numel(zi)./prod([nm])).*prod([nm])-numel(zi))],nm,[]);
fv1_shape=size(fv1);fv1=reshape(fv1,1,[]);
fv2_shape=size(fv2);fv2=reshape(fv2,1,[]);
fm1_shape=size(fm1);fm1=reshape([fm1(:).',zeros(1,ceil(numel(fm1)./prod([2])).*prod([2])-numel(fm1))],2,[]);
%
%***FIRST EXECUTABLE STATEMENT CH
if( n<=nm )
%
[nm,n,ar,ai,w,fv1,fv2,fm1]=htridi(nm,n,ar,ai,w,fv1,fv2,fm1);
if( matz~=0 )
% .......... FIND BOTH EIGENVALUES AND EIGENVECTORS ..........
for i = 1 : n;
%
for j = 1 : n;
zr(j,i) = 0.0e0;
end; j = fix(n+1);
%
zr(i,i) = 1.0e0;
end; i = fix(n+1);
%
[nm,n,w,fv1,zr,ierr]=tql2(nm,n,w,fv1,zr,ierr);
if( ierr==0 )
n_orig=n; [nm,n,ar,ai,fm1,dumvar6,zr,zi]=htribk(nm,n,ar,ai,fm1,n,zr,zi); n(dumvar6~=n_orig)=dumvar6(dumvar6~=n_orig);
end;
else;
% .......... FIND EIGENVALUES ONLY ..........
[n,w,fv2,ierr]=tqlrat(n,w,fv2,ierr);
end;
else;
ierr = fix(10.*n);
end;
ar_shape=zeros(ar_shape);ar_shape(:)=ar(1:numel(ar_shape));ar=ar_shape;
ai_shape=zeros(ai_shape);ai_shape(:)=ai(1:numel(ai_shape));ai=ai_shape;
w_shape=zeros(w_shape);w_shape(:)=w(1:numel(w_shape));w=w_shape;
zr_shape=zeros(zr_shape);zr_shape(:)=zr(1:numel(zr_shape));zr=zr_shape;
zi_shape=zeros(zi_shape);zi_shape(:)=zi(1:numel(zi_shape));zi=zi_shape;
fv1_shape=zeros(fv1_shape);fv1_shape(:)=fv1(1:numel(fv1_shape));fv1=fv1_shape;
fv2_shape=zeros(fv2_shape);fv2_shape(:)=fv2(1:numel(fv2_shape));fv2=fv2_shape;
fm1_shape=zeros(fm1_shape);fm1_shape(:)=fm1(1:numel(fm1_shape));fm1=fm1_shape;
end
%DECK CHFCM
|
|