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@7472 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
		
			
				
	
	
		
			118 lines
		
	
	
		
			2.7 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
			
		
		
	
	
			118 lines
		
	
	
		
			2.7 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
| program fcal
 | |
| 
 | |
| ! Compute Intercept (A) and Slope (B) for a series of FreqCal measurements. 
 | |
|   parameter(NZ=1000)
 | |
|   implicit real*8 (a-h,o-z)
 | |
|   real*8 fd(NZ),deltaf(NZ),r(NZ)
 | |
|   character infile*50
 | |
|   character line*80
 | |
|   character cutc*8
 | |
| 
 | |
|   nargs=iargc()
 | |
|   if(nargs.ne.1) then
 | |
|      print*,'Usage:   fcal <infile>'
 | |
|      print*,'Example: fcal fmtave.out'
 | |
|      go to 999
 | |
|   endif
 | |
|   call getarg(1,infile)
 | |
| 
 | |
|   open(10,file=infile,status='old',err=997)
 | |
|   open(12,file='fcal.out',status='unknown')
 | |
|   open(13,file='fcal.plt',status='unknown')
 | |
| 
 | |
|   i=0
 | |
|   do j=1,9999
 | |
|      read(10,1000,end=10) line
 | |
| 1000 format(a80)
 | |
|      i0=index(line,' 0 ')
 | |
|      i1=index(line,' 1 ')
 | |
|      if(i0.le.0 .and. i1.le.0) then
 | |
|         read(line,*,err=5) f,df
 | |
|         ncal=1
 | |
|         i=i+1
 | |
|         fd(i)=f
 | |
|         deltaf(i)=df
 | |
|      else if(i1.gt.0) then
 | |
|         i=i+1
 | |
|         read(line,*,err=5) f,df,ncal,nn,rr,cutc
 | |
|         fd(i)=f
 | |
|         deltaf(i)=df
 | |
|         r(i)=0.d0
 | |
|      endif
 | |
| 5    continue
 | |
|   enddo
 | |
| 
 | |
| 10 iz=i
 | |
|   if(iz.lt.2) go to 998
 | |
|   call fit(fd,deltaf,r,iz,a,b,sigmaa,sigmab,rms)
 | |
| 
 | |
|   write(*,1002) 
 | |
| 1002 format('    Freq      DF     Meas Freq     Resid'/        &
 | |
|             '   (MHz)     (Hz)      (MHz)        (Hz)'/        &
 | |
|             '-----------------------------------------')       
 | |
|   do i=1,iz
 | |
|      fm=fd(i) + 1.d-6*deltaf(i)
 | |
|      calfac=1.d0 + 1.d-6*deltaf(i)/fd(i)
 | |
|      write(*,1010) fd(i),deltaf(i),fm,r(i)
 | |
|      write(13,1010) fd(i),deltaf(i),fm,r(i)
 | |
| 1010 format(f8.3,f9.3,f14.9,f9.3,2x,a6)
 | |
|   enddo
 | |
|   calfac=1.d0 + 1.d-6*b
 | |
|   err=1.d-6*sigmab
 | |
| 
 | |
|   if(iz.ge.3) then
 | |
|      write(*,1100) a,b,rms
 | |
| 1100 format(/'A:',f8.2,' Hz    B:',f9.4,' ppm    StdDev:',f7.3,' Hz')
 | |
|   if(iz.gt.2) write(*,1110) sigmaa,sigmab
 | |
| 1110 format('err:',f6.2,9x,f9.4,23x,f13.9)
 | |
|   else
 | |
|      write(*,1120) a,b
 | |
| 1120 format(/'A:',f8.2,' Hz    B:',f9.4)
 | |
|   endif
 | |
| 
 | |
|   write(12,1130) a,b
 | |
| 1130 format(f10.4)
 | |
| 
 | |
|   go to 999
 | |
| 
 | |
| 997 print*,'Cannot open input file: ',infile
 | |
|   go to 999
 | |
| 998 print*,'Input file must contain at least 2 valid measurement pairs'
 | |
| 
 | |
| 999 end program fcal
 | |
| 
 | |
| subroutine fit(x,y,r,iz,a,b,sigmaa,sigmab,rms)
 | |
|   implicit real*8 (a-h,o-z)
 | |
|   real*8 x(iz),y(iz),r(iz)
 | |
| 
 | |
|   sx=0.d0
 | |
|   sy=0.d0
 | |
|   sxy=0.d0
 | |
|   sx2=0.d0
 | |
|   do i=1,iz
 | |
|      sx=sx + x(i)
 | |
|      sy=sy + y(i)
 | |
|      sxy=sxy + x(i)*y(i)
 | |
|      sx2=sx2 + x(i)*x(i)
 | |
|   enddo
 | |
|   delta=iz*sx2 - sx*sx
 | |
|   a=(sx2*sy - sx*sxy)/delta
 | |
|   b=(iz*sxy - sx*sy)/delta
 | |
| 
 | |
|   sq=0.d0
 | |
|   do i=1,iz
 | |
|      r(i)=y(i) - (a + b*x(i))
 | |
|      sq=sq + r(i)**2
 | |
|   enddo
 | |
|   rms=0.
 | |
|   sigmaa=0.
 | |
|   sigmab=0.
 | |
|   if(iz.ge.3) then
 | |
|      rms=sqrt(sq/(iz-2))
 | |
|      sigmaa=sqrt(rms*rms*sx2/delta)
 | |
|      sigmab=sqrt(iz*rms*rms/delta)
 | |
|   endif
 | |
| 
 | |
|   return
 | |
| end subroutine fit
 |