WSJT-X/lib/calibrate.f90

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