mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-11-03 13:30:52 -05:00 
			
		
		
		
	By using the local 8-bit character set we can allow local non-ASCII characters in file paths, for example user account names on MS Windows with characters in the default code page.
		
			
				
	
	
		
			97 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
			
		
		
	
	
			97 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
subroutine calibrate(data_dir,iz,a,b,rms,sigmaa,sigmab,irc)
 | 
						|
 | 
						|
! Average groups of frequency-calibration measurements, then fit a
 | 
						|
! straight line for slope and intercept.
 | 
						|
 | 
						|
  parameter (NZ=1000)
 | 
						|
  implicit real*8 (a-h,o-z)
 | 
						|
  character*(*) data_dir
 | 
						|
  character*256 infile,outfile
 | 
						|
  character*8 cutc,cutc1
 | 
						|
  character*1 c1
 | 
						|
  real*8 fd(NZ),deltaf(NZ),r(NZ),rmsd(NZ)
 | 
						|
  integer nn(NZ)
 | 
						|
 | 
						|
  infile=trim(data_dir)//'/'//'fmt.all'
 | 
						|
  outfile=trim(data_dir)//'/'//'fcal2.out'
 | 
						|
 | 
						|
  open(10,file=trim(infile),status='old',err=996)
 | 
						|
  open(12,file=trim(outfile),status='unknown',err=997)
 | 
						|
 | 
						|
  nkhz0=0
 | 
						|
  sum=0.d0
 | 
						|
  sumsq=0.d0
 | 
						|
  n=0
 | 
						|
  j=0
 | 
						|
  do i=1,99999
 | 
						|
     read(10,*,end=10,err=995) cutc,nkHz,ncal,noffset,faudio,df,dblevel,snr
 | 
						|
     if((nkHz.ne.nkHz0) .and. i.ne.1) then
 | 
						|
        ave=sum/n
 | 
						|
        rms=0.d0
 | 
						|
        if(n.gt.1) then
 | 
						|
           rms=sqrt(abs(sumsq - sum*sum/n)/(n-1.d0))
 | 
						|
        endif
 | 
						|
        fMHz=0.001d0*nkHz0
 | 
						|
        j=j+1
 | 
						|
        fd(j)=fMHz
 | 
						|
        deltaf(j)=ave
 | 
						|
        r(j)=0.d0
 | 
						|
        rmsd(j)=rms
 | 
						|
        nn(j)=n
 | 
						|
        sum=0.d0
 | 
						|
        sumsq=0.d0
 | 
						|
        n=0
 | 
						|
     endif
 | 
						|
     dial_error=faudio-noffset
 | 
						|
     sum=sum + dial_error
 | 
						|
     sumsq=sumsq + dial_error**2
 | 
						|
     n=n+1
 | 
						|
     if(n.eq.1) then
 | 
						|
        cutc1=cutc
 | 
						|
        ncal0=ncal
 | 
						|
     endif
 | 
						|
     nkHz0=nkHz
 | 
						|
  enddo
 | 
						|
 | 
						|
10 ave=sum/n
 | 
						|
  rms=0.d0
 | 
						|
  if(n.gt.0) then
 | 
						|
     rms=sqrt((sumsq - sum*sum/n)/(n-1.d0))
 | 
						|
  endif
 | 
						|
  fMHz=0.001d0*nkHz
 | 
						|
  j=j+1
 | 
						|
  fd(j)=fMHz
 | 
						|
  deltaf(j)=ave
 | 
						|
  r(j)=0.d0
 | 
						|
  rmsd(j)=rms
 | 
						|
  nn(j)=n
 | 
						|
  iz=j
 | 
						|
  if(iz.lt.2) go to 998
 | 
						|
 | 
						|
  call fitcal(fd,deltaf,r,iz,a,b,sigmaa,sigmab,rms)
 | 
						|
 | 
						|
  write(12,1002) 
 | 
						|
1002 format('    Freq      DF     Meas Freq    N    rms    Resid'/        &
 | 
						|
            '   (MHz)     (Hz)      (MHz)          (Hz)     (Hz)'/        &
 | 
						|
            '----------------------------------------------------')       
 | 
						|
  irc=0
 | 
						|
  do i=1,iz
 | 
						|
     fm=fd(i) + 1.d-6*deltaf(i)
 | 
						|
     c1=' '
 | 
						|
     if(rmsd(i).gt.1.0d0) c1='*'
 | 
						|
     write(12,1012)  fd(i),deltaf(i),fm,nn(i),rmsd(i),r(i),c1
 | 
						|
1012 format(f8.3,f9.3,f14.9,i4,f7.2,f9.3,1x,a1)
 | 
						|
  enddo
 | 
						|
  go to 999
 | 
						|
 | 
						|
995 irc=-4; iz=i; go to 999
 | 
						|
996 irc=-1; go to 999
 | 
						|
997 irc=-2; go to 999
 | 
						|
998 irc=-3
 | 
						|
999 continue
 | 
						|
  close(10)
 | 
						|
  close(12)
 | 
						|
 | 
						|
  return
 | 
						|
end subroutine calibrate
 |