Code covered by the BSD License  

Highlights from
slatec

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

[ndeg,coeff,root,ierr,work]=cpqr79(ndeg,coeff,root,ierr,work);
function [ndeg,coeff,root,ierr,work]=cpqr79(ndeg,coeff,root,ierr,work);
persistent c k kad khi khr kj km1 kwi kwr scalemlv ; 

if isempty(km1), km1=0; end;
%***BEGIN PROLOGUE  CPQR79
%***PURPOSE  Find the zeros of a polynomial with complex coefficients.
%***LIBRARY   SLATEC
%***CATEGORY  F1A1B
%***TYPE      COMPLEX (RPQR79-S, CPQR79-C)
%***KEYWORDS  COMPLEX POLYNOMIAL, POLYNOMIAL ROOTS, POLYNOMIAL ZEROS
%***AUTHOR  Vandevender, W. H., (SNLA)
%***DESCRIPTION
%
%   Abstract
%       This routine computes all zeros of a polynomial of degree NDEG
%       with complex coefficients by computing the eigenvalues of the
%       companion matrix.
%
%   Description of Parameters
%       The user must dimension all arrays appearing in the call list
%            COEFF(NDEG+1), ROOT(NDEG), WORK(2*NDEG*(NDEG+1))
%
%    --Input--
%      NDEG    degree of polynomial
%
%      COEFF   COMPLEX coefficients in descending order.  i.e.,
%              P(Z)= COEFF(1)*(Z**NDEG) + COEFF(NDEG)*Z + COEFF(NDEG+1)
%
%      WORK    REAL work array of dimension at least 2*NDEG*(NDEG+1)
%
%   --Output--
%      ROOT    COMPLEX vector of roots
%
%      IERR    Output Error Code
%           - Normal Code
%          0  means the roots were computed.
%           - Abnormal Codes
%          1  more than 30 QR iterations on some eigenvalue of the
%             companion matrix
%          2  COEFF(1)=0.0
%          3  NDEG is invalid (less than or equal to 0)
%
%***REFERENCES  (NONE)
%***ROUTINES CALLED  COMQR, XERMSG
%***REVISION HISTORY  (YYMMDD)
%   791201  DATE WRITTEN
%   890531  Changed all specific intrinsics to generic.  (WRB)
%   890531  REVISION DATE from Version 3.2
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
%   900326  Removed duplicate information from DESCRIPTION section.
%           (WRB)
%   911010  Code reworked and simplified.  (RWC and WRB)
%***end PROLOGUE  CPQR79
coeff_shape=size(coeff);coeff=reshape(coeff,1,[]);
root_shape=size(root);root=reshape(root,1,[]);
if isempty(scalemlv), scalemlv=0; end;
if isempty(c), c=0; end;
work_shape=size(work);work=reshape(work,1,[]);
if isempty(k), k=0; end;
if isempty(khr), khr=0; end;
if isempty(khi), khi=0; end;
if isempty(kwr), kwr=0; end;
if isempty(kwi), kwi=0; end;
if isempty(kad), kad=0; end;
if isempty(kj), kj=0; end;
%***FIRST EXECUTABLE STATEMENT  CPQR79
ierr = 0;
if( abs(coeff(1))==0.0 )
ierr = 2;
xermsg('SLATEC','CPQR79','LEADING COEFFICIENT IS ZERO.',2,1);
coeff_shape=zeros(coeff_shape);coeff_shape(:)=coeff(1:numel(coeff_shape));coeff=coeff_shape;
root_shape=zeros(root_shape);root_shape(:)=root(1:numel(root_shape));root=root_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
return;
end;
%
if( ndeg<=0 )
ierr = 3;
xermsg('SLATEC','CPQR79','DEGREE INVALID.',3,1);
coeff_shape=zeros(coeff_shape);coeff_shape(:)=coeff(1:numel(coeff_shape));coeff=coeff_shape;
root_shape=zeros(root_shape);root_shape(:)=root(1:numel(root_shape));root=root_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
return;
end;
%
if( ndeg==1 )
root(1) = -coeff(2)./coeff(1);
coeff_shape=zeros(coeff_shape);coeff_shape(:)=coeff(1:numel(coeff_shape));coeff=coeff_shape;
root_shape=zeros(root_shape);root_shape(:)=root(1:numel(root_shape));root=root_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
return;
end;
%
scalemlv = 1.0e0./coeff(1);
khr = 1;
khi = fix(khr + ndeg.*ndeg);
kwr = fix(khi + khi - khr);
kwi = fix(kwr + ndeg);
%
for k = 1 : kwr;
work(k) = 0.0e0;
end; k = fix(kwr+1);
%
for k = 1 : ndeg;
kad =fix((k-1).*ndeg + 1);
c = scalemlv.*coeff(k+1);
work(kad) = -real(c);
kj = fix(khi + kad - 1);
work(kj) = -imag(c);
if( k~=ndeg )
work(kad+k) = 1.0e0;
end;
end; k = fix(ndeg+1);
%
ndeg_orig=ndeg; ndeg_orig=ndeg;    [ndeg,dumvar2,dumvar3,dumvar4,dumvar5,dumvar6,dumvar7,dumvar8,ierr]=comqr(ndeg,ndeg,1,ndeg,work(sub2ind(size(work),max(khr,1)):end),work(sub2ind(size(work),max(khi,1)):end),work(sub2ind(size(work),max(kwr,1)):end),work(sub2ind(size(work),max(kwi,1)):end),ierr);    ndeg(dumvar4~=ndeg_orig)=dumvar4(dumvar4~=ndeg_orig); ndeg(dumvar2~=ndeg_orig)=dumvar2(dumvar2~=ndeg_orig);   dumvar5i=find((work(sub2ind(size(work),max(khr,1)):end))~=(dumvar5));dumvar6i=find((work(sub2ind(size(work),max(khi,1)):end))~=(dumvar6));dumvar7i=find((work(sub2ind(size(work),max(kwr,1)):end))~=(dumvar7));dumvar8i=find((work(sub2ind(size(work),max(kwi,1)):end))~=(dumvar8));   work(khr-1+dumvar5i)=dumvar5(dumvar5i); work(khi-1+dumvar6i)=dumvar6(dumvar6i); work(kwr-1+dumvar7i)=dumvar7(dumvar7i); work(kwi-1+dumvar8i)=dumvar8(dumvar8i); 
%
if( ierr~=0 )
ierr = 1;
xermsg('SLATEC','CPQR79','NO CONVERGENCE IN 30 QR ITERATIONS.',1,1);
coeff_shape=zeros(coeff_shape);coeff_shape(:)=coeff(1:numel(coeff_shape));coeff=coeff_shape;
root_shape=zeros(root_shape);root_shape(:)=root(1:numel(root_shape));root=root_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
return;
end;
%
for k = 1 : ndeg;
km1 = fix(k - 1);
root(k) = complex(work(kwr+km1),work(kwi+km1));
end; k = fix(ndeg+1);
coeff_shape=zeros(coeff_shape);coeff_shape(:)=coeff(1:numel(coeff_shape));coeff=coeff_shape;
root_shape=zeros(root_shape);root_shape(:)=root(1:numel(root_shape));root=root_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
end
%DECK CPROC

Contact us at files@mathworks.com