Hound can now decode Fox messages with i3bit=1.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@8297 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor 2017-12-08 17:03:11 +00:00
parent 075307da68
commit 385c83658e
7 changed files with 111 additions and 64 deletions

View File

@ -438,6 +438,7 @@ set (wsjt_FSRCS
lib/foldspec9f.f90 lib/foldspec9f.f90
lib/four2a.f90 lib/four2a.f90
lib/ft8/foxgen.f90 lib/ft8/foxgen.f90
lib/ft8/foxgen_wrap.f90
lib/fqso_first.f90 lib/fqso_first.f90
lib/freqcal.f90 lib/freqcal.f90
lib/fsk4hf/fsk4hf.f90 lib/fsk4hf/fsk4hf.f90

View File

@ -435,13 +435,13 @@ contains
integer, intent(in) :: snr integer, intent(in) :: snr
real, intent(in) :: dt real, intent(in) :: dt
real, intent(in) :: freq real, intent(in) :: freq
character(len=22), intent(in) :: decoded character(len=32), intent(in) :: decoded
character c1*12,c2*6,g2*4,w*4 character c1*12,c2*6,g2*4,w*4
integer i1,i2,i3,n15,nwrap integer i0,i1,i2,i3,n15,nwrap
integer, intent(in) :: nap integer, intent(in) :: nap
real, intent(in) :: qual real, intent(in) :: qual
character*2 annot character*2 annot
character*22 decoded0 character*32 decoded0
logical isgrid4,first logical isgrid4,first
data first/.true./ data first/.true./
save save
@ -464,15 +464,20 @@ contains
endif endif
decoded0=decoded decoded0=decoded
annot=' ' annot=' '
if(nap.ne.0) then if(nap.ne.0) then
write(annot,'(a1,i1)') 'a',nap write(annot,'(a1,i1)') 'a',nap
if(qual.lt.0.17) decoded0(22:22)='?' if(qual.lt.0.17) decoded0(22:22)='?'
endif endif
write(*,1000) params%nutc,snr,dt,nint(freq),decoded0,annot
i0=index(decoded0,';')
if(i0.le.0) write(*,1000) params%nutc,snr,dt,nint(freq),decoded0(1:22),annot
1000 format(i6.6,i4,f5.1,i5,' ~ ',1x,a22,1x,a2) 1000 format(i6.6,i4,f5.1,i5,' ~ ',1x,a22,1x,a2)
if(i0.gt.0) write(*,1001) params%nutc,snr,dt,nint(freq),decoded0
1001 format(i6.6,i4,f5.1,i5,' ~ ',1x,a32)
write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0 write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0
1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a22,' FT8') 1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a32,' FT8')
i1=index(decoded0,' ') i1=index(decoded0,' ')
i2=i1 + index(decoded0(i1+1:),' ') i2=i1 + index(decoded0(i1+1:),' ')

View File

@ -23,7 +23,7 @@ subroutine extractmessage174(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
i1Dec8BitBytes(11)=0 i1Dec8BitBytes(11)=0
icrc12=crc12(c_loc(i1Dec8BitBytes),11) !CRC12 computed from 75 msg bits icrc12=crc12(c_loc(i1Dec8BitBytes),11) !CRC12 computed from 75 msg bits
if(ncrc12.eq.icrc12) then if(ncrc12.eq.icrc12 .or. sum(decoded(57:87)).eq.0) then !### Kludge ###
! CRC12 checks out --- unpack 72-bit message ! CRC12 checks out --- unpack 72-bit message
do ibyte=1,12 do ibyte=1,12
itmp=0 itmp=0

View File

@ -1,5 +1,19 @@
subroutine foxgen() subroutine foxgen()
! Called from MainWindow::foxTxSequencer() to generate the Tx waveform in
! FT8 Fox mode. The Tx message can contain up to 5 "slots", each carrying
! its own FT8 signal.
! Encoded messages can be of the form "HoundCall FoxCall rpt" (a standard FT8
! message with i3bit=0) or "HoundCall_1 RR73; HoundCall_2 <FoxCall> rpt",
! a new message type with i3bit=1. The waveform is generated with
! fsample=48000 Hz; it is compressed to reduce the PEP-to-average power ratio,
! with (currently disabled) filtering afterware to reduce spectral growth.
! Input message information is provided in character array cmsg(5), in
! common/foxcom/. The generated wave(NWAVE) is passed back in the same
! common block.
use crc use crc
parameter (NN=79,ND=58,KK=87,NSPS=4*1920) parameter (NN=79,ND=58,KK=87,NSPS=4*1920)
parameter (NWAVE=NN*NSPS,NFFT=614400,NH=NFFT/2) parameter (NWAVE=NN*NSPS,NFFT=614400,NH=NFFT/2)
@ -11,13 +25,14 @@ subroutine foxgen()
logical bcontest,checksumok logical bcontest,checksumok
integer itone(NN) integer itone(NN)
integer icos7(0:6) integer icos7(0:6)
integer*1 msgbits(KK),codeword(3*ND) integer*1 msgbits(KK),codeword(3*ND),msgbits2
integer*1, target:: i1Msg8BitBytes(11) integer*1, target:: i1Msg8BitBytes(11)
integer*1, target:: mycall integer*1, target:: mycall
real x(NFFT),y(NFFT) real x(NFFT),y(NFFT)
real*8 dt,twopi,f0,fstep,dfreq,phi,dphi real*8 dt,twopi,f0,fstep,dfreq,phi,dphi
complex cx(0:NH),cy(0:NH) complex cx(0:NH),cy(0:NH)
common/foxcom/wave(NWAVE),nslots,i3bit(5),cmsg(5),mycall(6) common/foxcom/wave(NWAVE),nslots,i3bit(5),cmsg(5),mycall(6)
common/foxcom2/itone2(NN),msgbits2(KK)
equivalence (x,cx),(y,cy) equivalence (x,cx),(y,cy)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
@ -28,37 +43,27 @@ subroutine foxgen()
twopi=8.d0*atan(1.d0) twopi=8.d0*atan(1.d0)
wave=0. wave=0.
mygrid=' ' mygrid=' '
nrpt=0 irpt=0
do n=1,nslots do n=1,nslots
!###
! if(n.eq.1) then
! cmsg(n)='W0AAA W3DDD'
! i3bit(n)=0
! endif
! if(n.eq.2) then
! cmsg(n)='W0AAA RR73; W3DDD <K1JT> -12'
! i3bit(n)=1
! endif
!###
i3b=i3bit(n) i3b=i3bit(n)
if(i3b.eq.0) then if(i3b.eq.0) then
msg=cmsg(n)(1:22) msg=cmsg(n)(1:22) !Stansard FT8 message
else else
i1=index(cmsg(n),' ') i1=index(cmsg(n),' ') !Special Fox message
i2=index(cmsg(n),';') i2=index(cmsg(n),';')
i3=index(cmsg(n),'<') i3=index(cmsg(n),'<')
i4=index(cmsg(n),'>') i4=index(cmsg(n),'>')
msg=cmsg(n)(1:i1)//cmsg(n)(i2+1:i3-2)//' ' msg=cmsg(n)(1:i1)//cmsg(n)(i2+1:i3-2)//' '
read(cmsg(n)(i4+2:i4+4),*) nrpt read(cmsg(n)(i4+2:i4+4),*) irpt
endif endif
call genft8(msg,mygrid,bcontest,0,msgsent,msgbits,itone) call genft8(msg,mygrid,bcontest,0,msgsent,msgbits,itone)
if(i3b.eq.1) then if(i3b.eq.1) then
icrc10=crc10(c_loc(mycall),6) icrc10=crc10(c_loc(mycall),6)
ng16=64*icrc10 + nrpt+30 nrpt=irpt+30
write(cbits,1001) msgbits(1:56),ng16,i3b,0 write(cbits,1001) msgbits(1:56),icrc10,nrpt,i3b,0
1001 format(56b1.1,b16.16,b3.3,b12.12) 1001 format(56b1.1,b10.10,b6.6,b3.3,b12.12)
read(cbits,1002) msgbits read(cbits,1002) msgbits
1002 format(87i1) 1002 format(87i1)
@ -67,7 +72,8 @@ subroutine foxgen()
1003 format(11b8) 1003 format(11b8)
icrc12=crc12(c_loc(i1Msg8BitBytes),11) icrc12=crc12(c_loc(i1Msg8BitBytes),11)
write(cbits,1001) msgbits(1:56),ng16,i3b,icrc12 print*,'BB',icrc10,nrpt,i3b,icrc12
write(cbits,1001) msgbits(1:56),icrc10,nrpt,i3b,icrc12
read(cbits,1002) msgbits read(cbits,1002) msgbits
call encode174(msgbits,codeword) !Encode the test message call encode174(msgbits,codeword) !Encode the test message
@ -85,13 +91,9 @@ subroutine foxgen()
enddo enddo
endif endif
!### ! Make copies of itone() and msgbits() for ft8sim
! call chkcrc12a(msgbits,nbadcrc) itone2=itone
! i3bb=4*msgbits(73) + 2*msgbits(74) + msgbits(75) msgbits2=msgbits
! iFreeText=msgbits(57)
! write(*,3001) i3b,i3bb,icrc10,icrc12,nbadcrc,msgsent
!3001 format(5i6,2x,a22)
!###
f0=1500.d0 + fstep*(n-1) f0=1500.d0 + fstep*(n-1)
phi=0.d0 phi=0.d0

View File

@ -1,13 +1,17 @@
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,lsubtract,nagain,iaptype,mygrid6,bcontest,sync0,f1,xdt,xbase, & napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,bcontest,sync0,f1,xdt,xbase, &
apsym,nharderrors,dmin,nbadcrc,ipass,iera,message,xsnr) apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg32,xsnr)
use crc
use timer_module, only: timer use timer_module, only: timer
include 'ft8_params.f90' include 'ft8_params.f90'
parameter(NRECENT=10,NP2=2812) parameter(NRECENT=10,NP2=2812)
character*32 msg32
character message*22,msgsent*22 character message*22,msgsent*22
character*12 recent_calls(NRECENT) character*12 mycall12,recent_calls(NRECENT)
character*6 mygrid6 character*6, target:: mycall6
character*6 mygrid6,c1,c2
character*87 cbits
logical bcontest logical bcontest
real a(5) real a(5)
real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND) real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND)
@ -15,7 +19,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
real bmeta(3*ND),bmetb(3*ND),bmetap(3*ND) real bmeta(3*ND),bmetb(3*ND),bmetap(3*ND)
real llr(3*ND),llra(3*ND),llr0(3*ND),llr1(3*ND),llrap(3*ND) !Soft symbols real llr(3*ND),llra(3*ND),llr0(3*ND),llr1(3*ND),llrap(3*ND) !Soft symbols
real dd0(15*12000) real dd0(15*12000)
integer*1 decoded(KK),apmask(3*ND),cw(3*ND) integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND)
integer*1 msgbits(KK) integer*1 msgbits(KK)
integer apsym(KK) integer apsym(KK)
integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16) integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16)
@ -359,7 +363,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
message=' ' message=' '
xsnr=-99.0 xsnr=-99.0
if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword
!### if(any(decoded(73:75).ne.0)) cycle !Reject if any of the 3 extra bits is nonzero
if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. & if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. &
.not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. & .not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. &
.not.(ipass.gt.2 .and. nharderrors.gt.39) .and. & .not.(ipass.gt.2 .and. nharderrors.gt.39) .and. &
@ -370,17 +373,15 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
nharderrors=-1 nharderrors=-1
cycle cycle
endif endif
!###
i3bit=4*decoded(73) + 2*decoded(74) + decoded(75) i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
iFreeText=decoded(57) iFreeText=decoded(57)
! if(nbadcrc.eq.0) write(*,3001) nharderrors,nbadcrc,i3bit
!3001 format('A',3i5)
!###
if(nbadcrc.eq.0) then if(nbadcrc.eq.0) then
decoded0=decoded
if(i3bit.eq.1) decoded(57:)=0
call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent) call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent)
decoded=decoded0
! This needs fixing for messages with i3bit=1:
call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone) call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
if(i3bit.eq.1 .and. iFreeText.eq.0) message(21:21)='1'
if(i3bit.eq.2 .and. iFreeText.eq.0) message(21:21)='2'
if(lsubtract) call subtractft8(dd0,itone,f1,xdt2) if(lsubtract) call subtractft8(dd0,itone,f1,xdt2)
xsig=0.0 xsig=0.0
xnoi=0.0 xnoi=0.0
@ -393,10 +394,37 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
if(xnoi.gt.0 .and. xnoi.lt.xsig) xsnr=xsig/xnoi-1.0 if(xnoi.gt.0 .and. xnoi.lt.xsig) xsnr=xsig/xnoi-1.0
xsnr=10.0*log10(xsnr)-27.0 xsnr=10.0*log10(xsnr)-27.0
xsnr2=db(xsig/xbase - 1.0) - 32.0 xsnr2=db(xsig/xbase - 1.0) - 32.0
! write(52,3052) f1,xdt,xsig,xnoi,xbase,xsnr,xsnr2
!3052 format(7f10.2)
if(.not.nagain) xsnr=xsnr2 if(.not.nagain) xsnr=xsnr2
if(xsnr .lt. -24.0) xsnr=-24.0 if(xsnr .lt. -24.0) xsnr=-24.0
if(i3bit.eq.1) then
mycall6=mycall12(1:6)
icrc10=crc10(c_loc(mycall6),6)
write(cbits,1001) decoded
1001 format(87i1)
read(cbits,1002) ncrc10,nrpt
1002 format(56x,b10,b6)
irpt=nrpt-30
i1=index(message,' ')
i2=index(message(i1+1:),' ') + i1
c1=message(1:i1)//' '
c2=message(i1+1:i2)//' '
msg32=c1//' RR73; '//c2//' <'//trim(mycall6)//'> '
write(msg32(30:32),1010) irpt
1010 format(i3.2)
if(msg32(30:30).ne.'-') msg32(30:30)='+'
iz=len(trim(msg32))
do iter=1,5 !Collapse multiple blanks into one
ib2=index(msg32(1:iz),' ')
if(ib2.lt.1) exit
msg32=msg32(1:ib2)//msg32(ib2+2:)
iz=iz-1
enddo
else
msg32=message//' '
endif
return return
endif endif
enddo enddo

View File

@ -7,7 +7,7 @@ program ft8sim
include 'ft8_params.f90' !Set various constants include 'ft8_params.f90' !Set various constants
type(hdr) h !Header for .wav file type(hdr) h !Header for .wav file
character arg*12,fname*17,sorm*1 character arg*12,fname*17,sorm*1
character msg*22,msgsent*22,msg0*22 character msg32*32,msg*22,msgsent*22,msg0*22
character*6 mygrid6 character*6 mygrid6
logical bcontest logical bcontest
complex c0(0:NMAX-1) complex c0(0:NMAX-1)
@ -27,7 +27,7 @@ program ft8sim
print*,'Make nfiles negative to invoke 72-bit contest mode.' print*,'Make nfiles negative to invoke 72-bit contest mode.'
go to 999 go to 999
endif endif
call getarg(1,msg) !Message to be transmitted call getarg(1,msg32) !Message to be transmitted
call getarg(2,sorm) !s for single signal, m for multiple sigs call getarg(2,sorm) !s for single signal, m for multiple sigs
if(sorm.eq."s") then if(sorm.eq."s") then
print*,"Generating single signal at 1500 Hz." print*,"Generating single signal at 1500 Hz."
@ -68,13 +68,21 @@ program ft8sim
sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb) sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0 if(snrdb.gt.90.0) sig=1.0
txt=NN*NSPS/12000.0 txt=NN*NSPS/12000.0
i3bit=0 ! ### TEMPORARY ??? ###
! Source-encode, then get itone() ! Source-encode, then get itone()
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone) if(index(msg32,';').lt.0) then
write(*,1000) f0,xdt,txt,snrdb,bw,msgsent i3bit=0
msg=msg32(1:22)
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
write(*,1000) f0,xdt,txt,snrdb,bw,msgsent
1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, & 1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, &
' BW:',f4.1,2x,a22) ' BW:',f4.1,2x,a22)
else
call foxgen_wrap(msg32,msgbits,itone)
write(*,1001) f0,xdt,txt,snrdb,bw,msg32
1001 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, &
' BW:',f4.1,2x,a32)
endif
write(*,'(28i1,1x,28i1)') msgbits(1:56) write(*,'(28i1,1x,28i1)') msgbits(1:56)
write(*,'(16i1)') msgbits(57:72) write(*,'(16i1)') msgbits(57:72)
@ -146,3 +154,5 @@ program ft8sim
enddo enddo
999 end program ft8sim 999 end program ft8sim

View File

@ -24,7 +24,7 @@ module ft8_decode
integer, intent(in) :: snr integer, intent(in) :: snr
real, intent(in) :: dt real, intent(in) :: dt
real, intent(in) :: freq real, intent(in) :: freq
character(len=22), intent(in) :: decoded character(len=32), intent(in) :: decoded
integer, intent(in) :: nap integer, intent(in) :: nap
real, intent(in) :: qual real, intent(in) :: qual
end subroutine ft8_decode_callback end subroutine ft8_decode_callback
@ -52,7 +52,7 @@ contains
character*6 mygrid6,hisgrid6 character*6 mygrid6,hisgrid6
integer*2 iwave(15*12000) integer*2 iwave(15*12000)
integer apsym(KK) integer apsym(KK)
character datetime*13,message*22 character datetime*13,message*22,msg32*32
character*22 allmessages(100) character*22 allmessages(100)
integer allsnrs(100) integer allsnrs(100)
save s,dd save s,dd
@ -105,9 +105,10 @@ contains
xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0)) xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0))
nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ### nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ###
call timer('ft8b ',0) call timer('ft8b ',0)
call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon,lapcqonly, & call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon,lapcqonly, &
napwid,lsubtract,nagain,iaptype,mygrid6,bcontest,sync,f1,xdt, & napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,bcontest,sync,f1,xdt, &
xbase,apsym,nharderrors,dmin,nbadcrc,iappass,iera,message,xsnr) xbase,apsym,nharderrors,dmin,nbadcrc,iappass,iera,msg32,xsnr)
message=msg32(1:22) !###
nsnr=nint(xsnr) nsnr=nint(xsnr)
xdt=xdt-0.5 xdt=xdt-0.5
hd=nharderrors+dmin hd=nharderrors+dmin
@ -132,7 +133,7 @@ contains
! flush(81) ! flush(81)
if(.not.ldupe .and. associated(this%callback)) then if(.not.ldupe .and. associated(this%callback)) then
qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0] qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0]
call this%callback(sync,nsnr,xdt,f1,message,iaptype,qual) call this%callback(sync,nsnr,xdt,f1,msg32,iaptype,qual)
endif endif
endif endif
enddo enddo