From 95599a7153e52a2ca8780993ec51b78eb508d9d1 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Wed, 9 Jan 2019 12:45:20 -0500 Subject: [PATCH] Add a standalone FT8 decoder, for testing. --- CMakeLists.txt | 5 +++ lib/ft8.f90 | 49 ++++++++++++++++++++++ lib/ft8dec.f90 | 111 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 165 insertions(+) create mode 100644 lib/ft8.f90 create mode 100644 lib/ft8dec.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 2040766e2..1fc3d7162 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -452,6 +452,8 @@ 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.f90 lib/gen4.f90 lib/gen65.f90 @@ -1245,6 +1247,9 @@ target_link_libraries (jt65 wsjt_fort wsjt_cxx) add_executable (ft8code lib/ft8/ft8code.f90 wsjtx.rc) target_link_libraries (ft8code wsjt_fort wsjt_cxx) +add_executable (ft8 lib/ft8.f90 wsjtx.rc) +target_link_libraries (ft8 wsjt_fort wsjt_cxx) + add_executable (ft8sim lib/ft8/ft8sim.f90 wsjtx.rc) target_link_libraries (ft8sim wsjt_fort wsjt_cxx) diff --git a/lib/ft8.f90 b/lib/ft8.f90 new file mode 100644 index 000000000..aacff17d6 --- /dev/null +++ b/lib/ft8.f90 @@ -0,0 +1,49 @@ +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/ft8dec.f90 b/lib/ft8dec.f90 new file mode 100644 index 000000000..2dea2a914 --- /dev/null +++ b/lib/ft8dec.f90 @@ -0,0 +1,111 @@ +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