WSJT-X/lib/qra02.f90

subroutine qra02(dd,nf1,nf2,nfqso,ntol,mycall_12,sync,nsnr,dtx,nfreq,    &
     decoded,nft)

  use packjt
  parameter (NFFT=2*6912,NH=NFFT/2,NZ=5760)
  character decoded*22,mycall_12*12,mycall*6
  character*1 mark(0:5),zplot(0:63)
  logical ltext
  integer icos7(0:6)
  integer ipk(1)
  integer jpk(1)
!  integer dat4(12)
  integer dat4(120)
  real dd(60*12000)
  real s(NZ)
  real savg(NZ)
  real blue(0:25)
  real red(NZ)
  real x(NFFT)
  complex cx(0:NH)
  equivalence (x,cx)
  data icos7/2,5,6,0,4,1,3/                            !Costas 7x7 pattern
  data mark/' ','.','-','+','X','$'/
  common/qra65com/ss(NZ,194),s3(0:63,1:63),ccf(NZ,0:25)
  save

!  rewind 74
!  rewind 75

!  print*,'B',nf1,nf2,nfqso,ntol
  nsps=6912
  istep=nsps/2
  nsteps=52*12000/istep - 2
  ia=1-istep
  savg=0.
  df=12000.0/NFFT
  do j=1,nsteps
     ia=ia+istep
     ib=ia+nsps-1
     x(1:nsps)=1.2e-4*dd(ia:ib)
     x(nsps+1:)=0.0
     call four2a(x,nfft,1,-1,0)        !r2c FFT
     do i=1,NZ
        s(i)=real(cx(i))**2 + aimag(cx(i))**2
     enddo
     ss(1:NZ,j)=s
     savg=savg+s
  enddo

  savg=savg/nsteps
  call pctile(savg,NZ,45,base)
  savg=savg/base - 1.0
  ss=ss/base
!  do i=1,NZ
!     write(73,1010) i*df,savg(i),i
!1010 format(2f10.3,i8)
!  enddo

  fa=max(nf1,nfqso-ntol)
  fb=min(nf2,nfqso+ntol)
  ia=nint(fa/df)
  ib=nint(fb/df)
  fac=1.0/sqrt(21.0)
  sync=0.
  do if0=ia,ib
     red(if0)=0.
     do j=0,25
        t=-3.0
        do n=0,6
           i=if0 + 2*icos7(n)
           t=t + ss(i,1+2*n+j) + ss(i,1+2*n+j+78) + ss(i,1+2*n+j+154)
        enddo
        ccf(if0,j)=fac*t
        if(ccf(if0,j).gt.red(if0)) then
           red(if0)=ccf(if0,j)
           if(red(if0).gt.sync) then
              sync=red(if0)
              f0=if0*df
              dtx=j*istep/12000.0 - 1.0
              i0=if0
              j0=j
           endif
        endif
     enddo
  enddo

  do i=0,63
     k=i0 + 2*i
     jj=j0+13
     do j=1,63
        jj=jj+2
        s3(i,j)=ss(k,jj)
        if(j.eq.32) jj=jj+14               !Skip over the middle Costas array
     enddo
  enddo

  do j=1,63
     do i=0,63
        n=0.25*s3(i,j)
        if(n.lt.0) n=0
        if(n.gt.5) n=5
        zplot(i)=mark(n)
     enddo
     ipk=maxloc(s3(0:63,j))
!     write(76,3001) j,zplot,ipk(1)-1
!3001 format(i2,1x,'|',64a1,'|',i4)
  enddo

  if0=nint(f0/df)
  nfreq=nint(f0)
  blue(0:25)=ccf(if0,0:25)
  jpk=maxloc(blue)
  xpk=jpk(1) + 1.0
  call slope(blue,26,xpk)

!  do j=0,25
!     tsec=j*istep/12000.0
!     write(74,1020) tsec,blue(j)
!1020 format(f5.2,i3,10f7.1)
!  enddo

!  do i=ia,ib
!     f=i*df
!     write(75,1030) f,red(i)
!1030 format(2f10.2)
!  enddo
!  flush(74)
!  flush(75)
!  flush(76)

  decoded='                      '
  nft=100
  nsnr=-30
  if(sync.gt.1.0) nsnr=nint(10.0*log10(sync) - 38.0)
  if(sync.lt.12.8) go to 900                !### Temporary ###
!  print*,'A',sync,nsnr

  mycall=mycall_12(1:6)                     !### May need fixing ###
  call packcall(mycall,nmycall,ltext)
!  write(77,3002) s3
!3002 format(f10.3)
!  flush(77)
!  print*,'a',sync,dtx,base
  call qra65_dec(s3,nmycall,dat4,irc)       !Attempt decoding
!  print*,'z',sync,dtx,nfreq
  if(irc.ge.0) then
     call unpackmsg(dat4,decoded)           !Unpack the user message
     call fmtmsg(decoded,iz)
     nft=100 + irc
  endif

900 return
end subroutine qra02