1subroutine msk144_freq_search(cdat,fc,if1,if2,delf,nframes,navmask,cb,    &
2     cdat2,xmax,bestf,cs,xccs)
3
4  parameter (NSPM=864,NZ=7*NSPM)
5  complex cdat(NZ)
6  complex cdat2(NZ)
7  complex c(NSPM)                    !Coherently averaged complex data
8  complex ct2(2*NSPM)
9  complex cs(NSPM)
10  complex cb(42)                     !Complex waveform for sync word
11  complex cc(0:NSPM-1)
12  real xcc(0:NSPM-1)
13  real xccs(0:NSPM-1)
14  integer navmask(nframes)           !Tells which frames to average
15
16  navg=sum(navmask)
17  n=nframes*NSPM
18  fac=1.0/(48.0*sqrt(float(navg)))
19
20  do ifr=if1,if2                     !Find freq that maximizes sync
21     ferr=ifr*delf
22     call tweak1(cdat,n,-(fc+ferr),cdat2)
23     c=0
24     sumw=0.
25     do i=1,nframes
26        ib=(i-1)*NSPM+1
27        ie=ib+NSPM-1
28        if(navmask(i).eq.1) c=c + cdat2(ib:ie)
29     enddo
30
31     cc=0
32     ct2(1:NSPM)=c
33     ct2(NSPM+1:2*NSPM)=c
34
35     do ish=0,NSPM-1
36        cc(ish)=dot_product(ct2(1+ish:42+ish)+ct2(337+ish:378+ish),cb(1:42))
37     enddo
38
39     xcc=abs(cc)
40     xb=maxval(xcc)*fac
41     if(xb.gt.xmax) then
42        xmax=xb
43        bestf=ferr
44        cs=c
45        xccs=xcc
46     endif
47  enddo
48
49  return
50end subroutine msk144_freq_search
51