Repatch (from linux) of OSX IRAF

1 files changed, 412 insertions, 0 deletions

diff --git a/math/ieee/chap1/weave2.f b/math/ieee/chap1/weave2.f
new file mode 100644
index 00000000..5c04ff91
--- /dev/null
+++ b/math/ieee/chap1/weave2.f
@@ -0,0 +1,412 @@
+c
+c-----------------------------------------------------------------------
+c
+c subroutine: weave2
+c   this subroutine implements the post-weave modules
+c   of the wfta.  the working arrays are sr and si.
+c   the routine checks to see which factors are present
+c   in the transform length n = na*nb*nc*nd and executes
+c   the post-weave code for these factors.
+c
+c-----------------------------------------------------------------------
+c
+      subroutine weave2(sr,si)
+      common na,nb,nc,nd,nd1,nd2,nd3,nd4
+      dimension sr(1),si(1)
+      dimension q(8),t(16)
+      if(nd.ne.5) go to 700
+c
+c **********************************************************************
+c
+c     the following code implements the 5 point post-weave module
+c
+c **********************************************************************
+c
+      noff=nd1*nd2*nd3
+      nbase=1
+      do 510 n1=1,noff
+      nr1=nbase+noff
+      nr2=nr1+noff
+      nr3=nr2+noff
+      nr4=nr3+noff
+      nr5=nr4+noff
+      t1=sr(nbase)+sr(nr1)
+      t3=t1-sr(nr3)
+      t1=t1+sr(nr3)
+      t4=si(nr2)+si(nr5)
+      t2=si(nr4)+si(nr5)
+      sr(nr1)=t1-t4
+      sr4=t1+t4
+      sr2=t3+t2
+      sr(nr3)=t3-t2
+      t1=si(nbase)+si(nr1)
+      t3=t1-si(nr3)
+      t1=t1+si(nr3)
+      t4=sr(nr2)+sr(nr5)
+      t2=sr(nr4)+sr(nr5)
+      si(nr1)=t1+t4
+      si(nr4)=t1-t4
+      si(nr2)=t3-t2
+      si(nr3)=t3+t2
+      sr(nr2)=sr2
+      sr(nr4)=sr4
+510   nbase=nbase+1
+700   if(nc.ne.7) go to 300
+c
+c **********************************************************************
+c
+c     the following code implements the 7 point post-weave module
+c
+c **********************************************************************
+c
+      noff=nd1*nd2
+      nbase=1
+      nlup2=8*noff
+      do 740 n4=1,nd
+      do 710 n1=1,noff
+      nr1=nbase+noff
+      nr2=nr1+noff
+      nr3=nr2+noff
+      nr4=nr3+noff
+      nr5=nr4+noff
+      nr6=nr5+noff
+      nr7=nr6+noff
+      nr8=nr7+noff
+      t1=sr(nr1)+sr(nbase)
+      t2=t1-sr(nr3)-sr(nr4)
+      t4=t1+sr(nr3)-sr(nr7)
+      t1=t1+sr(nr4)+sr(nr7)
+      t6=si(nr2)+si(nr5)+si(nr8)
+      t5=si(nr2)-si(nr5)-si(nr6)
+      t3=si(nr2)+si(nr6)-si(nr8)
+      sr(nr1)=t1-t6
+      sr6=t1+t6
+      sr2=t2-t5
+      sr5=t2+t5
+      sr(nr4)=t4-t3
+      sr(nr3)=t4+t3
+      t1=si(nr1)+si(nbase)
+      t2=t1-si(nr3)-si(nr4)
+      t4=t1+si(nr3)-si(nr7)
+      t1=t1+si(nr4)+si(nr7)
+      t6=sr(nr2)+sr(nr5)+sr(nr8)
+      t5=sr(nr2)-sr(nr5)-sr(nr6)
+      t3=sr(nr2)+sr(nr6)-sr(nr8)
+      si(nr1)=t1+t6
+      si(nr6)=t1-t6
+      si(nr2)=t2+t5
+      si(nr5)=t2-t5
+      si(nr4)=t4+t3
+      si(nr3)=t4-t3
+      sr(nr2)=sr2
+      sr(nr5)=sr5
+      sr(nr6)=sr6
+710   nbase=nbase+1
+740   nbase=nbase+nlup2
+300   if(nb.eq.1) go to 400
+      if(nb.ne.3) go to 900
+c
+c **********************************************************************
+c
+c     the following code implements the 3 point post-weave module
+c
+c **********************************************************************
+c
+      nlup2=2*nd1
+      nlup23=3*nd1*(nd3-nc)
+      nbase=1
+      noff=nd1
+      do 340 n5=1,nd
+      do 330 n4=1,nc
+      do 310 n2=1,nd1
+      nr1=nbase+noff
+      nr2=nr1+noff
+      t1=sr(nbase)+sr(nr1)
+      sr(nr1)=t1-si(nr2)
+      sr2=t1+si(nr2)
+      t1=si(nbase)+si(nr1)
+      si(nr1)=t1+sr(nr2)
+      si(nr2)=t1-sr(nr2)
+      sr(nr2)=sr2
+310   nbase=nbase+1
+330   nbase=nbase+nlup2
+340   nbase=nbase+nlup23
+900   if(nb.ne.9) go to 400
+c
+c **********************************************************************
+c
+c     the following code implements the 9 point post-weave module
+c
+c **********************************************************************
+c
+      nlup2=10*nd1
+      nlup23=11*nd1*(nd3-nc)
+      nbase=1
+      noff=nd1
+      do 940 n4=1,nd
+      do 930 n3=1,nc
+      do 910 n2=1,nd1
+      nr1=nbase+noff
+      nr2=nr1+noff
+      nr3=nr2+noff
+      nr4=nr3+noff
+      nr5=nr4+noff
+      nr6=nr5+noff
+      nr7=nr6+noff
+      nr8=nr7+noff
+      nr9=nr8+noff
+      nr10=nr9+noff
+      t3=sr(nbase)-sr(nr3)
+      t7=sr(nbase)+sr(nr1)
+      sr(nbase)=sr(nbase)+sr(nr3)+sr(nr3)
+      t6=t3+si(nr10)
+      sr(nr3)=t3-si(nr10)
+      t4=t7+sr(nr5)-sr(nr6)
+      t1=t7-sr(nr4)-sr(nr5)
+      t7=t7+sr(nr4)+sr(nr6)
+      sr(nr6)=t6
+      t8=si(nr2)-si(nr7)-si(nr8)
+      t5=si(nr2)+si(nr8)-si(nr9)
+      t2=si(nr2)+si(nr7)+si(nr9)
+      sr(nr1)=t7-t2
+      sr8=t7+t2
+      sr(nr4)=t1-t8
+      sr(nr5)=t1+t8
+      sr7=t4-t5
+      sr2=t4+t5
+      t3=si(nbase)-si(nr3)
+      t7=si(nbase)+si(nr1)
+      si(nbase)=si(nbase)+si(nr3)+si(nr3)
+      t6=t3-sr(nr10)
+      si(nr3)=t3+sr(nr10)
+      t4=t7+si(nr5)-si(nr6)
+      t1=t7-si(nr4)-si(nr5)
+      t7=t7+si(nr4)+si(nr6)
+      si(nr6)=t6
+      t8=sr(nr2)-sr(nr7)-sr(nr8)
+      t5=sr(nr2)+sr(nr8)-sr(nr9)
+      t2=sr(nr2)+sr(nr7)+sr(nr9)
+      si(nr1)=t7+t2
+      si(nr8)=t7-t2
+      si(nr4)=t1+t8
+      si(nr5)=t1-t8
+      si(nr7)=t4+t5
+      si(nr2)=t4-t5
+      sr(nr2)=sr2
+      sr(nr7)=sr7
+      sr(nr8)=sr8
+910   nbase=nbase+1
+930   nbase=nbase+nlup2
+940   nbase=nbase+nlup23
+400   if(na.eq.1) return
+      if(na.ne.4) go to 800
+c
+c **********************************************************************
+c
+c     the following code implements the 4 point post-weave module
+c
+c **********************************************************************
+c
+      nlup2=4*(nd2-nb)
+      nlup23=4*nd2*(nd3-nc)
+      nbase=1
+      do 440 n4=1,nd
+      do 430 n3=1,nc
+      do 420 n2=1,nb
+      nr1=nbase+1
+      nr2=nr1+1
+      nr3=nr2+1
+      tr0=sr(nbase)+sr(nr2)
+      tr2=sr(nbase)-sr(nr2)
+      tr1=sr(nr1)+sr(nr3)
+      tr3=sr(nr1)-sr(nr3)
+      ti1=si(nr1)+si(nr3)
+      ti3=si(nr1)-si(nr3)
+      sr(nbase)=tr0+tr1
+      sr(nr2)=tr0-tr1
+      sr(nr1)=tr2+ti3
+      sr(nr3)=tr2-ti3
+      ti0=si(nbase)+si(nr2)
+      ti2=si(nbase)-si(nr2)
+      si(nbase)=ti0+ti1
+      si(nr2)=ti0-ti1
+      si(nr1)=ti2-tr3
+      si(nr3)=ti2+tr3
+420   nbase=nbase+4
+430   nbase=nbase+nlup2
+440   nbase=nbase+nlup23
+800   if(na.ne.8) go to 1600
+c
+c **********************************************************************
+c
+c     the following code implements the 8 point post-weave module
+c
+c **********************************************************************
+c
+      nlup2=8*(nd2-nb)
+      nlup23=8*nd2*(nd3-nc)
+      nbase=1
+      do 840 n4=1,nd
+      do 830 n3=1,nc
+      do 820 n2=1,nb
+      nr1=nbase+1
+      nr2=nr1+1
+      nr3=nr2+1
+      nr4=nr3+1
+      nr5=nr4+1
+      nr6=nr5+1
+      nr7=nr6+1
+      t1=sr(nbase)-sr(nr1)
+      sr(nbase)=sr(nbase)+sr(nr1)
+      sr6=sr(nr2)+si(nr3)
+      sr(nr2)=sr(nr2)-si(nr3)
+      t4=sr(nr4)-si(nr5)
+      t5=sr(nr4)+si(nr5)
+      t6=sr(nr7)-si(nr6)
+      t7=sr(nr7)+si(nr6)
+      sr(nr4)=t1
+      sr(nr1)=t4+t6
+      sr3=t4-t6
+      sr5=t5-t7
+      sr(nr7)=t5+t7
+      t1=si(nbase)-si(nr1)
+      si(nbase)=si(nbase)+si(nr1)
+      t3=si(nr2)-sr(nr3)
+      si(nr2)=si(nr2)+sr(nr3)
+      t4=si(nr4)+sr(nr5)
+      t5=si(nr4)-sr(nr5)
+      si(nr6)=t3
+      t6=sr(nr6)+si(nr7)
+      t7=sr(nr6)-si(nr7)
+      si(nr4)=t1
+      si(nr1)=t4+t6
+      si(nr3)=t4-t6
+      si(nr5)=t5+t7
+      si(nr7)=t5-t7
+      sr(nr3)=sr3
+      sr(nr5)=sr5
+      sr(nr6)=sr6
+820   nbase=nbase+8
+830   nbase=nbase+nlup2
+840   nbase=nbase+nlup23
+1600  if(na.ne.16) return
+c
+c **********************************************************************
+c
+c     the following code implements the 16 point post-weave module
+c
+c **********************************************************************
+c
+      nlup2=18*(nd2-nb)
+      nlup23=18*nd2*(nd3-nc)
+      nbase=1
+      do 1640 n4=1,nd
+      do 1630 n3=1,nc
+      do 1620 n2=1,nb
+      nr1=nbase+1
+      nr2=nr1+1
+      nr3=nr2+1
+      nr4=nr3+1
+      nr5=nr4+1
+      nr6=nr5+1
+      nr7=nr6+1
+      nr8=nr7+1
+      nr9=nr8+1
+      nr10=nr9+1
+      nr11=nr10+1
+      nr12=nr11+1
+      nr13=nr12+1
+      nr14=nr13+1
+      nr15=nr14+1
+      nr16=nr15+1
+      nr17=nr16+1
+      t(2)=sr(nbase)-sr(nr1)
+      sr(nbase)=sr(nr1)+sr(nbase)
+      t(4)=sr(nr2)+si(nr3)
+      t(3)=sr(nr2)-si(nr3)
+      t(6)=sr(nr4)+si(nr5)
+      t(5)=sr(nr4)-si(nr5)
+      t(8)=-si(nr6)-sr(nr7)
+      t(7)=-si(nr6)+sr(nr7)
+      t(9)=sr(nr8)+sr(nr14)
+      t(15)=sr(nr8)-sr(nr14)
+      t(13)=-si(nr10)-si(nr12)
+      t(11)=si(nr10)-si(nr12)
+      t(16)=sr(nr15)-sr(nr17)
+      t(12)=sr(nr11)-sr(nr17)
+      t(10)=-si(nr9)-si(nr16)
+      t(14)=-si(nr16)+si(nr13)
+      sr(nr2)=t(5)+t(7)
+      sr6=t(5)-t(7)
+      sr10=t(6)+t(8)
+      sr(nr14)=t(6)-t(8)
+      q(7)=t(9)+t(10)
+      q(8)=t(9)-t(10)
+      q(1)=t(11)+t(12)
+      q(2)=t(11)-t(12)
+      q(4)=t(14)+t(15)
+      q(5)=t(15)-t(14)
+      q(3)=t(13)+t(16)
+      q(6)=t(13)-t(16)
+      sr(nr1)=q(3)+q(7)
+      sr(nr7)=q(7)-q(3)
+      sr9=q(8)+q(6)
+      sr(nr15)=q(8)-q(6)
+      sr5=q(1)+q(4)
+      sr3=q(4)-q(1)
+      sr13=q(2)+q(5)
+      sr11=q(5)-q(2)
+      sr(nr8)=t(2)
+      sr(nr4)=t(3)
+      sr12=t(4)
+      t(2)=si(nbase)-si(nr1)
+      si(nbase)=si(nr1)+si(nbase)
+      t(4)=si(nr2)-sr(nr3)
+      t(3)=si(nr2)+sr(nr3)
+      t(6)=si(nr4)-sr(nr5)
+      t(5)=si(nr4)+sr(nr5)
+      t(8)=sr(nr6)-si(nr7)
+      t(7)=sr(nr6)+si(nr7)
+      t(9)=si(nr8)+si(nr14)
+      t(15)=si(nr8)-si(nr14)
+      t(13)=sr(nr10)+sr(nr12)
+      t(11)=sr(nr12)-sr(nr10)
+      t(16)=si(nr15)-si(nr17)
+      t(12)=si(nr11)-si(nr17)
+      t(10)=sr(nr9)+sr(nr16)
+      si(nr2)=t(5)+t(7)
+      si(nr6)=t(5)-t(7)
+      si(nr10)=t(6)+t(8)
+      si(nr14)=t(6)-t(8)
+      q(7)=t(9)+t(10)
+      q(8)=t(9)-t(10)
+      q(1)=t(11)+t(12)
+      q(2)=t(11)-t(12)
+      q(4)=t(14)+t(15)
+      q(5)=t(15)-t(14)
+      q(3)=t(13)+t(16)
+      q(6)=t(13)-t(16)
+      si(nr1)=q(3)+q(7)
+      si(nr7)=q(7)-q(3)
+      si(nr9)=q(8)+q(6)
+      si(nr15)=q(8)-q(6)
+      si(nr5)=q(1)+q(4)
+      si(nr3)=q(4)-q(1)
+      si(nr13)=q(2)+q(5)
+      si(nr11)=q(5)-q(2)
+      si(nr8)=t(2)
+      si(nr4)=t(3)
+      si(nr12)=t(4)
+      sr(nr3)=sr3
+      sr(nr5)=sr5
+      sr(nr6)=sr6
+      sr(nr9)=sr9
+      sr(nr10)=sr10
+      sr(nr11)=sr11
+      sr(nr12)=sr12
+      sr(nr13)=sr13
+1620  nbase=nbase+18
+1630  nbase=nbase+nlup2
+1640  nbase=nbase+nlup23
+      return
+      end