From ff109a60caa2c927f66c06e0952b52601b3526d5 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 3 Feb 2020 10:48:51 -0600 Subject: [PATCH] Implement AP decoding for Hounds when Fox has a compound call with standard base call. --- CMakeLists.txt | 2 - lib/ft8.f90 | 49 ------------------- lib/ft8/ft8apset.f90 | 38 ++++++++++++--- lib/ft8/ft8b.f90 | 20 ++++---- lib/ft8_decode.f90 | 18 ++----- lib/ft8dec.f90 | 111 ------------------------------------------- 6 files changed, 48 insertions(+), 190 deletions(-) delete mode 100644 lib/ft8.f90 delete mode 100644 lib/ft8dec.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index fb79c1880..640777d73 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -468,8 +468,6 @@ set (wsjt_FSRCS lib/ft8/ft8b.f90 lib/ft8/ft8code.f90 lib/ft8/ft8_downsample.f90 - lib/ft8.f90 - lib/ft8dec.f90 lib/ft8/ft8sim_fsk.f90 lib/ft8/ft8sim.f90 lib/gen4.f90 diff --git a/lib/ft8.f90 b/lib/ft8.f90 deleted file mode 100644 index aacff17d6..000000000 --- a/lib/ft8.f90 +++ /dev/null @@ -1,49 +0,0 @@ -program ft8 - - integer*2 iwave(15*12000) - logical lft8apon,lapcqonly,nagain,newdat - character*12 mycall12,hiscall12 - character*6 hisgrid6 - character arg*8,infile*80 - integer ihdr(11) - - nargs=iargc() - if(nargs.lt.3) then - print*,'Usage: ft8 nfa nfb ndepth infile' - print*,'Example: ft8 200 4000 3 181201_180315.wav' - go to 999 - endif - call getarg(1,arg) - read(arg,*) nfa - call getarg(2,arg) - read(arg,*) nfb - call getarg(3,arg) - read(arg,*) ndepth - nfiles=nargs-3 - - nQSOProgress=0 - nfqso=1500 - nftx=0 - newdat=.true. - nutc=0 - ncontest=0 - nagain=.false. - lft8apon=.false. - lapcqonly=.false. - napwid=75 - mycall12='K1ABC' - hiscall12='W9XYZ' - hisgrid6='EN37wb' - - do ifile=1,nfiles - call getarg(3+ifile,infile) - open(10,file=infile,status='old',access='stream') - read(10) ihdr,iwave - close(10) - - call ft8dec(iwave,nQSOProgress,nfqso,nftx,newdat, & - nutc,nfa,nfb,ndepth,ncontest,nagain,lft8apon,lapcqonly, & - napwid,mycall12,hiscall12,hisgrid6) - enddo - -999 end program ft8 diff --git a/lib/ft8/ft8apset.f90 b/lib/ft8/ft8apset.f90 index 56a18c4fe..60d2bf08c 100644 --- a/lib/ft8/ft8apset.f90 +++ b/lib/ft8/ft8apset.f90 @@ -1,14 +1,20 @@ -subroutine ft8apset(mycall12,hiscall12,apsym) +subroutine ft8apset(mycall12,hiscall12,ncontest,apsym,aph10) use packjt77 character*77 c77 character*37 msg,msgchk character*12 mycall12,hiscall12,hiscall - integer apsym(58) + character*13 hc13 + character*10 c10 + character*6 base6 + logical*1 ok1 + integer apsym(58),aph10(10) logical nohiscall,unpk77_success apsym=0 apsym(1)=99 apsym(30)=99 + aph10=0 + aph10(1)=99 if(len(trim(mycall12)).lt.3) return @@ -17,23 +23,41 @@ subroutine ft8apset(mycall12,hiscall12,apsym) if(len(trim(hiscall)).lt.3) then hiscall=mycall12 ! use mycall for dummy hiscall - mycall won't be hashed. nohiscall=.true. + else + hc13=hiscall + n10=0 + n12=0 + n22=0 + call save_hash_call(hc13,n10,n12,n22) + write(c10,'(b10.10)') iand(n10,Z'3FF') + read(c10,'(10i1.1)',err=1) aph10 + aph10=2*aph10-1 endif ! Encode a dummy standard message: i3=1, 28 1 28 1 1 15 ! msg=trim(mycall12)//' '//trim(hiscall)//' RRR' + i3=0 + n3=0 call pack77(msg,i3,n3,c77) call unpack77(c77,1,msgchk,unpk77_success) + if(ncontest.eq.7.and. (i3.ne.1 .or. .not.unpk77_success)) return + if(ncontest.le.5.and. (i3.ne.1 .or. msg.ne.msgchk .or. .not.unpk77_success)) return - if(i3.ne.1 .or. (msg.ne.msgchk) .or. .not.unpk77_success) return - - read(c77,'(58i1)',err=1) apsym(1:58) + read(c77,'(58i1)',err=2) apsym(1:58) apsym=2*apsym-1 - if(nohiscall) apsym(30)=99 + if(nohiscall) then + apsym(30)=99 + aph10(1)=99 + endif return -1 apsym=0 +1 aph10=0 + aph10(1)=99 + return +2 apsym=0 apsym(1)=99 apsym(30)=99 return + end subroutine ft8apset diff --git a/lib/ft8/ft8b.f90 b/lib/ft8/ft8b.f90 index 72c82a6dc..a8e0a2e58 100644 --- a/lib/ft8/ft8b.f90 +++ b/lib/ft8/ft8b.f90 @@ -1,6 +1,6 @@ -subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & +subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & napwid,lsubtract,nagain,ncontest,iaptype,mycall12,hiscall12, & - sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr) + sync0,f1,xdt,xbase,apsym,aph10,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr) use crc use timer_module, only: timer @@ -17,7 +17,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & real llra(174),llrb(174),llrc(174),llrd(174) !Soft symbols real dd0(15*12000) integer*1 message77(77),apmask(174),cw(174) - integer apsym(58) + integer apsym(58),aph10(10) integer mcq(29),mcqru(29),mcqfd(29),mcqtest(29),mcqww(29) integer mrrr(19),m73(19),mrr73(19) integer itone(NN) @@ -45,7 +45,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & data graymap/0,1,3,2,5,6,4,7/ save nappasses,naptypes,ncontest0,one - if(first.or.(ncontest.ne.ncontest0)) then mcq=2*mcq-1 mcqfd=2*mcqfd-1 @@ -88,7 +87,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & ncontest0=ncontest endif - dxcall13=hiscall12 + dxcall13=hiscall12 ! initialize for use in packjt77 mycall13=mycall12 max_iterations=30 @@ -223,7 +222,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & ! 1 regular decoding, nsym=1 ! 2 regular decoding, nsym=2 ! 3 regular decoding, nsym=3 -! 4 ap pass 1, nsym=1 (for now?) +! 4 ap pass 1, nsym=1 ! 5 ap pass 2 ! 6 ap pass 3 ! 7 ap pass 4 @@ -269,6 +268,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & if(ncontest.eq.6) cycle ! No AP for Foxes if(ncontest.eq.7.and.f1.gt.950.0) cycle ! Hounds use AP only for signals below 950 Hz if(iaptype.ge.2 .and. apsym(1).gt.1) cycle ! No, or nonstandard, mycall + if(ncontest.eq.7 .and. iaptype.ge.2 .and. aph10(1).gt.1) cycle if(iaptype.ge.3 .and. apsym(30).gt.1) cycle ! No, or nonstandard, dxcall if(iaptype.eq.1) then ! CQ or CQ RU or CQ TEST or CQ FD @@ -314,9 +314,11 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & apmask(75:77)=1 llrd(75)=apmag*(-1) llrd(76:77)=apmag*(+1) - else if(ncontest.eq.6) then ! ??? RR73; MyCall ??? + else if(ncontest.eq.7) then ! ??? RR73; MyCall ??? apmask(29:56)=1 llrd(29:56)=apmag*apsym(1:28) + apmask(57:66)=1 + llrd(57:66)=apmag*aph10(1:10) apmask(72:77)=1 llrd(72:73)=apmag*(-1) llrd(74)=apmag*(+1) @@ -361,6 +363,8 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & else if(ncontest.eq.7.and.iaptype.eq.4) then ! Hound listens for MyCall RR73;... apmask(1:28)=1 llrd(1:28)=apmag*apsym(1:28) + apmask(57:66)=1 + llrd(57:66)=apmag*aph10(1:10) apmask(72:77)=1 llrd(72:73)=apmag*(-1) llrd(74)=apmag*(1) @@ -377,7 +381,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & dmin=0.0 if(ndepth.eq.3 .and. nharderrors.lt.0) then ndeep=3 - if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid) then + if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid .or. ncontest.eq.7) then ndeep=4 endif if(nagain) ndeep=5 diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index 8cfd8600c..c501bd40b 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -35,10 +35,8 @@ contains subroutine decode(this,callback,iwave,nQSOProgress,nfqso,nftx,newdat, & nutc,nfa,nfb,ndepth,ncontest,nagain,lft8apon,lapcqonly, & napwid,mycall12,hiscall12,hisgrid6) -! use wavhdr use timer_module, only: timer include 'ft8/ft8_params.f90' -! type(hdr) h class(ft8_decoder), intent(inout) :: this procedure(ft8_decode_callback) :: callback @@ -49,26 +47,21 @@ contains real dd(15*12000) logical, intent(in) :: lft8apon,lapcqonly,nagain logical newdat,lsubtract,ldupe - character*12 mycall12,hiscall12,mycall12_0 + character*12 mycall12,hiscall12 character*6 hisgrid6 integer*2 iwave(15*12000) - integer apsym2(58) + integer apsym2(58),aph10(10) character datetime*13,msg37*37 ! character message*22 character*37 allmessages(100) integer allsnrs(100) - data mycall12_0/'dummy'/ - save s,dd,mycall12_0 - - if(mycall12.ne.mycall12_0) then - mycall12_0=mycall12 - endif + save s,dd this%callback => callback write(datetime,1001) nutc !### TEMPORARY ### 1001 format("000000_",i6.6) - call ft8apset(mycall12,hiscall12,apsym2) + call ft8apset(mycall12,hiscall12,ncontest,apsym2,aph10) dd=iwave ndecodes=0 allmessages=' ' @@ -110,11 +103,10 @@ contains f1=candidate(1,icand) xdt=candidate(2,icand) xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0)) - nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ### call timer('ft8b ',0) call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & lapcqonly,napwid,lsubtract,nagain,ncontest,iaptype,mycall12, & - hiscall12,sync,f1,xdt,xbase,apsym2,nharderrors,dmin, & + hiscall12,sync,f1,xdt,xbase,apsym2,aph10,nharderrors,dmin, & nbadcrc,iappass,iera,msg37,xsnr) call timer('ft8b ',1) nsnr=nint(xsnr) diff --git a/lib/ft8dec.f90 b/lib/ft8dec.f90 deleted file mode 100644 index 2dea2a914..000000000 --- a/lib/ft8dec.f90 +++ /dev/null @@ -1,111 +0,0 @@ -subroutine ft8dec(iwave,nQSOProgress,nfqso,nftx,newdat, & - nutc,nfa,nfb,ndepth,ncontest,nagain,lft8apon,lapcqonly, & - napwid,mycall12,hiscall12,hisgrid6) -! use wavhdr - use timer_module, only: timer - include 'ft8/ft8_params.f90' -! type(hdr) h - - parameter (MAXCAND=300) - real s(NH1,NHSYM) - real sbase(NH1) - real candidate(3,MAXCAND) - real dd(15*12000) - logical, intent(in) :: lft8apon,lapcqonly,nagain - logical newdat,lsubtract,ldupe - character*12 mycall12,hiscall12,mycall12_0 - character*6 hisgrid6 - integer*2 iwave(15*12000) - integer apsym2(58) - character datetime*13,msg37*37 -! character message*22 - character*37 allmessages(100) - integer allsnrs(100) - data mycall12_0/'dummy'/ - save s,dd,mycall12_0 - - if(mycall12.ne.mycall12_0) then - mycall12_0=mycall12 - endif - - write(datetime,1001) nutc !### TEMPORARY ### -1001 format("000000_",i6.6) - - call ft8apset(mycall12,hiscall12,apsym2) - dd=iwave - ndecodes=0 - allmessages=' ' - allsnrs=0 - ifa=nfa - ifb=nfb - if(nagain) then - ifa=nfqso-10 - ifb=nfqso+10 - endif - -! For now: -! ndepth=1: no subtraction, 1 pass, belief propagation only -! ndepth=2: subtraction, 3 passes, belief propagation only -! ndepth=3: subtraction, 3 passes, bp+osd - if(ndepth.eq.1) npass=1 - if(ndepth.ge.2) npass=3 - do ipass=1,npass - newdat=.true. ! Is this a problem? I hijacked newdat. - syncmin=1.5 - if(ipass.eq.1) then - lsubtract=.true. - if(ndepth.eq.1) lsubtract=.false. - elseif(ipass.eq.2) then - n2=ndecodes - if(ndecodes.eq.0) cycle - lsubtract=.true. - elseif(ipass.eq.3) then - if((ndecodes-n2).eq.0) cycle - lsubtract=.false. - endif - call timer('sync8 ',0) - maxc=MAXCAND - call sync8(dd,ifa,ifb,syncmin,nfqso,maxc,s,candidate, & - ncand,sbase) - call timer('sync8 ',1) - do icand=1,ncand - sync=candidate(3,icand) - f1=candidate(1,icand) - xdt=candidate(2,icand) - xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0)) - nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ### - call timer('ft8b ',0) - call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & - lapcqonly,napwid,lsubtract,nagain,ncontest,iaptype,mycall12, & - hiscall12,sync,f1,xdt,xbase,apsym2,nharderrors,dmin, & - nbadcrc,iappass,iera,msg37,xsnr) - call timer('ft8b ',1) - nsnr=nint(xsnr) - xdt=xdt-0.5 - hd=nharderrors+dmin - if(nbadcrc.eq.0) then - ldupe=.false. - do id=1,ndecodes - if(msg37.eq.allmessages(id).and.nsnr.le.allsnrs(id)) ldupe=.true. - enddo - if(.not.ldupe) then - ndecodes=ndecodes+1 - allmessages(ndecodes)=msg37 - allsnrs(ndecodes)=nsnr - endif -! write(81,1004) nutc,ncand,icand,ipass,iaptype,iappass, & -! nharderrors,dmin,hd,min(sync,999.0),nint(xsnr), & -! xdt,nint(f1),msg37 -!1004 format(i6.6,2i4,3i2,i3,3f6.1,i4,f6.2,i5,2x,a37) -! flush(81) - if(.not.ldupe) then - qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0] - write(*,1010) min(sync,999.0),nsnr,xdt,nint(f1), & - iaptype,qual,msg37 -1010 format(f5.1,i4,f5.2,i5,i3,f5.1,1x,a37) - endif - endif - enddo - enddo - return -end subroutine ft8dec