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