Code covered by the BSD License  

Highlights from
slatec

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

[ncomp,lnfc,yhp,work,iwork,inhomo,iflag]=dvecs(ncomp,lnfc,yhp,work,iwork,inhomo,iflag);
function [ncomp,lnfc,yhp,work,iwork,inhomo,iflag]=dvecs(ncomp,lnfc,yhp,work,iwork,inhomo,iflag);
%***BEGIN PROLOGUE  DVECS
%***SUBSIDIARY
%***PURPOSE  Subsidiary to DBVSUP
%***LIBRARY   SLATEC
%***TYPE      doubleprecision (SVECS-S, DVECS-D)
%***AUTHOR  Watts, H. A., (SNLA)
%***DESCRIPTION
%
%  This subroutine is used for the special structure of COMPLEX*16
%  valued problems. DMGSBV is called upon to obtain LNFC vectors from an
%  original set of 2*LNFC independent vectors so that the resulting
%  LNFC vectors together with their imaginary product or mate vectors
%  form an independent set.
%
%***SEE ALSO  DBVSUP
%***ROUTINES CALLED  DMGSBV
%***COMMON BLOCKS    DML18J
%***REVISION HISTORY  (YYMMDD)
%   750601  DATE WRITTEN
%   890831  Modified array declarations.  (WRB)
%   890921  Realigned order of variables in certain COMMON blocks.
%           (WRB)
%   891009  Removed unreferenced statement label.  (WRB)
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900328  Added TYPE section.  (WRB)
%   910722  Updated AUTHOR section.  (ALS)
%***end PROLOGUE  DVECS
%
persistent dum idp k kp niv ; 

global dml18j_18; if isempty(dml18j_18), dml18j_18=0; end;
if isempty(idp), idp=0; end;
global dml18j_11; if isempty(dml18j_11), dml18j_11=0; end;
global dml18j_12; if isempty(dml18j_12), dml18j_12=0; end;
iwork_shape=size(iwork);iwork=reshape(iwork,1,[]);
if isempty(k), k=0; end;
if isempty(kp), kp=0; end;
global dml18j_17; if isempty(dml18j_17), dml18j_17=0; end;
global dml18j_7; if isempty(dml18j_7), dml18j_7=0; end;
global dml18j_8; if isempty(dml18j_8), dml18j_8=0; end;
global dml18j_10; if isempty(dml18j_10), dml18j_10=0; end;
global dml18j_15; if isempty(dml18j_15), dml18j_15=0; end;
global dml18j_5; if isempty(dml18j_5), dml18j_5=0; end;
if isempty(niv), niv=0; end;
global dml18j_6; if isempty(dml18j_6), dml18j_6=0; end;
global dml18j_13; if isempty(dml18j_13), dml18j_13=0; end;
global dml18j_9; if isempty(dml18j_9), dml18j_9=0; end;
global dml18j_14; if isempty(dml18j_14), dml18j_14=0; end;
global dml18j_16; if isempty(dml18j_16), dml18j_16=0; end;
global dml18j_4; if isempty(dml18j_4), dml18j_4=0; end;
global dml18j_1; if isempty(dml18j_1), dml18j_1=0; end;
if isempty(dum), dum=0; end;
global dml18j_2; if isempty(dml18j_2), dml18j_2=0; end;
global dml18j_3; if isempty(dml18j_3), dml18j_3=0; end;
work_shape=size(work);work=reshape(work,1,[]);
yhp_shape=size(yhp);yhp=reshape([yhp(:).',zeros(1,ceil(numel(yhp)./prod([ncomp])).*prod([ncomp])-numel(yhp))],ncomp,[]);
% common :: ;
%% common /dml18j/ ae , re , tol , nxpts , nic , nopg , mxnon ,ndisk , ntape , neq , indpvt , integ , nps , ntp ,neqivp , numort , lnfcc , icoco;
%% common /dml18j/ dml18j_1 , dml18j_2 , dml18j_3 , dml18j_4 , dml18j_5 , dml18j_6 , dml18j_7 ,dml18j_8 , dml18j_9 , dml18j_10 , dml18j_11 , dml18j_12 , dml18j_13 , dml18j_14 ,dml18j_15 , dml18j_16 , dml18j_17 , dml18j_18;
%***FIRST EXECUTABLE STATEMENT  DVECS
if( lnfc~=1 )
niv = fix(lnfc);
lnfc = fix(2.*lnfc);
dml18j_17 = fix(2.*dml18j_17);
kp = fix(lnfc + 2 + dml18j_17);
idp = fix(dml18j_11);
dml18j_11 = 0;
ncomp_orig=ncomp;    [ncomp,lnfc,yhp,dumvar4,niv,iflag,dumvar7,dumvar8,idumvar7,inhomo,dumvar11,dumvar12,dum]=dmgsbv(ncomp,lnfc,yhp,ncomp,niv,iflag,work(sub2ind(size(work),max(1,1)):end),work(sub2ind(size(work),max(kp,1)):end),iwork(sub2ind(size(work),max(1,1)):end),inhomo,yhp(sub2ind(size(yhp),1,lnfc+1):end),work(sub2ind(size(work),max(lnfc+2,1)):end),dum);    ncomp(dumvar4~=ncomp_orig)=dumvar4(dumvar4~=ncomp_orig);   dumvar7i=find((work(sub2ind(size(work),max(1,1)):end))~=(dumvar7));dumvar8i=find((work(sub2ind(size(work),max(kp,1)):end))~=(dumvar8));dumvar12i=find((work(sub2ind(size(work),max(lnfc+2,1)):end))~=(dumvar12));   work(1-1+dumvar7i)=dumvar7(dumvar7i); work(kp-1+dumvar8i)=dumvar8(dumvar8i); yhp(sub2ind(size(yhp),1,lnfc+1):end)=dumvar11; work(lnfc+2-1+dumvar12i)=dumvar12(dumvar12i); 
lnfc = fix(fix(lnfc./2));
dml18j_17 = fix(fix(dml18j_17./2));
dml18j_11 = fix(idp);
if( iflag~=0 || niv~=lnfc )
iflag = 99;
else;
for k = 1 : ncomp;
yhp(k,lnfc+1) = yhp(k,dml18j_17+1);
end; k = fix(ncomp+1);
iflag = 1;
end;
else;
for k = 1 : ncomp;
yhp(k,lnfc+1) = yhp(k,dml18j_17+1);
end; k = fix(ncomp+1);
iflag = 1;
end;
iwork_shape=zeros(iwork_shape);iwork_shape(:)=iwork(1:numel(iwork_shape));iwork=iwork_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
yhp_shape=zeros(yhp_shape);yhp_shape(:)=yhp(1:numel(yhp_shape));yhp=yhp_shape;
end
%DECK DVNRMS

Contact us at files@mathworks.com