180 lines
4.9 KiB
Fortran
180 lines
4.9 KiB
Fortran
|
subroutine sync4(dat,jz,ntol,NFreeze,MouseDF,mode,mode4,minwidth, &
|
||
|
|
dtx,dfx,snrx,snrsync,ccfblue,ccfred1,flip,width,ps0)
|
||
|
|
|
||
|
|
! Synchronizes JT4 data, finding the best-fit DT and DF.
|
||
|
|
|
||
|
|
parameter (NFFTMAX=2520) !Max length of FFTs
|
||
|
|
parameter (NHMAX=NFFTMAX/2) !Max length of power spectra
|
||
|
|
parameter (NSMAX=525) !Max number of half-symbol steps
|
||
|
|
integer ntol !Range of DF search
|
||
|
|
real dat(jz)
|
||
|
|
real psavg(NHMAX) !Average spectrum of whole record
|
||
|
|
real ps0(450) !Avg spectrum for plotting
|
||
|
|
real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols
|
||
|
|
real ccfblue(-5:540) !CCF with pseudorandom sequence
|
||
|
|
real ccfred(-450:450) !Peak of ccfblue, as function of freq
|
||
|
|
real red(-450:450) !Peak of ccfblue, as function of freq
|
||
|
|
real ccfred1(-224:224) !Peak of ccfblue, as function of freq
|
||
|
|
real tmp(1260)
|
||
|
|
integer ipk1(1)
|
||
|
|
integer nch(7)
|
||
|
|
logical savered
|
||
|
|
equivalence (ipk1,ipk1a)
|
||
|
|
data nch/1,2,4,9,18,36,72/
|
||
|
|
save
|
||
|
|
|
||
|
|
! write(*,3001) 'A',ntol,nfreeze,mousedf,mode,mode4,minwidth
|
||
|
|
!3001 format(a1,6i6)
|
||
|
|
|
||
|
|
! Do FFTs of twice symbol length, stepped by half symbols. Note that
|
||
|
|
! we have already downsampled the data by factor of 2.
|
||
|
|
nsym=207
|
||
|
|
nfft=2520
|
||
|
|
nh=nfft/2
|
||
|
|
nq=nfft/4
|
||
|
|
nsteps=jz/nq - 1
|
||
|
|
df=0.5*11025.0/nfft
|
||
|
|
psavg(1:nh)=0.
|
||
|
|
if(mode.eq.-999) width=0. !Silence compiler warning
|
||
|
|
|
||
|
|
do j=1,nsteps !Compute spectrum for each step, get average
|
||
|
|
k=(j-1)*nq + 1
|
||
|
|
call ps4(dat(k),nfft,s2(1,j))
|
||
|
|
psavg(1:nh)=psavg(1:nh) + s2(1:nh,j)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
nsmo=min(10*mode4,150)
|
||
|
|
call flat1b(psavg,nsmo,s2,nh,nsteps,NHMAX,NSMAX) !Flatten spectra
|
||
|
|
|
||
|
|
if(mode4.ge.9) call smo(psavg,nh,tmp,mode4/4)
|
||
|
|
|
||
|
|
i0=132
|
||
|
|
do i=1,450
|
||
|
|
ps0(i)=5.0*(psavg(i0+2*i) + psavg(i0+2*i+1) - 2.0)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
! Set freq and lag ranges
|
||
|
|
famin=200.0 + 3*mode4*df
|
||
|
|
fbmax=2700.0 - 3*mode4*df
|
||
|
|
fa=famin
|
||
|
|
fb=fbmax
|
||
|
|
if(NFreeze.eq.1) then
|
||
|
|
fa=max(famin,1270.46+MouseDF-ntol)
|
||
|
|
fb=min(fbmax,1270.46+MouseDF+ntol)
|
||
|
|
else
|
||
|
|
fa=max(famin,1270.46+MouseDF-600)
|
||
|
|
fb=min(fbmax,1270.46+MouseDF+600)
|
||
|
|
endif
|
||
|
|
ia=fa/df - 3*mode4 !Index of lowest tone, bottom of range
|
||
|
|
ib=fb/df - 3*mode4 !Index of lowest tone, top of range
|
||
|
|
i0=nint(1270.46/df)
|
||
|
|
irange=450
|
||
|
|
if(ia-i0.lt.-irange) ia=i0-irange
|
||
|
|
if(ib-i0.gt.irange) ib=i0+irange
|
||
|
|
lag1=-5
|
||
|
|
lag2=59
|
||
|
|
syncbest=-1.e30
|
||
|
|
ccfred=0.
|
||
|
|
jmax=-1000
|
||
|
|
jmin=1000
|
||
|
|
|
||
|
|
do ich=minwidth,7 !Find best width
|
||
|
|
kz=nch(ich)/2
|
||
|
|
savered=.false.
|
||
|
|
do i=ia+kz,ib-kz !Find best frequency channel for CCF
|
||
|
|
call xcor4(s2,i,nsteps,nsym,lag1,lag2,ich,mode4,ccfblue,ccf0, &
|
||
|
|
lagpk0,flip)
|
||
|
|
j=i-i0 + 3*mode4
|
||
|
|
if(j.ge.-372 .and. j.le.372) then
|
||
|
|
ccfred(j)=ccf0
|
||
|
|
jmax=max(j,jmax)
|
||
|
|
jmin=min(j,jmin)
|
||
|
|
endif
|
||
|
|
|
||
|
|
! Find rms of the CCF, without main peak
|
||
|
|
call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0)
|
||
|
|
sync=abs(ccfblue(lagpk0))
|
||
|
|
|
||
|
|
! Find best sync value
|
||
|
|
if(sync.gt.syncbest) then
|
||
|
|
ipk=i
|
||
|
|
lagpk=lagpk0
|
||
|
|
ichpk=ich
|
||
|
|
syncbest=sync
|
||
|
|
savered=.true.
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
if(savered) red=ccfred
|
||
|
|
enddo
|
||
|
|
|
||
|
|
ccfred=red
|
||
|
|
! width=df*nch(ichpk)
|
||
|
|
dfx=(ipk-i0 + 3*mode4)*df
|
||
|
|
|
||
|
|
! Peak up in time, at best whole-channel frequency
|
||
|
|
call xcor4(s2,ipk,nsteps,nsym,lag1,lag2,ichpk,mode4,ccfblue,ccfmax, &
|
||
|
|
lagpk,flip)
|
||
|
|
xlag=lagpk
|
||
|
|
if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then
|
||
|
|
call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2)
|
||
|
|
xlag=lagpk+dx2
|
||
|
|
endif
|
||
|
|
|
||
|
|
! Find rms of the CCF, without the main peak
|
||
|
|
call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0)
|
||
|
|
sq=0.
|
||
|
|
nsq=0
|
||
|
|
do lag=lag1,lag2
|
||
|
|
if(abs(lag-xlag).gt.2.0) then
|
||
|
|
sq=sq+ccfblue(lag)**2
|
||
|
|
nsq=nsq+1
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
rms=sqrt(sq/nsq)
|
||
|
|
snrsync=max(0.0,db(abs(ccfblue(lagpk)/rms - 1.0)) - 4.5)
|
||
|
|
snrx=-26.
|
||
|
|
if(mode4.eq.2) snrx=-25.
|
||
|
|
if(mode4.eq.4) snrx=-24.
|
||
|
|
if(mode4.eq.9) snrx=-23.
|
||
|
|
if(mode4.eq.18) snrx=-22.
|
||
|
|
if(mode4.eq.36) snrx=-21.
|
||
|
|
if(mode4.eq.72) snrx=-20.
|
||
|
|
snrx=snrx + snrsync
|
||
|
|
|
||
|
|
dt=2.0/11025.0
|
||
|
|
istart=xlag*nq
|
||
|
|
dtx=istart*dt
|
||
|
|
ccfred1=0.
|
||
|
|
jmin=max(jmin,-224)
|
||
|
|
jmax=min(jmax,224)
|
||
|
|
do i=jmin,jmax
|
||
|
|
ccfred1(i)=ccfred(i)
|
||
|
|
enddo
|
||
|
|
|
||
|
|
ipk1=maxloc(ccfred1) - 225
|
||
|
|
ns=0
|
||
|
|
s=0.
|
||
|
|
iw=min(mode4,(ib-ia)/4)
|
||
|
|
do i=jmin,jmax
|
||
|
|
if(abs(i-ipk1a).gt.iw) then
|
||
|
|
s=s+ccfred1(i)
|
||
|
|
ns=ns+1
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
base=s/ns
|
||
|
|
ccfred1=ccfred1-base
|
||
|
|
ccf10=0.5*maxval(ccfred1)
|
||
|
|
do i=ipk1a,jmin,-1
|
||
|
|
if(ccfred1(i).le.ccf10) exit
|
||
|
|
enddo
|
||
|
|
i1=i
|
||
|
|
do i=ipk1a,jmax
|
||
|
|
if(ccfred1(i).le.ccf10) exit
|
||
|
|
enddo
|
||
|
|
width=(i-i1)*df
|
||
|
|
|
||
|
|
return
|
||
|
|
end subroutine sync4
|
||
|
|
|
||
|
|
include 'flat1b.f90'
|