mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-09 02:26:06 -05:00
536 lines
16 KiB
Fortran
536 lines
16 KiB
Fortran
module jt65_decode
|
|
|
|
integer, parameter :: NSZ=3413, NZMAX=60*12000
|
|
|
|
type :: jt65_decoder
|
|
procedure(jt65_decode_callback), pointer :: callback => null()
|
|
contains
|
|
procedure :: decode
|
|
end type jt65_decoder
|
|
|
|
! Callback function to be called with each decode
|
|
abstract interface
|
|
subroutine jt65_decode_callback(this,sync,snr,dt,freq,drift, &
|
|
nflip,width,decoded,ft,qual,nsmo,nsum,minsync)
|
|
|
|
import jt65_decoder
|
|
implicit none
|
|
class(jt65_decoder), intent(inout) :: this
|
|
real, intent(in) :: sync
|
|
integer, intent(in) :: snr
|
|
real, intent(in) :: dt
|
|
integer, intent(in) :: freq
|
|
integer, intent(in) :: drift
|
|
integer, intent(in) :: nflip
|
|
real, intent(in) :: width
|
|
character(len=22), intent(in) :: decoded
|
|
integer, intent(in) :: ft
|
|
integer, intent(in) :: qual
|
|
integer, intent(in) :: nsmo
|
|
integer, intent(in) :: nsum
|
|
integer, intent(in) :: minsync
|
|
|
|
end subroutine jt65_decode_callback
|
|
end interface
|
|
|
|
contains
|
|
|
|
subroutine decode(this,callback,dd0,npts,newdat,nutc,nf1,nf2,nfqso, &
|
|
ntol,nsubmode,minsync,nagain,n2pass,nrobust,ntrials,naggressive, &
|
|
ndepth,emedelay,clearave,mycall,hiscall,hisgrid,nexp_decode, &
|
|
nQSOProgress,ljt65apon)
|
|
|
|
! Process dd0() data to find and decode JT65 signals.
|
|
|
|
use jt65_mod
|
|
use timer_module, only: timer
|
|
|
|
include 'constants.f90'
|
|
|
|
class(jt65_decoder), intent(inout) :: this
|
|
procedure(jt65_decode_callback) :: callback
|
|
real, intent(in) :: dd0(NZMAX),emedelay
|
|
integer, intent(in) :: npts, nutc, nf1, nf2, nfqso, ntol &
|
|
, nsubmode, minsync, n2pass, ntrials, naggressive, ndepth &
|
|
, nexp_decode, nQSOProgress
|
|
logical, intent(in) :: newdat, nagain, nrobust, clearave, ljt65apon
|
|
character(len=12), intent(in) :: mycall, hiscall
|
|
character(len=6), intent(in) :: hisgrid
|
|
|
|
real dd(NZMAX)
|
|
real ss(552,NSZ)
|
|
real savg(NSZ)
|
|
real a(5)
|
|
character*22 decoded,decoded0,avemsg,deepave
|
|
type candidate
|
|
real freq
|
|
real dt
|
|
real sync
|
|
real flip
|
|
end type candidate
|
|
type(candidate) ca(300)
|
|
type accepted_decode
|
|
real freq
|
|
real dt
|
|
real sync
|
|
character*22 decoded
|
|
end type accepted_decode
|
|
type(accepted_decode) dec(50)
|
|
logical :: first_time,prtavg,single_decode,bVHF,clear_avg65
|
|
|
|
integer h0(0:11),d0(0:11)
|
|
real r0(0:11)
|
|
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
|
|
common/steve/thresh0
|
|
common/sync/ss
|
|
|
|
! 0 1 2 3 4 5 6 7 8 9 10 11
|
|
data h0/41,42,43,43,44,45,46,47,48,48,49,49/
|
|
data d0/71,72,73,74,76,77,78,80,81,82,83,83/
|
|
|
|
! 0 1 2 3 4 5 6 7 8 9 10 11
|
|
data r0/0.70,0.72,0.74,0.76,0.78,0.80,0.82,0.84,0.86,0.88,0.90,0.90/
|
|
data nutc0/-999/,nfreq0/-999/,nsave/0/,clear_avg65/.true./
|
|
save
|
|
|
|
this%callback => callback
|
|
first_time=nrobust !Silence compiler warning
|
|
first_time=newdat
|
|
dd=dd0
|
|
ndecoded=0
|
|
ndecoded0=0
|
|
|
|
if(nsubmode.ge.100) then
|
|
! This is QRA64 mode
|
|
mode64=2**(nsubmode-100)
|
|
call qra64a(dd,npts,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, &
|
|
emedelay,mycall,hiscall,hisgrid,sync,nsnr,dtx,nfreq,decoded,nft)
|
|
if (associated(this%callback)) then
|
|
ndrift=0
|
|
nflip=1
|
|
width=1.0
|
|
nsmo=0
|
|
nqual=0
|
|
call this%callback(sync,nsnr,dtx,nfreq,ndrift, &
|
|
nflip,width,decoded,nft,nqual,nsmo,1,minsync)
|
|
end if
|
|
go to 900
|
|
endif
|
|
|
|
single_decode=iand(nexp_decode,32).ne.0 .or. nagain
|
|
bVHF=iand(nexp_decode,64).ne.0
|
|
|
|
if(bVHF) then
|
|
nvec=ntrials
|
|
npass=1
|
|
if(n2pass.gt.1) npass=2
|
|
else
|
|
nvec=1000
|
|
if(ndepth.eq.1) then
|
|
npass=2
|
|
nvec=100
|
|
elseif(ndepth.eq.2) then
|
|
npass=2
|
|
nvec=1000
|
|
else
|
|
npass=4
|
|
nvec=1000
|
|
endif
|
|
endif
|
|
do ipass=1,npass
|
|
first_time=.true.
|
|
if(ipass.eq.1) then !First-pass parameters
|
|
thresh0=2.5
|
|
nsubtract=1
|
|
nrob=0
|
|
elseif( ipass.eq.2 ) then !Second-pass parameters
|
|
thresh0=2.0
|
|
nsubtract=1
|
|
nrob=0
|
|
elseif( ipass.eq.3 ) then
|
|
thresh0=2.0
|
|
nsubtract=1
|
|
nrob=0
|
|
elseif( ipass.eq.4 ) then
|
|
thresh0=2.0
|
|
nsubtract=0
|
|
nrob=1
|
|
endif
|
|
if(npass.eq.1) then
|
|
nsubtract=0
|
|
thresh0=2.0
|
|
endif
|
|
|
|
call timer('symsp65 ',0)
|
|
ss=0.
|
|
call symspec65(dd,npts,nqsym,savg) !Get normalized symbol spectra
|
|
call timer('symsp65 ',1)
|
|
nfa=nf1
|
|
nfb=nf2
|
|
|
|
!### Q: should either of the next two uses of "single_decode" be "bVHF" instead?
|
|
if(single_decode .or. (bVHF .and. ntol.lt.1000)) then
|
|
nfa=max(200,nfqso-ntol)
|
|
nfb=min(4000,nfqso+ntol)
|
|
thresh0=1.0
|
|
endif
|
|
df=12000.0/8192.0 !df = 1.465 Hz
|
|
if(bVHF) then
|
|
ia=max(1,nint(nfa/df)-ntol)
|
|
ib=min(NSZ,nint(nfb/df)+ntol)
|
|
nz=ib-ia+1
|
|
call lorentzian(savg(ia),nz,a)
|
|
baseline=a(1)
|
|
amp=a(2)
|
|
f0=(a(3)+ia-1)*df
|
|
width=a(4)*df
|
|
endif
|
|
|
|
ncand=0
|
|
call timer('sync65 ',0)
|
|
call sync65(nfa,nfb,ntol,nqsym,ca,ncand,nrob,bVHF)
|
|
ncand=min(ncand,50/ipass)
|
|
call timer('sync65 ',1)
|
|
|
|
mode65=2**nsubmode
|
|
nflip=1
|
|
nqd=0
|
|
decoded=' '
|
|
decoded0=""
|
|
freq0=0.
|
|
prtavg=.false.
|
|
if(.not.nagain) nsum=0
|
|
if(clearave) then
|
|
nsum=0
|
|
nsave=0
|
|
clear_avg65=.true.
|
|
endif
|
|
|
|
if(bVHF) then
|
|
! Be sure to search for shorthand message at nfqso +/- ntol
|
|
if(ncand.lt.300) ncand=ncand+1
|
|
ca(ncand)%sync=5.0
|
|
ca(ncand)%dt=2.5
|
|
ca(ncand)%freq=nfqso
|
|
ca(ncand)%flip=0
|
|
endif
|
|
do icand=1,ncand
|
|
sync1=ca(icand)%sync
|
|
dtx=ca(icand)%dt
|
|
freq=ca(icand)%freq
|
|
if(bVHF) then
|
|
flip=ca(icand)%flip
|
|
nflip=int(flip)
|
|
endif
|
|
if(sync1.lt.float(minsync)) nflip=0
|
|
if(ipass.eq.1) ntry65a=ntry65a + 1
|
|
if(ipass.eq.2) ntry65b=ntry65b + 1
|
|
call timer('decod65a',0)
|
|
nft=0
|
|
nspecial=0
|
|
call decode65a(dd,npts,first_time,nqd,freq,nflip,mode65,nvec, &
|
|
naggressive,ndepth,ntol,mycall,hiscall,hisgrid,nQSOProgress, &
|
|
ljt65apon,bVHF,sync2,a,dtx,nft,nspecial,qual, &
|
|
nhist,nsmo,decoded)
|
|
call timer('decod65a',1)
|
|
|
|
if(.not.bVHF) then
|
|
if(abs(a(1)).gt.10.0/ipass) cycle
|
|
ibad=0
|
|
if(abs(a(1)).gt.5.0) ibad=1
|
|
if(abs(a(2)).gt.2.0) ibad=ibad+1
|
|
if(abs(dtx-1.0).gt.2.5) ibad=ibad+1
|
|
if(ibad.ge.2) cycle
|
|
endif
|
|
|
|
if(nspecial.eq.0 .and. sync1.eq.5.0 .and. dtx.eq.2.5) cycle
|
|
if(nspecial.eq.2) decoded='RO'
|
|
if(nspecial.eq.3) decoded='RRR'
|
|
if(nspecial.eq.4) decoded='73'
|
|
if(sync1.lt.float(minsync) .and. &
|
|
decoded.eq.' ') nflip=0
|
|
if(nft.ne.0) nsum=1
|
|
|
|
nhard_min=param(1)
|
|
nrtt1000=param(4)
|
|
ntotal_min=param(5)
|
|
nsmo=param(9)
|
|
|
|
nfreq=nint(freq+a(1))
|
|
ndrift=nint(2.0*a(2))
|
|
if(bVHF) then
|
|
xtmp=10**((sync1+16.0)/10.0) ! sync comes to us in dB
|
|
s2db=1.1*db(xtmp)+1.4*(dB(width)-4.3)-52.0
|
|
! s2db=sync1 - 30.0 + db(width/3.3) !### VHF/UHF/microwave
|
|
if(nspecial.gt.0) s2db=sync2
|
|
else
|
|
s2db=10.0*log10(sync2) - 35 !### Empirical (HF)
|
|
endif
|
|
nsnr=nint(s2db)
|
|
if(nsnr.lt.-30) nsnr=-30
|
|
if(nsnr.gt.-1) nsnr=-1
|
|
nftt=0
|
|
!********* DOES THIS STILL WORK WHEN NFT INCLUDES # OF AP SYMBOLS USED??
|
|
if(nft.ne.1 .and. iand(ndepth,16).eq.16 .and. &
|
|
sync1.ge.float(minsync) .and. (.not.prtavg)) then
|
|
! Single-sequence FT decode failed, so try for an average FT decode.
|
|
if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then
|
|
! This is a new minute or a new frequency, so call avg65.
|
|
nutc0=nutc
|
|
nfreq0=nfreq
|
|
nsave=nsave+1
|
|
nsave=mod(nsave-1,64)+1
|
|
call avg65(nutc,nsave,sync1,dtx,nflip,nfreq,mode65,ntol, &
|
|
ndepth,nagain,ntrials,naggressive,clear_avg65,neme, &
|
|
mycall,hiscall,hisgrid,nftt,avemsg,qave,deepave,nsum, &
|
|
ndeepave,nQSOProgress,ljt65apon)
|
|
nsmo=param(9)
|
|
nqave=int(qave)
|
|
|
|
if (associated(this%callback) .and.nftt.ge.1 .and. nsum.ge.2) then
|
|
! Display a decoded message obtained by averaging 2 or more transmissions
|
|
call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, &
|
|
nflip,width,avemsg,nftt,nqave,nsmo,nsum,minsync)
|
|
prtavg=.true.
|
|
end if
|
|
|
|
endif
|
|
endif
|
|
|
|
if(nftt.eq.0) go to 5
|
|
! if(nftt.eq.1) then
|
|
!! nft=1
|
|
! decoded=avemsg
|
|
! go to 5
|
|
! endif
|
|
n=naggressive
|
|
rtt=0.001*nrtt1000
|
|
if(nft.lt.2 .and. minsync.ge.0 .and. nspecial.eq.0 .and. .not.bVHF) then
|
|
if(nhard_min.gt.50) cycle
|
|
if(nhard_min.gt.h0(n)) cycle
|
|
if(ntotal_min.gt.d0(n)) cycle
|
|
if(rtt.gt.r0(n)) cycle
|
|
endif
|
|
|
|
5 continue
|
|
if(decoded.eq.decoded0 .and. abs(freq-freq0).lt. 3.0 .and. &
|
|
minsync.ge.0) cycle !Don't display dupes
|
|
! if(decoded.ne.' ' .or. minsync.lt.0) then
|
|
if(decoded.ne.' ' .or. bVHF) then
|
|
if(nsubtract.eq.1) then
|
|
call timer('subtr65 ',0)
|
|
call subtract65(dd,npts,freq,dtx)
|
|
call timer('subtr65 ',1)
|
|
endif
|
|
|
|
ndupe=0 ! de-dedupe
|
|
do i=1, ndecoded
|
|
if(decoded==dec(i)%decoded) then
|
|
ndupe=1
|
|
exit
|
|
endif
|
|
enddo
|
|
if(ndupe.ne.1 .and. ((sync1.ge.float(minsync)) .or. bVHF)) then
|
|
if(ipass.eq.1) n65a=n65a + 1
|
|
if(ipass.eq.2) n65b=n65b + 1
|
|
if(ndecoded.lt.50) ndecoded=ndecoded+1
|
|
dec(ndecoded)%freq=freq+a(1)
|
|
dec(ndecoded)%dt=dtx
|
|
dec(ndecoded)%sync=sync2
|
|
dec(ndecoded)%decoded=decoded
|
|
nqual=min(int(qual),9999)
|
|
|
|
if(associated(this%callback)) then
|
|
call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, &
|
|
nflip,width,decoded,nft,nqual,nsmo,1,minsync)
|
|
end if
|
|
endif
|
|
decoded0=decoded
|
|
freq0=freq
|
|
if(decoded0.eq.' ') decoded0='*'
|
|
if(single_decode .and. ndecoded.gt.0) go to 900
|
|
endif
|
|
enddo ! icand
|
|
if(ipass.gt.1 .and. ndecoded.eq.ndecoded0) exit
|
|
ndecoded0=ndecoded
|
|
enddo ! ipass
|
|
900 return
|
|
end subroutine decode
|
|
|
|
subroutine avg65(nutc,nsave,snrsync,dtxx,nflip,nfreq,mode65,ntol,ndepth, &
|
|
nagain, ntrials,naggressive,clear_avg65,neme,mycall,hiscall,hisgrid, &
|
|
nftt,avemsg,qave,deepave,nsum,ndeepave,nQSOProgress,ljt65apon)
|
|
|
|
! Decodes averaged JT65 data
|
|
|
|
use jt65_mod
|
|
parameter (MAXAVE=64)
|
|
character*22 avemsg,deepave,deepbest
|
|
character mycall*12,hiscall*12,hisgrid*6
|
|
character*1 csync,cused(64)
|
|
logical nagain
|
|
integer iused(64)
|
|
! Accumulated data for message averaging
|
|
integer iutc(MAXAVE)
|
|
integer nfsave(MAXAVE)
|
|
integer nflipsave(MAXAVE)
|
|
real s1b(-255:256,126)
|
|
real s1save(-255:256,126,MAXAVE)
|
|
real s2(66,126)
|
|
real s3save(64,63,MAXAVE)
|
|
real s3b(64,63)
|
|
real s3c(64,63)
|
|
real dtsave(MAXAVE)
|
|
real syncsave(MAXAVE)
|
|
logical first,clear_avg65,ljt65apon
|
|
data first/.true./
|
|
save
|
|
|
|
if(first .or. clear_avg65) then
|
|
iutc=-1
|
|
nfsave=0
|
|
dtdiff=0.2
|
|
s3save=0.
|
|
s1save=0.
|
|
nsave=1 !### ???
|
|
! Silence compiler warnings
|
|
if(nagain .and. ndeepave.eq.-99 .and. neme.eq.-99) stop
|
|
first=.false.
|
|
clear_avg65=.false.
|
|
endif
|
|
|
|
do i=1,64
|
|
if(iutc(i).lt.0) exit
|
|
if(nutc.eq.iutc(i) .and. abs(nfreq-nfsave(i)).le.ntol) go to 10
|
|
enddo
|
|
|
|
! Save data for message averaging
|
|
iutc(nsave)=nutc
|
|
syncsave(nsave)=snrsync
|
|
dtsave(nsave)=dtxx
|
|
nfsave(nsave)=nfreq
|
|
nflipsave(nsave)=nflip
|
|
s1save(-255:256,1:126,nsave)=s1
|
|
s3save(1:64,1:63,nsave)=s3a
|
|
avemsg=' '
|
|
deepbest=' '
|
|
nfttbest=0
|
|
|
|
10 syncsum=0.
|
|
dtsum=0.
|
|
nfsum=0
|
|
nsum=0
|
|
s1b=0.
|
|
s3b=0.
|
|
s3c=0.
|
|
|
|
do i=1,MAXAVE !Consider all saved spectra
|
|
cused(i)='.'
|
|
if(iutc(i).lt.0) exit
|
|
if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same (odd/even) seq
|
|
if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match
|
|
if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match
|
|
if(nflip.ne.nflipsave(i)) cycle !Sync type (*/#) must match
|
|
s3b=s3b + s3save(1:64,1:63,i)
|
|
s1b=s1b + s1save(-255:256,1:126,i)
|
|
syncsum=syncsum + syncsave(i)
|
|
dtsum=dtsum + dtsave(i)
|
|
nfsum=nfsum + nfsave(i)
|
|
cused(i)='$'
|
|
nsum=nsum+1
|
|
iused(nsum)=i
|
|
enddo
|
|
if(nsum.lt.64) iused(nsum+1)=0
|
|
|
|
syncave=0.
|
|
dtave=0.
|
|
fave=0.
|
|
if(nsum.gt.0) then
|
|
syncave=syncsum/nsum
|
|
dtave=dtsum/nsum
|
|
fave=float(nfsum)/nsum
|
|
endif
|
|
|
|
do i=1,nsave
|
|
csync='*'
|
|
if(nflipsave(i).lt.0.0) csync='#'
|
|
write(14,1000) cused(i),iutc(i),syncsave(i),dtsave(i)-1.0,nfsave(i),csync
|
|
1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1)
|
|
enddo
|
|
if(nsum.lt.2) go to 900
|
|
|
|
df=1378.125/512.0
|
|
|
|
! Do the smoothing loop
|
|
qualbest=0.
|
|
minsmo=0
|
|
maxsmo=0
|
|
if(mode65.ge.2) then
|
|
minsmo=nint(width/df)
|
|
maxsmo=2*minsmo
|
|
endif
|
|
nn=0
|
|
do ismo=minsmo,maxsmo
|
|
nftt=0
|
|
if(ismo.gt.0) then
|
|
do j=1,126
|
|
call smo121(s1b(-255,j),512)
|
|
if(j.eq.1) nn=nn+1
|
|
if(nn.ge.4) then
|
|
call smo121(s1b(-255,j),512)
|
|
if(j.eq.1) nn=nn+1
|
|
endif
|
|
enddo
|
|
endif
|
|
|
|
do i=1,66
|
|
jj=i
|
|
if(mode65.eq.2) jj=2*i-1
|
|
if(mode65.eq.4) then
|
|
ff=4*(i-1)*df - 355.297852
|
|
jj=nint(ff/df)+1
|
|
endif
|
|
s2(i,1:126)=s1b(jj,1:126)
|
|
enddo
|
|
|
|
do j=1,63
|
|
k=mdat(j) !Points to data symbol
|
|
if(nflip.lt.0) k=mdat2(j)
|
|
do i=1,64
|
|
s3c(i,j)=4.e-5*s2(i+2,k)
|
|
enddo
|
|
enddo
|
|
|
|
nadd=nsum*ismo
|
|
call extract(s3c,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, &
|
|
hiscall,hisgrid,nQSOProgress,ljt65apon,ncount,nhist, &
|
|
avemsg,ltext,nftt,qual)
|
|
if(nftt.eq.1) then
|
|
nsmo=ismo
|
|
param(9)=nsmo
|
|
go to 900
|
|
else if(nftt.ge.2) then
|
|
if(qual.gt.qualbest) then
|
|
deepbest=avemsg
|
|
qualbest=qual
|
|
nnbest=nn
|
|
nsmobest=ismo
|
|
nfttbest=nftt
|
|
endif
|
|
endif
|
|
enddo
|
|
if(nfttbest.eq.2) then
|
|
avemsg=deepbest !### ???
|
|
deepave=deepbest
|
|
qave=qualbest
|
|
nsmo=nsmobest
|
|
param(9)=nsmo
|
|
nftt=nfttbest
|
|
endif
|
|
900 continue
|
|
|
|
return
|
|
end subroutine avg65
|
|
|
|
end module jt65_decode
|