Code covered by the BSD License  

Highlights from
slatec

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

[nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa]=passb(nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa);
function [nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa]=passb(nac,ido,ip,l1,idl1,cc,c1,c2,ch,ch2,wa);
persistent i idij idj idl idlj idot idp ik inc ipp2 ipph j jc k l lc wai war ; 

if isempty(wai), wai=0; end;
if isempty(war), war=0; end;
if isempty(i), i=0; end;
if isempty(idij), idij=0; end;
if isempty(idj), idj=0; end;
if isempty(idl), idl=0; end;
if isempty(idlj), idlj=0; end;
if isempty(idot), idot=0; end;
if isempty(idp), idp=0; end;
if isempty(ik), ik=0; end;
if isempty(inc), inc=0; end;
if isempty(ipp2), ipp2=0; end;
if isempty(ipph), ipph=0; end;
if isempty(j), j=0; end;
if isempty(jc), jc=0; end;
if isempty(k), k=0; end;
if isempty(l), l=0; end;
if isempty(lc), lc=0; end;
%***BEGIN PROLOGUE  PASSB
%***SUBSIDIARY
%***PURPOSE  Calculate the fast Fourier transform of subvectors of
%            arbitrary length.
%***LIBRARY   SLATEC (FFTPACK)
%***TYPE      SINGLE PRECISION (PASSB-S)
%***AUTHOR  Swarztrauber, P. N., (NCAR)
%***ROUTINES CALLED  (NONE)
%***REVISION HISTORY  (YYMMDD)
%   790601  DATE WRITTEN
%   830401  Modified to use SLATEC library source file format.
%   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
%           changing dummy array size declarations (1) to (*).
%   881128  Modified by Dick Valent to meet prologue standards.
%   890831  Modified array declarations.  (WRB)
%   891009  Removed unreferenced variable.  (WRB)
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900402  Added TYPE section.  (WRB)
%***end PROLOGUE  PASSB
ch_shape=size(ch);ch=reshape([ch(:).',zeros(1,ceil(numel(ch)./prod([ido,l1])).*prod([ido,l1])-numel(ch))],ido,l1,[]);
cc_shape=size(cc);cc=reshape([cc(:).',zeros(1,ceil(numel(cc)./prod([ido,ip])).*prod([ido,ip])-numel(cc))],ido,ip,[]);
c1_shape=size(c1);c1=reshape([c1(:).',zeros(1,ceil(numel(c1)./prod([ido,l1])).*prod([ido,l1])-numel(c1))],ido,l1,[]);
wa_shape=size(wa);wa=reshape(wa,1,[]);
c2_shape=size(c2);c2=reshape([c2(:).',zeros(1,ceil(numel(c2)./prod([idl1])).*prod([idl1])-numel(c2))],idl1,[]);
ch2_shape=size(ch2);ch2=reshape([ch2(:).',zeros(1,ceil(numel(ch2)./prod([idl1])).*prod([idl1])-numel(ch2))],idl1,[]);
%***FIRST EXECUTABLE STATEMENT  PASSB
idot = fix(fix(ido./2));
ipp2 = fix(ip + 2);
ipph =fix(fix((ip+1)./2));
idp = fix(ip.*ido);
%
if( ido<l1 )
for j = 2 : ipph;
jc = fix(ipp2 - j);
for i = 1 : ido;
%DIR$ IVDEP
for k = 1 : l1;
ch(i,k,j) = cc(i,j,k) + cc(i,jc,k);
ch(i,k,jc) = cc(i,j,k) - cc(i,jc,k);
end; k = fix(l1+1);
end; i = fix(ido+1);
end; j = fix(ipph+1);
for i = 1 : ido;
%DIR$ IVDEP
for k = 1 : l1;
ch(i,k,1) = cc(i,1,k);
end; k = fix(l1+1);
end; i = fix(ido+1);
else;
for j = 2 : ipph;
jc = fix(ipp2 - j);
for k = 1 : l1;
%DIR$ IVDEP
for i = 1 : ido;
ch(i,k,j) = cc(i,j,k) + cc(i,jc,k);
ch(i,k,jc) = cc(i,j,k) - cc(i,jc,k);
end; i = fix(ido+1);
end; k = fix(l1+1);
end; j = fix(ipph+1);
for k = 1 : l1;
%DIR$ IVDEP
for i = 1 : ido;
ch(i,k,1) = cc(i,1,k);
end; i = fix(ido+1);
end; k = fix(l1+1);
end;
idl = fix(2 - ido);
inc = 0;
for l = 2 : ipph;
lc = fix(ipp2 - l);
idl = fix(idl + ido);
%DIR$ IVDEP
for ik = 1 : idl1;
c2(ik,l) = ch2(ik,1) + wa(idl-1).*ch2(ik,2);
c2(ik,lc) = wa(idl).*ch2(ik,ip);
end; ik = fix(idl1+1);
idlj = fix(idl);
inc = fix(inc + ido);
for j = 3 : ipph;
jc = fix(ipp2 - j);
idlj = fix(idlj + inc);
if( idlj>idp )
idlj = fix(idlj - idp);
end;
war = wa(idlj-1);
wai = wa(idlj);
%DIR$ IVDEP
for ik = 1 : idl1;
c2(ik,l) = c2(ik,l) + war.*ch2(ik,j);
c2(ik,lc) = c2(ik,lc) + wai.*ch2(ik,jc);
end; ik = fix(idl1+1);
end; j = fix(ipph+1);
end; l = fix(ipph+1);
for j = 2 : ipph;
%DIR$ IVDEP
for ik = 1 : idl1;
ch2(ik,1) = ch2(ik,1) + ch2(ik,j);
end; ik = fix(idl1+1);
end; j = fix(ipph+1);
for j = 2 : ipph;
jc = fix(ipp2 - j);
%DIR$ IVDEP
for ik = 2 : 2: idl1 ;
ch2(ik-1,j) = c2(ik-1,j) - c2(ik,jc);
ch2(ik-1,jc) = c2(ik-1,j) + c2(ik,jc);
ch2(ik,j) = c2(ik,j) + c2(ik-1,jc);
ch2(ik,jc) = c2(ik,j) - c2(ik-1,jc);
end; ik = fix(idl1 +1);
end; j = fix(ipph+1);
nac = 1;
if( ido==2 )
ch_shape=zeros(ch_shape);ch_shape(:)=ch(1:numel(ch_shape));ch=ch_shape;
cc_shape=zeros(cc_shape);cc_shape(:)=cc(1:numel(cc_shape));cc=cc_shape;
c1_shape=zeros(c1_shape);c1_shape(:)=c1(1:numel(c1_shape));c1=c1_shape;
wa_shape=zeros(wa_shape);wa_shape(:)=wa(1:numel(wa_shape));wa=wa_shape;
c2_shape=zeros(c2_shape);c2_shape(:)=c2(1:numel(c2_shape));c2=c2_shape;
ch2_shape=zeros(ch2_shape);ch2_shape(:)=ch2(1:numel(ch2_shape));ch2=ch2_shape;
return;
end;
nac = 0;
for ik = 1 : idl1;
c2(ik,1) = ch2(ik,1);
end; ik = fix(idl1+1);
for j = 2 : ip;
%DIR$ IVDEP
for k = 1 : l1;
c1(1,k,j) = ch(1,k,j);
c1(2,k,j) = ch(2,k,j);
end; k = fix(l1+1);
end; j = fix(ip+1);
if( idot>l1 )
idj = fix(2 - ido);
for j = 2 : ip;
idj = fix(idj + ido);
for k = 1 : l1;
idij = fix(idj);
%DIR$ IVDEP
for i = 4 : 2: ido ;
idij = fix(idij + 2);
c1(i-1,k,j) = wa(idij-1).*ch(i-1,k,j) - wa(idij).*ch(i,k,j);
c1(i,k,j) = wa(idij-1).*ch(i,k,j) + wa(idij).*ch(i-1,k,j);
end; i = fix(ido +1);
end; k = fix(l1+1);
end; j = fix(ip+1);
else;
idij = 0;
for j = 2 : ip;
idij = fix(idij + 2);
for i = 4 : 2: ido ;
idij = fix(idij + 2);
%DIR$ IVDEP
for k = 1 : l1;
c1(i-1,k,j) = wa(idij-1).*ch(i-1,k,j) - wa(idij).*ch(i,k,j);
c1(i,k,j) = wa(idij-1).*ch(i,k,j) + wa(idij).*ch(i-1,k,j);
end; k = fix(l1+1);
end; i = fix(ido +1);
end; j = fix(ip+1);
ch_shape=zeros(ch_shape);ch_shape(:)=ch(1:numel(ch_shape));ch=ch_shape;
cc_shape=zeros(cc_shape);cc_shape(:)=cc(1:numel(cc_shape));cc=cc_shape;
c1_shape=zeros(c1_shape);c1_shape(:)=c1(1:numel(c1_shape));c1=c1_shape;
wa_shape=zeros(wa_shape);wa_shape(:)=wa(1:numel(wa_shape));wa=wa_shape;
c2_shape=zeros(c2_shape);c2_shape(:)=c2(1:numel(c2_shape));c2=c2_shape;
ch2_shape=zeros(ch2_shape);ch2_shape(:)=ch2(1:numel(ch2_shape));ch2=ch2_shape;
return;
end;
ch_shape=zeros(ch_shape);ch_shape(:)=ch(1:numel(ch_shape));ch=ch_shape;
cc_shape=zeros(cc_shape);cc_shape(:)=cc(1:numel(cc_shape));cc=cc_shape;
c1_shape=zeros(c1_shape);c1_shape(:)=c1(1:numel(c1_shape));c1=c1_shape;
wa_shape=zeros(wa_shape);wa_shape(:)=wa(1:numel(wa_shape));wa=wa_shape;
c2_shape=zeros(c2_shape);c2_shape(:)=c2(1:numel(c2_shape));c2=c2_shape;
ch2_shape=zeros(ch2_shape);ch2_shape(:)=ch2(1:numel(ch2_shape));ch2=ch2_shape;
end
%DECK PASSF2

Contact us at files@mathworks.com