Varioous adjustments to a7 decoding for FT8.

This commit is contained in:
Joe Taylor 2021-11-11 12:28:24 -05:00
parent c13407612e
commit 6020552473
5 changed files with 192 additions and 160 deletions

161
lib/ft8/chkdec.f90 Normal file
View File

@ -0,0 +1,161 @@
program chkdec
parameter(NMAX=100)
character*88 line
character*37 msg(NMAX),msg0,msg1
character*2 c2(NMAX)
character*1 c1(NMAX)
character*1 only
integer nsnr(NMAX,0:1),nf(NMAX,0:1)
real dt(NMAX,0:1)
logical found,eof
! These files are sorted by freq within each Rx sequence
open(10,file='all.wsjtx',status='old')
open(11,file='all.jtdx',status='old')
write(20,1030)
1030 format(' iseq B w j W W+ J E B w j W', &
' W+ J E'/80('-'))
nutc0=-1
nbt=0 !Both
nwt=0 !WSJT-X only
njt=0 !JTDX only
net=0 !Either
n7t=0 !a7
eof=.false.
do iseq=1,9999
j=0
msg=' '
nsnr=-99
nf=-99
dt=-99
c1=' '
c2=' '
do i=1,NMAX
read(10,'(a88)',end=8) line !Read from the WSJT-X file
if(line(25:30).ne.'Rx FT8') cycle !Ignore any line not an FT8 decode
read(line(8:13),*) nutc
if(nutc0.lt.0) nutc0=nutc !First time only
if(nutc.ne.nutc0) then
backspace(10)
go to 10 !Finished WSJT-X for this sequence
endif
j=j+1
if(j.eq.1) then
nf(j,0)=-1
j=j+1
endif
read(line,1001) nsnr(j,0),dt(j,0),nf(j,0),msg(j),c2(j)
1001 format(30x,i7,f5.1,i5,1x,a36,2x,a2)
! if(nutc.eq.180215 .and. c2(j).eq.'a7') print*,'aaa',j,nf(j,0),c2(j)
nutc0=nutc
enddo ! i
8 eof=.true.
10 jz=j
do i=1,NMAX
read(11,'(a88)',end=20) line !Read from the JTDX file
if(line(31:31).ne.'~') cycle !Ignore any line not an FT8 decode
read(line(10:15),*) nutc
if(nutc.ne.nutc0) then
backspace(11)
go to 20 !Finished JTDX for this sequence
endif
msg1=line(33:58)
read(line(25:29),*) nf1
found=.false.
do j=1,jz
if(msg(j).eq.msg1) then
read(line,1002) nsnr(j,1),dt(j,1),nf(j,1),c1(j)
1002 format(15x,i4,f5.1,i5,29x,a1)
found=.true.
exit
endif
i1=index(msg(j),'<')
if(i1.gt.0) then
i2=index(msg(j),'>')
msg0=msg(j)(1:i1-1)//msg(j)(i1+1:i2-1)//msg(j)(i2+1:)
if(msg0.eq.msg1) then
read(line,1002) nsnr(j,1),dt(j,1),nf(j,1),c1(j)
found=.true.
exit
endif
endif
enddo ! j
if(.not.found) then !Insert this one as a new message
do j=1,jz
if(nf1.ge.nf(j,0) .and. nf1.lt.nf(j+1,0)) then
jj=j+1
exit
endif
enddo
do j=jz+1,jj+1,-1
nsnr(j,0)=nsnr(j-1,0)
dt(j,0)=dt(j-1,0)
nf(j,0)=nf(j-1,0)
msg(j)=msg(j-1)
c1(j)=c1(j-1)
c2(j)=c2(j-1)
enddo ! j
read(line,1004) nsnr(jj,1),dt(jj,1),nf(jj,1),msg(jj),c1(jj)
1004 format(15x,i4,f5.1,i5,3x,a26,a1)
c2(jj)=' '
nsnr(jj,0)=-99
dt(jj,0)=-99.0
nf(jj,0)=-99
jz=jz+1
endif
enddo ! i
20 nb=0
nw=0
nj=0
ne=0
n7=0
do j=2,jz
write(line,1020) nutc0,j,nsnr(j,:),dt(j,:),nf(j,:),msg(j)(1:26), &
c2(j),c1(j)
1020 format(i6.6,i3,1x,2i4,1x,2f6.1,1x,2i5,1x,a26,1x,a2,1x,a1)
if(c2(j).eq.'a7') n7=n7+1
only=' '
if(line(12:14).eq.'-99') then
line(12:14)=' '
only='j'
nj=nj+1
! if(c2(j).eq.'a7') print*,'aaa ',trim(line)
endif
if(line(16:18).eq.'-99') then
line(16:18)=' '
only='w'
nw=nw+1
endif
if(line(12:14).ne.' ' .or. line(16:19).ne.' ') ne=ne+1
if(line(12:14).ne.' ' .and. line(16:19).ne.' ') nb=nb+1
if(line(21:25).eq.'-99.0') line(21:25)=' '
if(line(27:31).eq.'-99.0') line(27:31)=' '
if(line(35:37).eq.'-99') line(35:37)=' '
if(line(40:42).eq.'-99') line(40:42)=' '
! if(line(12:14).ne.' ') nw=nw+1
! if(line(16:18).ne.' ') nj=nj+1
write(*,'(a74,1x,a1)') line(1:74),only
enddo ! j
nbt=nbt+nb
nwt=nwt+nw
n7t=n7t+n7
njt=njt+nj
net=net+ne
nutc0=nutc
write(*,*)
write(20,1031) iseq,nb,nw,nj,nb+nw-n7,nb+nw,nb+nj,ne,nbt,nwt,njt, &
nbt+nwt-n7t,nbt+nwt,nbt+njt,net
1031 format(i5,2x,7i4,2x,7i6)
if(eof) exit
! if(iseq.eq.2) exit
enddo ! iseq
end program chkdec

View File

@ -85,7 +85,7 @@ subroutine ft8_a7d(dd0,newdat,call_1,call_2,grid4,xdt,f1,nharderrors,dmin, &
real a(5)
real s8(0:7,NN)
real s2(0:511)
real dabcd(4)
real dmm(206)
real bmeta(174),bmetb(174),bmetc(174),bmetd(174)
real llra(174),llrb(174),llrc(174),llrd(174) !Soft symbols
real dd0(15*12000)
@ -96,7 +96,6 @@ subroutine ft8_a7d(dd0,newdat,call_1,call_2,grid4,xdt,f1,nharderrors,dmin, &
integer*1 nxor(174),hdec(174)
integer itone(NN)
integer icos7(0:6),ip(1)
integer ndm(4)
logical one(0:511,0:8)
integer graymap(0:7)
integer iloc(1)
@ -109,7 +108,7 @@ subroutine ft8_a7d(dd0,newdat,call_1,call_2,grid4,xdt,f1,nharderrors,dmin, &
data icos7/3,1,4,0,6,5,2/ !Sync array
data first/.true./
data graymap/0,1,3,2,5,6,4,7/
save one,ndm
save one
if(first) then
one=.false.
@ -119,7 +118,6 @@ subroutine ft8_a7d(dd0,newdat,call_1,call_2,grid4,xdt,f1,nharderrors,dmin, &
enddo
enddo
first=.false.
ndm=0
endif
call stdcall(call_1,std_1)
@ -326,7 +324,7 @@ subroutine ft8_a7d(dd0,newdat,call_1,call_2,grid4,xdt,f1,nharderrors,dmin, &
hdec=0
where(llrb.ge.0.0) hdec=1
nxor=ieor(hdec,cw)
db=sum(nxor*abs(llrb))
dbb=sum(nxor*abs(llrb))
hdec=0
where(llrc.ge.0.0) hdec=1
@ -338,150 +336,40 @@ subroutine ft8_a7d(dd0,newdat,call_1,call_2,grid4,xdt,f1,nharderrors,dmin, &
nxor=ieor(hdec,cw)
dd=sum(nxor*abs(llrd))
dm=min(da,db,dc,dd)
dm=min(da,dbb,dc,dd)
dmm(imsg)=dm
if(dm.lt.dmin) then
dmin=dm
dabcd(1)=da
dabcd(2)=db
dabcd(3)=dc
dabcd(4)=dd
msgbest=msgsent
if(dmin.le.60.0) nharderrors=count((2*cw-1)*llra.lt.0.0)
if(dm.eq.da) then
nharderrors=count((2*cw-1)*llra.lt.0.0)
pbest=pa
else if(dm.eq.dbb) then
nharderrors=count((2*cw-1)*llrb.lt.0.0)
pbest=pb
else if(dm.eq.dc) then
nharderrors=count((2*cw-1)*llrc.lt.0.0)
pbest=pc
else if(dm.eq.dd) then
nharderrors=count((2*cw-1)*llrd.lt.0.0)
pbest=pd
endif
endif
enddo ! imsg
if(dmin.le.60.0) then
if(dmin.eq.dabcd(1)) ndm(1)=ndm(1)+1
if(dmin.eq.dabcd(2)) ndm(2)=ndm(2)+1
if(dmin.eq.dabcd(3)) ndm(3)=ndm(3)+1
if(dmin.eq.dabcd(4)) ndm(4)=ndm(4)+1
! write(41,3041) nharderrors,dmin,dabcd,ndm,ibest,delfbest,trim(msgbest)
!3041 format(i5,5f8.2,4i4,i5,f7.1,1x,a)
! else
! f00=0.0
! call ft8q3(cd0,xdt,f00,call_1,call_2,grid4,msgbest,snr)
! if(snr.gt.5.0) then
! nharderrors=0
! dmin=0.
! xsnr=snr-25.0
! endif
endif
iloc=minloc(dmm)
dmm(iloc(1))=1.e30
iloc=minloc(dmm)
dmin2=dmm(iloc(1))
xsnr=-24.
if(pbest.gt.0.0) xsnr=db(pbest/50.0) - 24.0
! write(41,3041) nharderrors,dmin,dmin2,dmin2/dmin,xsnr,trim(msgbest)
!3041 format(i3,2f7.1,f7.2,f7.1,1x,a)
if(dmin.gt.100.0 .or. dmin2/dmin.lt.1.3) nharderrors=-1
msg37=msgbest
return
end subroutine ft8_a7d
subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr)
! Get q3-style decodes for FT8.
use packjt77
parameter(NN=79,NSPS=32)
parameter(NWAVE=NN*NSPS) !2528
parameter(NZ=3200,NLAGS=NZ-NWAVE)
character*12 call_1,call_2
character*4 grid4
character*37 msg,msgbest,msgsent
character c77*77
complex cwave(0:NWAVE-1)
complex cd(0:NZ-1)
complex z
real xjunk(NWAVE)
real ccf(0:NLAGS-1)
real ccfmsg(206)
integer itone(NN)
integer*1 msgbits(77)
logical std_1,std_2
if(xdt.eq.-99.0) return !Silence compiler warning
call stdcall(call_1,std_1)
call stdcall(call_2,std_2)
fs=200.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
bt=2.0
ccfbest=0.
lagbest=-1
do imsg=1,206
msg=trim(call_1)//' '//trim(call_2)
i=imsg
if(.not.std_1) then
if(i.eq.1 .or. i.ge.6) msg='<'//trim(call_1)//'> '//trim(call_2)
if(i.ge.2 .and. i.le.4) msg=trim(call_1)//' <'//trim(call_2)//'>'
else if(.not.std_2) then
if(i.le.4 .or. i.eq.6) msg='<'//trim(call_1)//'> '//trim(call_2)
if(i.ge.7) msg=trim(call_1)//' <'//trim(call_2)//'>'
endif
j0=len(trim(msg))+2
if(i.eq.2) msg(j0:j0+2)='RRR'
if(i.eq.3) msg(j0:j0+3)='RR73'
if(i.eq.4) msg(j0:j0+1)='73'
if(i.eq.5) then
if(std_2) msg='CQ '//trim(call_2)//' '//grid4
if(.not.std_2) msg='CQ '//trim(call_2)
endif
if(i.eq.6 .and. std_2) msg(j0:j0+3)=grid4
if(i.ge.7 .and. i.le.206) then
isnr = -50 + (i-7)/2
if(iand(i,1).eq.1) then
write(msg(j0:j0+2),'(i3.2)') isnr
if(msg(j0:j0).eq.' ') msg(j0:j0)='+'
else
write(msg(j0:j0+3),'("R",i3.2)') isnr
if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+'
endif
endif
! Source-encode, then get itone()
i3=-1
n3=-1
call pack77(msg,i3,n3,c77)
call genft8(msg,i3,n3,msgsent,msgbits,itone)
! Generate complex cwave
call gen_ft8wave(itone,NN,NSPS,bt,fs,f0,cwave,xjunk,1,NWAVE)
lagmax=-1
ccfmax=0.
nsum=32*2
do lag=0,nlags-1
z=0.
s=0.
do i=0,NWAVE-1
z=z + cd(i+lag)*conjg(cwave(i))
if(mod(i,nsum).eq.nsum-1 .or. i.eq.NWAVE-1) then
s=s + abs(z)
z=0.
endif
enddo
ccf(lag)=s
if(ccf(lag).gt.ccfmax) then
ccfmax=ccf(lag)
lagmax=lag
endif
enddo ! lag
ccfmsg(imsg)=ccfmax
if(ccfmax.gt.ccfbest) then
ccfbest=ccfmax
lagbest=lagmax
msgbest=msg
endif
enddo ! imsg
call pctile(ccfmsg,207,50,base)
call pctile(ccfmsg,207,67,sigma)
sigma=sigma-base
ccfmsg=(ccfmsg-base)/sigma
! do imsg=1,207
! write(44,3044) imsg,ccfmsg(imsg)
!3044 format(i5,f10.3)
! enddo
snr=maxval(ccfmsg)
return
end subroutine ft8q3
end module ft8_a7

View File

@ -15,7 +15,7 @@ subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr)
complex z
real xjunk(NWAVE)
real ccf(0:NLAGS-1)
real ccfmsg(207)
real ccfmsg(206)
integer itone(NN)
integer*1 msgbits(77)
logical std_1,std_2
@ -30,7 +30,7 @@ subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr)
ccfbest=0.
lagbest=-1
do imsg=1,207
do imsg=1,206
msg=trim(call_1)//' '//trim(call_2)
i=imsg
if(.not.std_1) then
@ -59,7 +59,6 @@ subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr)
if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+'
endif
endif
if(i.eq.207) msg='TNX 73 GL'
! Source-encode, then get itone()
i3=-1
@ -69,14 +68,6 @@ subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr)
! Generate complex cwave
call gen_ft8wave(itone,NN,NSPS,bt,fs,f0,cwave,xjunk,1,NWAVE)
if(imsg.eq.79) then
print*,NN,NSPS,bt,fs,f0,NWAVE,itone(1:7)
do i=0,NWAVE-1
write(45,3045) i,cd(i),100*cwave(i)
3045 format(i5,4e12.3)
enddo
endif
lagmax=-1
ccfmax=0.
nsum=32*2
@ -107,7 +98,7 @@ subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr)
call pctile(ccfmsg,207,50,base)
call pctile(ccfmsg,207,67,sigma)
sigma=sigma-base
ccfmsg=(ccfmsg-base)/(2.5*sigma)
ccfmsg=(ccfmsg-base)/sigma
! do imsg=1,207
! write(44,3044) imsg,ccfmsg(imsg)
!3044 format(i5,f10.3)

View File

@ -8,7 +8,7 @@ subroutine subtractft8(dd0,itone,f0,dt,lrefinedt)
! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt}
parameter (NMAX=15*12000,NFRAME=1920*79)
parameter (NFFT=NMAX,NFILT=4000)
parameter (NFFT=NMAX,NFILT=6500)
real dd(NMAX),dd0(NMAX)
real window(-NFILT/2:NFILT/2)
real x(NFFT+2)

View File

@ -258,26 +258,18 @@ contains
call ft8_a7d(dd,newdat,call_1,call_2,grid4,xdt,f1,nharderrors, &
dmin,msg37,xsnr)
call timer('ft8_a7d ',1)
! write(51,3051) i,xdt,nint(f1),nharderrors,dmin,call_1,call_2,grid4
!3051 format(i3,f7.2,2i5,f7.1,1x,a12,a12,1x,a4)
if(nharderrors.ge.0) then
if(associated(this%callback)) then
nsnr=xsnr
iaptype=7
if(nharderrors.eq.0 .and.dmin.eq.0.0) iaptype=8
qual=1.0
! if(iaptype.eq.8) print*,'b',nsnr,xdt,f1,msg37,'a8'
call this%callback(sync,nsnr,xdt,f1,msg37,iaptype,qual)
call ft8_a7_save(nutc,xdt,f1,msg37) !Enter decode in table
endif
! write(*,3901) xdt,nint(f1),nharderrors,dmin,trim(msg37)
!3901 format('$$$',f6.1,i5,i5,f7.1,1x,a)
endif
! newdat=.false.
enddo
endif
! if(nzhsym.eq.50) print*,'A',ndec(0,0:1),ndec(1,0:1)
return
end subroutine decode