subroutine qra64a(dd,npts,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) !twkfreq params f,f1,f2 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,minsync,mode64,emedelay,dtx,f0, & jpk0,sync,sync2,width) call timer('sync64 ',1) nfreq=nint(f0) if(mode64.eq.1 .and. minsync.ne.-1 .and. (sync-7.0).lt.minsync) go to 900 irc=-99 s3lim=20. ibwmax=11 if(mode64.le.4) ibwmax=9 ibwmin=0 idtmax=5 if(minsync.eq.-2) then ibwmin=ibwmax idtmax=3 endif LL=64*(mode64+2) NN=63 napmin=99 ncall=0 do idf0=1,11 idf=idf0/2 if(mod(idf0,2).eq.0) idf=-idf a=0. a(1)=-(f0+0.868*idf) call twkfreq(c00,c0,npts2,6000.0,a) do idt0=1,idtmax idt=idt0/2 if(mod(idt0,2).eq.0) idt=-idt jpk=jpk0 + 750*idt call spec64(c0,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 ibw=ibwmax,ibwmin,-2 b90=1.728**ibw if(b90.gt.230.0) cycle if(b90.lt.0.15*width) exit s3(1:LL*NN)=s3a(1:LL*NN) ncall=ncall+1 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 f0keep=-a(1) idfkeep=idf idtkeep=idt ibwkeep=ibw endif enddo ! ibw (b90 loop) if(iand(ndepth,3).lt.3 .and. irc.ge.0) go to 100 if(irc.eq.0) go to 100 enddo ! idt (DT loop) enddo ! idf (f0 loop) 100 if(napmin.ne.99) then dat4=dat4x b90=b90x snr2=snr2x irc=irckeep dtx=dtxkeep f0=f0keep idt=idtkeep idf=idfkeep ibw=ibwkeep endif 10 decoded=' ' if(irc.ge.0) then call unpackmsg(dat4,decoded) !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 nfreq=nint(f0) write(71,3071) idf,idt,ncall,irc,nsnr,dtx,nfreq,decoded 3071 format(5i5,f7.2,i6,2x,a22) 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) return end subroutine qra64a