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) !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