mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-10-31 04:50:34 -04:00 
			
		
		
		
	git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6611 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
		
			
				
	
	
		
			103 lines
		
	
	
		
			2.2 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
			
		
		
	
	
			103 lines
		
	
	
		
			2.2 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
| subroutine lorentzian(y,npts,a)
 | |
| 
 | |
| ! Input:  y(npts); assume x(i)=i, i=1,npts
 | |
| ! Output: a(5)
 | |
| !         a(1) = baseline
 | |
| !         a(2) = amplitude
 | |
| !         a(3) = x0
 | |
| !         a(4) = width
 | |
| !         a(5) = chisqr
 | |
| 
 | |
|   real y(npts)
 | |
|   real a(5)
 | |
|   real deltaa(4)
 | |
| 
 | |
|   a=0.
 | |
|   df=12000.0/8192.0                               !df = 1.465 Hz
 | |
|   width=0.
 | |
|   ipk=0
 | |
|   ymax=-1.e30
 | |
|   do i=1,npts
 | |
|      if(y(i).gt.ymax) then
 | |
|         ymax=y(i)
 | |
|         ipk=i
 | |
|      endif
 | |
| !     write(50,3001) i,i*df,y(i)
 | |
| !3001 format(i6,2f12.3)
 | |
|   enddo
 | |
| !  base=(sum(y(ipk-149:ipk-50)) + sum(y(ipk+51:ipk+150)))/200.0
 | |
|   base=(sum(y(1:20)) + sum(y(npts-19:npts)))/40.0
 | |
|   stest=ymax - 0.5*(ymax-base)
 | |
|   ssum=y(ipk)
 | |
|   do i=1,50
 | |
|      if(ipk+i.gt.npts) exit
 | |
|      if(y(ipk+i).lt.stest) exit
 | |
|      ssum=ssum + y(ipk+i)
 | |
|   enddo
 | |
|   do i=1,50
 | |
|      if(ipk-i.lt.1) exit
 | |
|      if(y(ipk-i).lt.stest) exit
 | |
|      ssum=ssum + y(ipk-i)
 | |
|   enddo
 | |
|   ww=ssum/y(ipk)
 | |
|   width=2
 | |
|   t=ww*ww - 5.67
 | |
|   if(t.gt.0.0) width=sqrt(t)
 | |
|   a(1)=base
 | |
|   a(2)=ymax-base
 | |
|   a(3)=ipk
 | |
|   a(4)=width
 | |
| 
 | |
| ! Now find Lorentzian parameters
 | |
| 
 | |
|   deltaa(1)=0.1
 | |
|   deltaa(2)=0.1
 | |
|   deltaa(3)=1.0
 | |
|   deltaa(4)=1.0
 | |
|   nterms=4
 | |
| 
 | |
| !  Start the iteration
 | |
|   chisqr=0.
 | |
|   chisqr0=1.e6
 | |
|   do iter=1,5
 | |
|      do j=1,nterms
 | |
|         chisq1=fchisq0(y,npts,a)
 | |
|         fn=0.
 | |
|         delta=deltaa(j)
 | |
| 10      a(j)=a(j)+delta
 | |
|         chisq2=fchisq0(y,npts,a)
 | |
|         if(chisq2.eq.chisq1) go to 10
 | |
|         if(chisq2.gt.chisq1) then
 | |
|            delta=-delta                      !Reverse direction
 | |
|            a(j)=a(j)+delta
 | |
|            tmp=chisq1
 | |
|            chisq1=chisq2
 | |
|            chisq2=tmp
 | |
|         endif
 | |
| 20      fn=fn+1.0
 | |
|         a(j)=a(j)+delta
 | |
|         chisq3=fchisq0(y,npts,a)
 | |
|         if(chisq3.lt.chisq2) then
 | |
|            chisq1=chisq2
 | |
|            chisq2=chisq3
 | |
|            go to 20
 | |
|         endif
 | |
| 
 | |
| ! Find minimum of parabola defined by last three points
 | |
|         delta=delta*(1./(1.+(chisq1-chisq2)/(chisq3-chisq2))+0.5)
 | |
|         a(j)=a(j)-delta
 | |
|         deltaa(j)=deltaa(j)*fn/3.
 | |
| !          write(*,4000) iter,j,a,chisq2
 | |
| !4000      format(i1,i2,4f10.4,f11.3)
 | |
|      enddo
 | |
|      chisqr=fchisq0(y,npts,a)
 | |
| !       write(*,4000) 0,0,a,chisqr
 | |
|      if(chisqr/chisqr0.gt.0.99) exit
 | |
|      chisqr0=chisqr
 | |
|   enddo
 | |
|   a(5)=chisqr
 | |
| 
 | |
|   return
 | |
| end subroutine lorentzian
 | |
| 
 |