perm filename POLFIT.F4[NET,GUE]1 blob
sn#028806 filedate 1973-03-12 generic text, type T, neo UTF8
subroutine polfit
common /fit/x,y,sigmay,npts,mode
common /pfit/nterms,a,chisqr
double precision x,y,sigmay,a,chisqr
double precision sumx,sumy,xterm,yterm,array,chisq
integer npts,mode
dimension x(50),y(50),sigmay(50),a(10)
dimension sumx(19),sumy(10),array(10,10)
11 nmax=2*nterms-1
do 13 n=1,nmax
13 sumx(n)=0.
do 15 j=1,nterms
15 sumy(j)=0.
chisq=0.
21 do 50 i=1,npts
xi=x(i)
yi=y(i)
31 if (mode) 32,37,39
32 if (yi) 35,37,33
33 weight=1./yi
goto 41
35 weight=1./(-yi)
goto 41
37 weight=1.
goto 41
39 weight=1./sigmay(i)**2
41 xterm=weight
do 44 n=1,nmax
sumx(n)=sumx(n)+xterm
44 xterm=xterm*xi
45 yterm=weight*yi
do 48 n=1,nterms
sumy(n)=sumy(n)+yterm
48 yterm=yterm*xi
49 chisq=chisq+weight*yi**2
50 continue
51 do 54 j=1,nterms
do 54 k=1,nterms
n=j+k-1
54 array(j,k)=sumx(n)
detla=determ(array,nterms)
if (delta) 61,57,61
57 chisqr=0.
do 59 j=1,nterms
59 a(j)=0.
goto 80
61 do 70 l=1,nterms
62 do 66 j=1,nterms
do 65 k=1,nterms
n=j+k-1
65 array(j,k)=sumx(n)
66 array(j,l)=sumy(j)
70 a(l)=determ(array,nterms)/delta
71 do 75 j=1,nterms
chisq=chisq-2.*a(j)*sumy(j)
do 75 k=1,nterms
n=j+k-1
75 chisq=chisq+a(j)*a(k)*sumx(n)
76 free=npts-nterms
77 chisqr=chisq/free
80 return
end