46 lines
1.1 KiB
Fortran
46 lines
1.1 KiB
Fortran
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
|