WSJT-X/lib/qra64a.f90

subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth,   &
     emedelay,mycall_12,hiscall_12,hisgrid_6,sync,nsnr,dtx,nfreq,decoded,nft)

  use packjt
  use timer_module, only: timer
  
  parameter (NMAX=60*12000,LN=1152*63)
  character decoded*22
  character*12 mycall_12,hiscall_12
  character*6 mycall,hiscall,hisgrid_6
  character*4 hisgrid
  logical ltext
  complex c00(0:720000)                      !Complex spectrum of dd()
  complex c0(0:720000)                       !Complex data for dd()
  real a(3)
  real dd(NMAX)                              !Raw data sampled at 12000 Hz
  real s3(LN)                                !Symbol spectra
  real s3a(LN)                               !Symbol spectra
  integer dat4(12)                           !Decoded message (as 12 integers)
  integer dat4x(12)
  integer nap(0:11)
  data nap/0,2,3,2,3,4,2,3,6,4,6,6/
  data nc1z/-1/,nc2z/-1/,ng2z/-1/,maxaptypez/-1/
  save

  call timer('qra64a  ',0)
  irc=-1
  decoded='                      '
  nft=99
  if(nfqso.lt.nf1 .or. nfqso.gt.nf2) go to 900

  mycall=mycall_12(1:6)                     !### May need fixing ###
  hiscall=hiscall_12(1:6)
  hisgrid=hisgrid_6(1:4)
  call packcall(mycall,nc1,ltext)
  call packcall(hiscall,nc2,ltext)
  call packgrid(hisgrid,ng2,ltext)
  nSubmode=0
  if(mode64.eq.2) nSubmode=1
  if(mode64.eq.4) nSubmode=2
  if(mode64.eq.8) nSubmode=3
  if(mode64.eq.16) nSubmode=4
  b90=1.0
  nFadingModel=1
  maxaptype=4
  if(iand(ndepth,64).ne.0) maxaptype=5
  if(nc1.ne.nc1z .or. nc2.ne.nc2z .or. ng2.ne.ng2z .or.            &
     maxaptype.ne.maxaptypez) then
     do naptype=0,maxaptype
        if(naptype.eq.2 .and. maxaptype.eq.4) cycle
        call qra64_dec(s3,nc1,nc2,ng2,naptype,1,nSubmode,b90,      &
             nFadingModel,dat4,snr2,irc)
     enddo
     nc1z=nc1
     nc2z=nc2
     ng2z=ng2
     maxaptypez=maxaptype
  endif
  naptype=maxaptype

  call ana64(dd,npts,c00)
  npts2=npts/2
  
  call timer('sync64  ',0)
  call sync64(c00,nf1,nf2,nfqso,ntol,mode64,emedelay,dtx,f0,jpk0,sync,  &
       sync2,width)
  call timer('sync64  ',1)
  nfreq=nint(f0)
  if(mode64.eq.1 .and. minsync.ge.0 .and. (sync-7.0).lt.minsync) go to 900
!  if((sync-3.4).lt.float(minsync) .or.width.gt.340.0) go to 900
  a=0.
  a(1)=-f0
  call twkfreq(c00,c0,npts2,6000.0,a)

  irc=-99
  s3lim=20.
  itz=11
  if(mode64.eq.4) itz=9
  if(mode64.eq.2) itz=7
  if(mode64.eq.1) itz=5

  LL=64*(mode64+2)
  NN=63
  napmin=99
  do itry0=1,5
     idt=itry0/2
     if(mod(itry0,2).eq.0) idt=-idt
     jpk=jpk0 + 750*idt
     call spec64(c0,npts2,mode64,jpk,s3a,LL,NN)
     call pctile(s3a,LL*NN,40,base)
     s3a=s3a/base
     where(s3a(1:LL*NN)>s3lim) s3a(1:LL*NN)=s3lim
     do iter=itz,0,-2
        b90=1.728**iter
        if(b90.gt.230.0) cycle
        if(b90.lt.0.15*width) exit
        s3(1:LL*NN)=s3a(1:LL*NN)
        call timer('qra64_de',0)
        call qra64_dec(s3,nc1,nc2,ng2,naptype,0,nSubmode,b90,      &
             nFadingModel,dat4,snr2,irc)
        call timer('qra64_de',1)
        if(irc.eq.0) go to 10
        if(irc.gt.0) call badmsg(irc,dat4,nc1,nc2,ng2)
        iirc=max(0,min(irc,11))
        if(irc.gt.0 .and. nap(iirc).lt.napmin) then
           dat4x=dat4
           b90x=b90
           snr2x=snr2
           napmin=nap(iirc)
           irckeep=irc
           dtxkeep=jpk/6000.0 - 1.0
           itry0keep=itry0
           iterkeep=iter
        endif
     enddo
     if(irc.eq.0) exit
  enddo

  if(napmin.ne.99) then
     dat4=dat4x
     b90=b90x
     snr2=snr2x
     irc=irckeep
     dtx=dtxkeep
     itry0=itry0keep
     iter=iterkeep
  endif
10 decoded='                      '

  if(irc.ge.0) then
     call unpackmsg(dat4,decoded,.false.,'      ') !Unpack the user message
     call fmtmsg(decoded,iz)
     if(index(decoded,"000AAA ").ge.1) then
        ! Suppress a certain type of garbage decode.
        decoded='                      '
        irc=-1
     endif
     nft=100 + irc
     nsnr=nint(snr2)
  else
     snr2=0.
  endif

900 if(irc.lt.0) then
     sy=max(1.0,sync)
     if(nSubmode.eq.0) nsnr=nint(10.0*log10(sy)-35.0)   !A
     if(nSubmode.eq.1) nsnr=nint(10.0*log10(sy)-34.0)   !B
     if(nSubmode.eq.2) nsnr=nint(10.0*log10(sy)-29.0)   !C
     if(nSubmode.eq.3) nsnr=nint(10.0*log10(sy)-29.0)   !D
     if(nSubmode.eq.4) nsnr=nint(10.0*log10(sy)-24.0)   !E
  endif
  call timer('qra64a  ',1)

!  write(71,3001) nutc,dtx,f0,sync,sync2,width,minsync,decoded
!3001 format(i4.4,f7.2,4f8.1,i3,2x,a22)
  
  return
end subroutine qra64a