| 
									
										
										
										
											2015-04-22 17:48:03 +00:00
										 |  |  | subroutine polyfit(x,y,sigmay,npts,nterms,mode,a,chisqr)
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  |   implicit real*8 (a-h,o-z)
 | 
					
						
							|  |  |  |   real*8 x(npts), y(npts), sigmay(npts), a(nterms)
 | 
					
						
							| 
									
										
										
										
											2016-11-30 00:40:50 +00:00
										 |  |  |   real*8 sumx(10), sumy(10), array(10,10)
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | ! Accumulate weighted sums
 | 
					
						
							|  |  |  |   nmax = 2*nterms-1
 | 
					
						
							|  |  |  |   sumx=0.
 | 
					
						
							|  |  |  |   sumy=0.
 | 
					
						
							|  |  |  |   chisq=0.
 | 
					
						
							|  |  |  |   do i=1,npts
 | 
					
						
							|  |  |  |      xi=x(i)
 | 
					
						
							|  |  |  |      yi=y(i)
 | 
					
						
							|  |  |  |      if(mode.lt.0) then
 | 
					
						
							|  |  |  |         weight=1./abs(yi)
 | 
					
						
							|  |  |  |      else if(mode.eq.0) then
 | 
					
						
							|  |  |  |         weight=1
 | 
					
						
							|  |  |  |      else
 | 
					
						
							|  |  |  |         weight=1./sigmay(i)**2
 | 
					
						
							|  |  |  |      end if
 | 
					
						
							|  |  |  |      xterm=weight
 | 
					
						
							|  |  |  |      do n=1,nmax
 | 
					
						
							|  |  |  |         sumx(n)=sumx(n)+xterm
 | 
					
						
							|  |  |  |         xterm=xterm*xi
 | 
					
						
							|  |  |  |      enddo
 | 
					
						
							|  |  |  |      yterm=weight*yi
 | 
					
						
							|  |  |  |      do n=1,nterms
 | 
					
						
							|  |  |  |         sumy(n)=sumy(n)+yterm
 | 
					
						
							|  |  |  |         yterm=yterm*xi
 | 
					
						
							|  |  |  |      enddo
 | 
					
						
							|  |  |  |      chisq=chisq+weight*yi**2
 | 
					
						
							|  |  |  |   enddo
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Construct matrices and calculate coefficients
 | 
					
						
							|  |  |  |   do j=1,nterms
 | 
					
						
							|  |  |  |      do k=1,nterms
 | 
					
						
							|  |  |  |         n=j+k-1
 | 
					
						
							|  |  |  |         array(j,k)=sumx(n)
 | 
					
						
							|  |  |  |      enddo
 | 
					
						
							|  |  |  |   enddo
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   delta=determ(array,nterms)
 | 
					
						
							|  |  |  |   if(delta.eq.0) then
 | 
					
						
							|  |  |  |      chisqr=0.
 | 
					
						
							|  |  |  |      a=0.
 | 
					
						
							|  |  |  |   else
 | 
					
						
							|  |  |  |      do l=1,nterms
 | 
					
						
							|  |  |  |         do j=1,nterms
 | 
					
						
							|  |  |  |            do k=1,nterms
 | 
					
						
							|  |  |  |               n=j+k-1
 | 
					
						
							|  |  |  |               array(j,k)=sumx(n)
 | 
					
						
							|  |  |  |            enddo
 | 
					
						
							|  |  |  |            array(j,l)=sumy(j)
 | 
					
						
							|  |  |  |         enddo
 | 
					
						
							|  |  |  |         a(l)=determ(array,nterms)/delta
 | 
					
						
							|  |  |  |      enddo
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Calculate chi square
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |      do j=1,nterms
 | 
					
						
							|  |  |  |         chisq=chisq-2*a(j)*sumy(j)
 | 
					
						
							|  |  |  |         do k=1,nterms
 | 
					
						
							|  |  |  |            n=j+k-1
 | 
					
						
							|  |  |  |            chisq=chisq+a(j)*a(k)*sumx(n)
 | 
					
						
							|  |  |  |         enddo
 | 
					
						
							|  |  |  |      enddo
 | 
					
						
							|  |  |  |      free=npts-nterms
 | 
					
						
							|  |  |  |      chisqr=chisq/free
 | 
					
						
							|  |  |  |   end if
 | 
					
						
							|  |  |  |   
 | 
					
						
							|  |  |  |   return
 | 
					
						
							| 
									
										
										
										
											2015-04-22 17:48:03 +00:00
										 |  |  | end subroutine polyfit
 |