WSJT-X/lib/qra64a.f90
Joe Taylor 5da4ae6363 Set naptype properly; protect nap() index from out-of-range values.
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@7341 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2016-11-27 16:38:39 +00:00

144 lines
4.2 KiB
Fortran

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
if(sync.lt.float(minsync)) 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)
napmin=99
do iter=itz,0,-2
b90=1.728**iter
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.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+1.0)
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