| 
									
										
										
										
											2014-01-08 20:55:11 +00:00
										 |  |  | subroutine flat3(s0,iz,nfa,nfb,nterms,ynoise,s)
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  |   implicit real*8 (a-h,o-z)
 | 
					
						
							|  |  |  |   parameter (NSMAX=6827)
 | 
					
						
							| 
									
										
										
										
											2014-01-08 20:55:11 +00:00
										 |  |  |   real*4 s0(iz)
 | 
					
						
							|  |  |  |   real*4 s(iz)
 | 
					
						
							| 
									
										
										
										
											2014-01-18 13:59:19 +00:00
										 |  |  |   real*4 ynoise,y4,db
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  |   real*8 x(NSMAX)
 | 
					
						
							|  |  |  |   real*8 y(NSMAX)
 | 
					
						
							|  |  |  |   real*8 y0(NSMAX)
 | 
					
						
							|  |  |  |   real*8 yfit(NSMAX)
 | 
					
						
							|  |  |  |   real*8 a(10)
 | 
					
						
							|  |  |  |   integer ii(NSMAX)
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   npts0=999999
 | 
					
						
							|  |  |  |   df=12000.0/16384.0
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   do i=1,iz
 | 
					
						
							| 
									
										
										
										
											2014-01-08 20:55:11 +00:00
										 |  |  |      y0(i)=db(s0(i))
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  |   enddo
 | 
					
						
							| 
									
										
										
										
											2014-01-08 20:55:11 +00:00
										 |  |  |   ia=(nfa+200.0)/df
 | 
					
						
							|  |  |  |   ib=5000.0/df
 | 
					
						
							|  |  |  |   if(nfb.gt.0) ib=nfb/df
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  |   j=0
 | 
					
						
							|  |  |  |   do i=ia,ib
 | 
					
						
							|  |  |  |      j=j+1
 | 
					
						
							|  |  |  |      x(j)=i*df
 | 
					
						
							|  |  |  |      y(j)=y0(i)
 | 
					
						
							|  |  |  |      ii(j)=i
 | 
					
						
							|  |  |  |   enddo
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   npts=j
 | 
					
						
							|  |  |  |   mode=0
 | 
					
						
							|  |  |  |   a=0.0
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   do iter=1,99
 | 
					
						
							|  |  |  |      call polfit(x,y,y,npts,nterms,mode,a,chisqr)
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |      do i=1,ib
 | 
					
						
							|  |  |  |         f=i*df
 | 
					
						
							| 
									
										
										
										
											2014-01-08 20:55:11 +00:00
										 |  |  |         yfit(i)=a(nterms)
 | 
					
						
							|  |  |  |         do n=nterms-1,1,-1
 | 
					
						
							|  |  |  |            yfit(i)=f*yfit(i) + a(n)
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  |         enddo
 | 
					
						
							|  |  |  | !        write(21,1010) f,y0(i),yfit(i),y0(i)-yfit(i)
 | 
					
						
							|  |  |  | !1010    format(4f12.3)
 | 
					
						
							|  |  |  |      enddo
 | 
					
						
							|  |  |  |      k=0
 | 
					
						
							|  |  |  |      do j=1,npts
 | 
					
						
							|  |  |  |         y1=y(j)-yfit(ii(j))
 | 
					
						
							|  |  |  |         if(y1.lt.ynoise) then
 | 
					
						
							| 
									
										
										
										
											2014-01-08 20:55:11 +00:00
										 |  |  | !        if(y1.lt.ynoise .and. y1.gt.-ynoise) then
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  |            k=k+1
 | 
					
						
							|  |  |  |            x(k)=x(j)
 | 
					
						
							|  |  |  |            y(k)=y(j)
 | 
					
						
							|  |  |  |            ii(k)=ii(j)
 | 
					
						
							|  |  |  |         endif
 | 
					
						
							|  |  |  |      enddo
 | 
					
						
							|  |  |  |      npts=k
 | 
					
						
							|  |  |  |      if(npts.eq.npts0 .or. npts.lt.(ib-ia)/10) exit
 | 
					
						
							|  |  |  |      npts0=npts
 | 
					
						
							|  |  |  |   enddo
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | !  do j=1,npts
 | 
					
						
							|  |  |  | !     write(22,1010) x(j),y(j),yfit(ii(j)),y(j)-yfit(ii(j))
 | 
					
						
							|  |  |  | !  enddo
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   do i=1,ib
 | 
					
						
							| 
									
										
										
										
											2014-01-09 00:03:22 +00:00
										 |  |  |      y4=y0(i)-yfit(i) - 10.0
 | 
					
						
							| 
									
										
										
										
											2014-01-08 20:55:11 +00:00
										 |  |  |      s(i)=10.0**(0.1*y4)
 | 
					
						
							| 
									
										
										
										
											2014-01-08 18:38:15 +00:00
										 |  |  |   enddo
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | end subroutine flat3
 |