subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & 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) decoded=' ' if(nfqso.lt.nf1 .or. nfqso.gt.nf2) go to 900 nft=99 nsnr=-30 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 maxf1=0 call timer('sync64 ',0) call sync64(dd,npts,nf1,nf2,nfqso,ntol,mode64,maxf1,dtx,f0,jpk,kpk,sync,c00) call timer('sync64 ',1) irc=-99 ! sync=5 ! dtx=0. ! f0=1000. ! if(sync.lt.minsync+3.5) go to 900 npts2=npts/2 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 ! do itry0=1,3 do itry0=1,1 idf0=itry0/2 if(mod(itry0,2).eq.0) idf0=-idf0 a(1)=-(f0+0.248*(idf0-0.33*kpk)) nfreq=nint(-a(1)) a(3)=0. ! do itry1=1,3 do itry1=1,1 idf1=itry1/2 if(mod(itry1,2).eq.0) idf1=-idf1 a(2)=-0.67*(idf1 + 0.67*kpk) call twkfreq(c00,c0,npts2,6000.0,a) call spec64(c0,npts2,mode64,jpk,s3a,LL,NN) !### Parameters 3000.0 and 10.0 might be better optimized? call pctile(s3a,LL*NN,45,base) s3max=3000.0 if(sync.gt.5.0) s3max=15000.0/sync s3max=max(10.0,s3max) do i=1,LL*NN if(s3a(i).gt.s3max*base) s3a(i)=s3max*base enddo s3pk=maxval(s3a(1:LL*NN)) napmin=99 do iter=itz,0,-2 b90=1.728**iter if(b90.gt.230.0) cycle 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(abs(snr2).gt.30.) snr2=-30.0 if(irc.eq.0) go to 10 if(irc.gt.0) call badmsg(irc,dat4,nc1,nc2,ng2) if(irc.lt.0) cycle iirc=max(0,min(irc,11)) if(irc.gt.0 .and. nap(iirc).le.napmin) then dat4x=dat4 b90x=b90 snr2x=snr2 napmin=nap(iirc) irckeep=irc endif enddo if(napmin.ne.99) then dat4=dat4x b90=b90x snr2=snr2x irc=irckeep endif 10 decoded=' ' if(irc.ge.0) then call unpackmsg(dat4,decoded) !Unpack the user message call fmtmsg(decoded,iz) nft=100 + irc nsnr=nint(snr2) else snr2=0. endif enddo enddo 900 continue if(index(decoded,"000AAA ").ge.1) then ! Suppress a certain type of garbage decode. decoded=' ' irc=-1 endif if(irc.lt.0) then sy=max(1.0,sync-2.5) if(nSubmode.eq.0) nsnr=nint(10.0*log10(sy)-38.0) !A if(nSubmode.eq.1) nsnr=nint(10.0*log10(sy)-36.0) !B if(nSubmode.eq.2) nsnr=nint(10.0*log10(sy)-34.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) return end subroutine qra64a