Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,45 @@
+      SUBROUTINE savgol(c,np,nl,nr,ld,m)
+      INTEGER ld,m,nl,np,nr,MMAX
+      REAL c(np)
+      PARAMETER (MMAX=6)
+CU    USES lubksb,ludcmp
+      INTEGER imj,ipj,j,k,kk,mm,indx(MMAX+1)
+      REAL d,fac,sum,a(MMAX+1,MMAX+1),b(MMAX+1)
+      if(np.lt.nl+nr+
+     *1.or.nl.lt.0.or.nr.lt.0.or.ld.gt.m.or.m.gt.MMAX.or.nl+nr.lt.m) 
+     *pause 'bad args in savgol'
+      do 14 ipj=0,2*m
+        sum=0.
+        if(ipj.eq.0)sum=1.
+        do 11 k=1,nr
+          sum=sum+float(k)**ipj
+11      continue
+        do 12 k=1,nl
+          sum=sum+float(-k)**ipj
+12      continue
+        mm=min(ipj,2*m-ipj)
+        do 13 imj=-mm,mm,2
+          a(1+(ipj+imj)/2,1+(ipj-imj)/2)=sum
+13      continue
+14    continue
+      call ludcmp(a,m+1,MMAX+1,indx,d)
+      do 15 j=1,m+1
+        b(j)=0.
+15    continue
+      b(ld+1)=1.
+      call lubksb(a,m+1,MMAX+1,indx,b)
+      do 16 kk=1,np
+        c(kk)=0.
+16    continue
+      do 18 k=-nl,nr
+        sum=b(1)
+        fac=1.
+        do 17 mm=1,m
+          fac=fac*k
+          sum=sum+b(mm+1)*fac
+17      continue
+        kk=mod(np-k,np)+1
+        c(kk)=sum
+18    continue
+      return
+      END