diff --git a/CMakeLists.txt b/CMakeLists.txt index e899714..ff15c81 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -289,7 +289,6 @@ set (wsjt_FSRCS lib/jt4_decode.f90 lib/jt65_decode.f90 lib/jt65_mod.f90 - lib/ft8_decode.f90 lib/jt9_decode.f90 lib/options.f90 lib/packjt.f90 @@ -298,6 +297,8 @@ set (wsjt_FSRCS lib/timer_impl.f90 lib/timer_module.f90 lib/wavhdr.f90 + lib/js8a_module.f90 + lib/js8a_decode.f90 lib/js8b_module.f90 lib/js8b_decode.f90 lib/js8c_module.f90 @@ -320,8 +321,6 @@ set (wsjt_FSRCS lib/averms.f90 lib/azdist.f90 lib/badmsg.f90 - lib/ft8/baseline.f90 - # lib/js8/baselinejs8.f90 lib/bpdecode40.f90 lib/bpdecode144.f90 lib/ft8/bpdecode174.f90 @@ -386,17 +385,8 @@ set (wsjt_FSRCS lib/fqso_first.f90 lib/freqcal.f90 lib/ft8/ft8apset.f90 - lib/ft8/ft8b.f90 - # lib/js8/js8params.f90 - # lib/js8/js8b.f90 - lib/ft8/ft8code.f90 - lib/ft8/ft8_downsample.f90 - # lib/js8/js8_downsample.f90 - lib/ft8/ft8sim.f90 lib/ft8/genft8.f90 lib/js8/genjs8.f90 - lib/ft8/genft8refsig.f90 - # lib/js8/genjs8refsig.f90 lib/geodist.f90 lib/getlags.f90 lib/getmet4.f90 @@ -417,8 +407,7 @@ set (wsjt_FSRCS lib/jplsubs.f lib/jt9fano.f90 lib/jtmsg.f90 - lib/ldpcsim144.f90 - lib/ft8/ldpcsim174.f90 + lib/js8/ldpcsim174js8a.f90 lib/js8/ldpcsim174js8b.f90 lib/js8/ldpcsim174js8c.f90 lib/js8/ldpcsim174js8e.f90 @@ -460,8 +449,6 @@ set (wsjt_FSRCS lib/spec9f.f90 lib/stdmsg.f90 lib/subtract65.f90 - lib/ft8/subtractft8.f90 - # lib/js8/subtractjs8.f90 lib/sun.f90 lib/symspec.f90 lib/symspec2.f90 @@ -469,10 +456,6 @@ set (wsjt_FSRCS lib/sync4.f90 lib/sync64.f90 lib/sync65.f90 - lib/ft8/sync8.f90 - # lib/js8/syncjs8.f90 - lib/ft8/sync8d.f90 - # lib/js8/syncjs8d.f90 lib/sync9.f90 lib/sync9f.f90 lib/sync9w.f90 @@ -997,8 +980,8 @@ endif (WIN32) add_library (wsjt_qtmm STATIC ${wsjt_qtmm_CXXSRCS} ${wsjt_qtmm_GENUISRCS}) target_link_libraries (wsjt_qtmm Qt5::Multimedia) -add_executable (ldpcsim174 lib/ft8/ldpcsim174.f90 wsjtx.rc) -target_link_libraries (ldpcsim174 wsjt_fort wsjt_cxx) +add_executable (ldpcsim174js8a lib/js8/ldpcsim174js8a.f90 wsjtx.rc) +target_link_libraries (ldpcsim174js8a wsjt_fort wsjt_cxx) add_executable (ldpcsim174js8b lib/js8/ldpcsim174js8b.f90 wsjtx.rc) target_link_libraries (ldpcsim174js8b wsjt_fort wsjt_cxx) diff --git a/lib/decoder.f90 b/lib/decoder.f90 index 6bebc50..609e849 100644 --- a/lib/decoder.f90 +++ b/lib/decoder.f90 @@ -3,7 +3,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample) !$ use omp_lib use prog_args use timer_module, only: timer - use ft8_decode + use js8a_decode use js8b_decode use js8c_decode use js8e_decode @@ -12,9 +12,9 @@ subroutine multimode_decoder(ss,id2,params,nfsample) include 'jt9com.f90' include 'timer_common.inc' - type, extends(ft8_decoder) :: counting_ft8_decoder + type, extends(js8a_decoder) :: counting_js8a_decoder integer :: decoded - end type counting_ft8_decoder + end type counting_js8a_decoder type, extends(js8b_decoder) :: counting_js8b_decoder integer :: decoded @@ -41,7 +41,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample) character(len=12) :: mycall, hiscall character(len=6) :: mygrid, hisgrid save - type(counting_ft8_decoder) :: my_js8a + type(counting_js8a_decoder) :: my_js8a type(counting_js8b_decoder) :: my_js8b type(counting_js8c_decoder) :: my_js8c type(counting_js8e_decoder) :: my_js8e @@ -69,10 +69,6 @@ subroutine multimode_decoder(ss,id2,params,nfsample) 10 nfail=0 if(params%nmode.eq.8) then - c2fox=' ' - g2fox=' ' - nsnrfox=-99 - nfreqfox=-99 n30z=0 nwrap=0 nfox=0 @@ -235,10 +231,6 @@ contains ichar(w(4:4)).ge.ichar('0') .and. ichar(w(4:4)).le.ichar('9')) if(first) then - c2fox=' ' - g2fox=' ' - nsnrfox=-99 - nfreqfox=-99 n30z=0 nwrap=0 nfox=0 @@ -291,11 +283,6 @@ contains n30z=n30 n30=n30+nwrap nfox=nfox+1 - c2fox(nfox)=c2 - g2fox(nfox)=g2 - nsnrfox(nfox)=snr - nfreqfox(nfox)=nint(freq) - n30fox(nfox)=n30 endif endif @@ -305,10 +292,10 @@ contains end subroutine js8_decoded subroutine js8a_decoded (this,sync,snr,dt,freq,decoded,nap,qual) - use ft8_decode + use js8a_decode implicit none - class(ft8_decoder), intent(inout) :: this + class(js8a_decoder), intent(inout) :: this real, intent(in) :: sync integer, intent(in) :: snr real, intent(in) :: dt @@ -323,7 +310,7 @@ contains call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, submode) select type(this) - type is (counting_ft8_decoder) + type is (counting_js8a_decoder) this%decoded = this%decoded + 1 end select diff --git a/lib/ft8/baseline.f90 b/lib/ft8/baseline.f90 deleted file mode 100644 index 3f8ec31..0000000 --- a/lib/ft8/baseline.f90 +++ /dev/null @@ -1,51 +0,0 @@ -subroutine baseline(s,nfa,nfb,sbase) - -! Fit baseline to spectrum (for FT8) -! Input: s(npts) Linear scale in power -! Output: sbase(npts) Baseline - - implicit real*8 (a-h,o-z) - - include 'ft8_params.f90' - - real*4 s(NSPS) - real*4 sbase(NSPS) - real*4 base - real*8 x(1000),y(1000),a(5) - data nseg/10/,npct/10/ - - df=12000.0/(NSPS*2.0d0) !3.125 Hz - ia=max(1,nint(nfa/df)) - ib=nint(nfb/df) - do i=ia,ib - s(i)=10.0*log10(s(i)) !Convert to dB scale - enddo - - nterms=5 - nlen=(ib-ia+1)/nseg !Length of test segment - i0=(ib-ia+1)/2 !Midpoint - k=0 - do n=1,nseg !Loop over all segments - ja=ia + (n-1)*nlen - jb=ja+nlen-1 - call pctile(s(ja),nlen,npct,base) !Find lowest npct of points - do i=ja,jb - if(s(i).le.base) then - if (k.lt.1000) k=k+1 !Save all "lower envelope" points - x(k)=i-i0 - y(k)=s(i) - endif - enddo - enddo - kz=k - a=0. - call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial - do i=ia,ib - t=i-i0 - sbase(i)=a(1)+t*(a(2)+t*(a(3)+t*(a(4)+t*(a(5))))) + 0.65 -! write(51,3051) i*df,s(i),sbase(i) -!3051 format(3f12.3) - enddo - - return -end subroutine baseline diff --git a/lib/ft8/ft8_downsample.f90 b/lib/ft8/ft8_downsample.f90 deleted file mode 100644 index 795a794..0000000 --- a/lib/ft8/ft8_downsample.f90 +++ /dev/null @@ -1,54 +0,0 @@ -subroutine ft8_downsample(dd,newdat,f0,c1) - - ! Downconvert to complex data sampled at 200 Hz ==> 32 samples/symbol - - include 'ft8_params.f90' - - parameter (NDFFT1=NSPS*NDD, NDFFT2=NDFFT1/NDOWN) ! Downconverted FFT Size - 192000/60 = 3200 - - logical newdat,first - - complex c1(0:NDFFT2-1) - complex cx(0:NDFFT1/2) - real dd(NMAX),x(NDFFT1),taper(0:NDD) - equivalence (x,cx) - data first/.true./ - save cx,first,taper - - if(first) then - pi=4.0*atan(1.0) - do i=0,NDD - taper(i)=0.5*(1.0+cos(i*pi/NDD)) - enddo - first=.false. - endif - if(newdat) then - ! Data in dd have changed, recompute the long FFT - x(1:NMAX)=dd - x(NMAX+1:NDFFT1)=0. !Zero-pad the x array - call four2a(cx,NDFFT1,1,-1,0) !r2c FFT to freq domain - newdat=.false. - endif - - df=12000.0/NDFFT1 - baud=12000.0/NSPS - i0=nint(f0/df) - ft=f0+8.5*baud - it=min(nint(ft/df),NDFFT1/2) - fb=f0-1.5*baud - ib=max(1,nint(fb/df)) - k=0 - c1=0. - do i=ib,it - c1(k)=cx(i) - k=k+1 - enddo - c1(0:NDD)=c1(0:NDD)*taper(NDD:0:-1) - c1(k-1-NDD:k-1)=c1(k-1-NDD:k-1)*taper - c1=cshift(c1,i0-ib) - call four2a(c1,NDFFT2,1,1,1) !c2c FFT back to time domain - fac=1.0/sqrt(float(NDFFT1)*NDFFT2) - c1=fac*c1 - - return -end subroutine ft8_downsample diff --git a/lib/ft8/ft8_params.f90 b/lib/ft8/ft8_params.f90 deleted file mode 100644 index 09f3e5d..0000000 --- a/lib/ft8/ft8_params.f90 +++ /dev/null @@ -1,27 +0,0 @@ -! LDPC (174,87) code - -!parameter (NSPS=480) !Samples per symbol at 12000 S/s -!parameter (NTXDUR=5) !TX Duration in Seconds -!parameter (NDOWNSPS=16) !Downsampled samples per symbol -!parameter (AZ=6.0) !Near dupe sync spacing -!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins - -! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136) ! 200 Hz -! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120) ! 160 Hz -! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=24, NDD=100) ! 80 Hz - parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100) ! 50 Hz -! parameter (NSPS=3840, NTXDUR=30, NDOWNSPS=32, NDD=100) ! 25 Hz - -parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. -parameter (AZ=12000.0/(1.0*NSPS)*0.64d0) - -parameter (KK=87) !Information bits (75 + CRC12) -parameter (ND=58) !Data symbols -parameter (NS=21) !Sync symbols (3 @ Costas 7x7) -parameter (NN=NS+ND) !Total channel symbols (79) -parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680) -parameter (NMAX=NTXDUR*12000) !Samples in iwave (180,000) -parameter (NFFT1=2*NSPS, NH1=NFFT1/2) !Length of FFTs for symbol spectra -parameter (NSTEP=NSPS/4) !Rough time-sync step size -parameter (NHSYM=NMAX/NSTEP-3) !Number of symbol spectra (1/4-sym steps) -parameter (NDOWN=NSPS/NDOWNSPS) !Downsample factor to 32 samples per symbol diff --git a/lib/ft8/ft8_params.f90 b/lib/ft8/ft8_params.f90 new file mode 120000 index 0000000..aae1361 --- /dev/null +++ b/lib/ft8/ft8_params.f90 @@ -0,0 +1 @@ +../js8/js8_params.f90 \ No newline at end of file diff --git a/lib/ft8/ft8b.f90 b/lib/ft8/ft8b.f90 deleted file mode 100644 index 8bd8659..0000000 --- a/lib/ft8/ft8b.f90 +++ /dev/null @@ -1,452 +0,0 @@ -subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & - napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,hiscall12,bcontest, & - sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr) - - use crc - use timer_module, only: timer - include 'ft8_params.f90' - parameter(NP2=2812) - character*37 msg37 - character message*22,msgsent*22,origmsg*22 - character*12 mycall12,hiscall12 - character*6 mycall6,mygrid6,hiscall6,c1,c2 - character*87 cbits - logical bcontest - real a(5) - real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND) - real ps(0:7),psl(0:7) - 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 dd0(NMAX) - integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND) - integer*1 msgbits(KK) - integer apsym(KK) - integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16) - integer itone(NN) - integer indxs1(8*ND) - integer icos7(0:6),ip(1) - integer nappasses(0:5) !Number of decoding passes to use for each QSO state - integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now - integer*1, target:: i1hiscall(12) - complex cd0(0:3199) - complex ctwk(NDOWNSPS) - complex csymb(NDOWNSPS) - logical first,newdat,lsubtract,lapon,lapcqonly,nagain - equivalence (s1,s1sort) - data icos7/4,2,5,6,1,3,0/ - data mcq/1,1,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,1,1,0,0,1/ - data mrrr/0,1,1,1,1,1,1,0,1,1,0,0,1,1,1,1/ - data m73/0,1,1,1,1,1,1,0,1,1,0,1,0,0,0,0/ - data mde/1,1,1,1,1,1,1,1,0,1,1,0,0,1,0,0,0,0,0,1,1,1,0,1,0,0,0,1/ - data mrr73/0,0,0,0,0,0,1,0,0,0,0,1,0,1,0,1/ - data first/.true./ - save nappasses,naptypes - - if(first) then - mcq=2*mcq-1 - mde=2*mde-1 - mrrr=2*mrrr-1 - m73=2*m73-1 - mrr73=2*mrr73-1 - nappasses(0)=2 - nappasses(1)=2 - nappasses(2)=2 - nappasses(3)=4 - nappasses(4)=4 - nappasses(5)=3 - -! iaptype -!------------------------ -! 1 CQ ??? ??? -! 2 MyCall ??? ??? -! 3 MyCall DxCall ??? -! 4 MyCall DxCall RRR -! 5 MyCall DxCall 73 -! 6 MyCall DxCall RR73 -! 7 ??? DxCall ??? - - naptypes(0,1:4)=(/1,2,0,0/) - naptypes(1,1:4)=(/2,3,0,0/) - naptypes(2,1:4)=(/2,3,0,0/) - naptypes(3,1:4)=(/3,4,5,6/) - naptypes(4,1:4)=(/3,4,5,6/) - naptypes(5,1:4)=(/3,1,2,0/) - first=.false. - endif - - max_iterations=30 - nharderrors=-1 - fs2=12000.0/NDOWN - dt2=1.0/fs2 - twopi=8.0*atan(1.0) - delfbest=0. - ibest=0 - - call timer('ft8_down',0) - call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample - call timer('ft8_down',1) - - i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal - smax=0.0 - do idt=i0-8,i0+8 !Search over +/- one quarter symbol - call sync8d(cd0,idt,ctwk,0,sync) - if(sync.gt.smax) then - smax=sync - ibest=idt - endif - enddo - xdt2=ibest*dt2 !Improved estimate for DT - -! Now peak up in frequency - i0=nint(xdt2*fs2) - smax=0.0 - do ifr=-5,5 !Search over +/- 2.5 Hz - delf=ifr*0.5 - dphi=twopi*delf*dt2 - phi=0.0 - do i=1,NDOWNSPS - ctwk(i)=cmplx(cos(phi),sin(phi)) - phi=mod(phi+dphi,twopi) - enddo - call sync8d(cd0,i0,ctwk,1,sync) - if( sync .gt. smax ) then - smax=sync - delfbest=delf - endif - enddo - a=0.0 - a(1)=-delfbest - call twkfreq1(cd0,NP2,fs2,a,cd0) - xdt=xdt2 - f1=f1+delfbest !Improved estimate of DF - - call sync8d(cd0,i0,ctwk,2,sync) - - j=0 - do k=1,NN - i1=ibest+(k-1)*NDOWNSPS - csymb=cmplx(0.0,0.0) - !if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31) - if( i1.ge.0 .and. i1+(NDOWNSPS-1) .le. NP2-1 ) csymb=cd0(i1:i1+(NDOWNSPS-1)) - call four2a(csymb,NDOWNSPS,1,-1,1) - s2(0:7,k)=abs(csymb(1:8))/1e3 - enddo - -! sync quality check - is1=0 - is2=0 - is3=0 - do k=1,7 - ip=maxloc(s2(:,k)) - if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1 - ip=maxloc(s2(:,k+36)) - if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1 - ip=maxloc(s2(:,k+72)) - if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1 - enddo -! hard sync sum - max is 21 - nsync=is1+is2+is3 - - if(nsync .le. 6) then ! bail out - call timer('badnsync', 0) - nbadcrc=1 - call timer('badnsync', 1) - return - endif - - j=0 - do k=1,NN - if(k.le.7) cycle - if(k.ge.37 .and. k.le.43) cycle - if(k.gt.72) cycle - j=j+1 - s1(0:7,j)=s2(0:7,k) - enddo - - call indexx(s1sort,8*ND,indxs1) - xmeds1=s1sort(indxs1(nint(0.5*8*ND))) - s1=s1/xmeds1 - - do j=1,ND - i4=3*j-2 - i2=3*j-1 - i1=3*j -! Max amplitude - ps=s1(0:7,j) - r1=max(ps(1),ps(3),ps(5),ps(7))-max(ps(0),ps(2),ps(4),ps(6)) - r2=max(ps(2),ps(3),ps(6),ps(7))-max(ps(0),ps(1),ps(4),ps(5)) - r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3)) - bmeta(i4)=r4 - bmeta(i2)=r2 - bmeta(i1)=r1 - bmetap(i4)=r4 - bmetap(i2)=r2 - bmetap(i1)=r1 -! Max log metric - psl=log(ps+1e-32) - r1=max(psl(1),psl(3),psl(5),psl(7))-max(psl(0),psl(2),psl(4),psl(6)) - r2=max(psl(2),psl(3),psl(6),psl(7))-max(psl(0),psl(1),psl(4),psl(5)) - r4=max(psl(4),psl(5),psl(6),psl(7))-max(psl(0),psl(1),psl(2),psl(3)) - bmetb(i4)=r4 - bmetb(i2)=r2 - bmetb(i1)=r1 - -! Metric for Cauchy noise -! r1=log(ps(1)**3+ps(3)**3+ps(5)**3+ps(7)**3)- & -! log(ps(0)**3+ps(2)**3+ps(4)**3+ps(6)**3) -! r2=log(ps(2)**3+ps(3)**3+ps(6)**3+ps(7)**3)- & -! log(ps(0)**3+ps(1)**3+ps(4)**3+ps(5)**3) -! r4=log(ps(4)**3+ps(5)**3+ps(6)**3+ps(7)**3)- & -! log(ps(0)**3+ps(1)**3+ps(2)**3+ps(3)**3) -! Metric for AWGN, no fading -! bscale=2.5 -! b0=bessi0(bscale*ps(0)) -! b1=bessi0(bscale*ps(1)) -! b2=bessi0(bscale*ps(2)) -! b3=bessi0(bscale*ps(3)) -! b4=bessi0(bscale*ps(4)) -! b5=bessi0(bscale*ps(5)) -! b6=bessi0(bscale*ps(6)) -! b7=bessi0(bscale*ps(7)) -! r1=log(b1+b3+b5+b7)-log(b0+b2+b4+b6) -! r2=log(b2+b3+b6+b7)-log(b0+b1+b4+b5) -! r4=log(b4+b5+b6+b7)-log(b0+b1+b2+b3) - - if(nQSOProgress .eq. 0 .or. nQSOProgress .eq. 5) then -! When bits 88:115 are set as ap bits, bit 115 lives in symbol 39 along -! with no-ap bits 116 and 117. Take care of metrics for bits 116 and 117. - if(j.eq.39) then ! take care of bits that live in symbol 39 - if(apsym(28).lt.0) then - bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1)) - bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2)) - else - bmetap(i2)=max(ps(6),ps(7))-max(ps(4),ps(5)) - bmetap(i1)=max(ps(5),ps(7))-max(ps(4),ps(6)) - endif - endif - endif - -! When bits 116:143 are set as ap bits, bit 115 lives in symbol 39 along -! with ap bits 116 and 117. Take care of metric for bit 115. -! if(j.eq.39) then ! take care of bit 115 -! iii=2*(apsym(29)+1)/2 + (apsym(30)+1)/2 ! known values of bits 116 & 117 -! if(iii.eq.0) bmetap(i4)=ps(4)-ps(0) -! if(iii.eq.1) bmetap(i4)=ps(5)-ps(1) -! if(iii.eq.2) bmetap(i4)=ps(6)-ps(2) -! if(iii.eq.3) bmetap(i4)=ps(7)-ps(3) -! endif - -! bit 144 lives in symbol 48 and will be 1 if it is set as an ap bit. -! take care of metrics for bits 142 and 143 - if(j.eq.48) then ! bit 144 is always 1 - bmetap(i4)=max(ps(5),ps(7))-max(ps(1),ps(3)) - bmetap(i2)=max(ps(3),ps(7))-max(ps(1),ps(5)) - endif - -! bit 154 lives in symbol 52 and will be 0 if it is set as an ap bit -! take care of metrics for bits 155 and 156 - if(j.eq.52) then ! bit 154 will be 0 if it is set as an ap bit. - bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1)) - bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2)) - endif - - enddo - - call normalizebmet(bmeta,3*ND) - call normalizebmet(bmetb,3*ND) - call normalizebmet(bmetap,3*ND) - - scalefac=2.83 - llr0=scalefac*bmeta - llr1=scalefac*bmetb - llra=scalefac*bmetap ! llr's for use with ap - apmag=scalefac*(maxval(abs(bmetap))*1.01) - -! pass # -!------------------------------ -! 1 regular decoding -! 2 erase 24 -! 3 erase 48 -! 4 ap pass 1 -! 5 ap pass 2 -! 6 ap pass 3 -! 7 ap pass 4, etc. - - if(lapon) then - if(.not.lapcqonly) then - npasses=4+nappasses(nQSOProgress) - else - npasses=5 - endif - else - npasses=4 - endif - - do ipass=1,npasses - - llr=llr0 - if(ipass.eq.2) llr=llr1 - if(ipass.eq.3) llr(1:24)=0. - if(ipass.eq.4) llr(1:48)=0. - if(ipass.le.4) then - apmask=0 - llrap=llr - iaptype=0 - endif - - if(ipass .gt. 4) then - if(.not.lapcqonly) then - iaptype=naptypes(nQSOProgress,ipass-4) - else - iaptype=1 - endif - if(iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle - if(iaptype.eq.1 .or. iaptype.eq.2 ) then ! AP,???,??? - apmask=0 - apmask(88:115)=1 ! first 28 bits are AP - apmask(144)=1 ! not free text - llrap=llr - if(iaptype.eq.1) llrap(88:115)=apmag*mcq - if(iaptype.eq.2) llrap(88:115)=apmag*apsym(1:28) - llrap(116:117)=llra(116:117) - llrap(142:143)=llra(142:143) - llrap(144)=-apmag - endif - if(iaptype.eq.3) then ! mycall, dxcall, ??? - apmask=0 - apmask(88:115)=1 ! mycall - apmask(116:143)=1 ! hiscall - apmask(144)=1 ! not free text - llrap=llr - llrap(88:143)=apmag*apsym(1:56) - llrap(144)=-apmag - endif - if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then - apmask=0 - apmask(88:115)=1 ! mycall - apmask(116:143)=1 ! hiscall - apmask(144:159)=1 ! RRR or 73 or RR73 - llrap=llr - llrap(88:143)=apmag*apsym(1:56) - if(iaptype.eq.4) llrap(144:159)=apmag*mrrr - if(iaptype.eq.5) llrap(144:159)=apmag*m73 - if(iaptype.eq.6) llrap(144:159)=apmag*mrr73 - endif - if(iaptype.eq.7) then ! ???, dxcall, ??? - apmask=0 - apmask(116:143)=1 ! hiscall - apmask(144)=1 ! not free text - llrap=llr - llrap(115)=llra(115) - llrap(116:143)=apmag*apsym(29:56) - llrap(144)=-apmag - endif - endif - - cw=0 - call timer('bpd174 ',0) - call bpdecode174(llrap,apmask,max_iterations,decoded,cw,nharderrors, & - niterations) - call timer('bpd174 ',1) - 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((ipass.eq.3 .or. ipass.eq.4) .and. .not.nagain) then - ndeep=3 - else - ndeep=4 - endif - endif - if(nagain) ndeep=5 - call timer('osd174 ',0) - call osd174(llrap,apmask,ndeep,decoded,cw,nharderrors,dmin) - call timer('osd174 ',1) - endif - nbadcrc=1 - message=' ' - xsnr=-99.0 - if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword - if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. & - .not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. & - .not.(ipass.gt.2 .and. nharderrors.gt.39) .and. & - .not.(ipass.eq.4 .and. nharderrors.gt.30) & - ) then - call chkcrc12a(decoded,nbadcrc) - else - nharderrors=-1 - cycle - endif - i3bit=4*decoded(73) + 2*decoded(74) + decoded(75) - if(nbadcrc.eq.0) then - decoded0=decoded - call extractmessage174(decoded,origmsg,ncrcflag) - decoded=decoded0 - - message(1:12)=origmsg(1:12) - call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone) - if(lsubtract) call subtractft8(dd0,itone,f1,xdt2) - xsig=0.0 - xnoi=0.0 - do i=1,NN - xsig=xsig+s2(itone(i),i)**2 - ios=mod(itone(i)+4,7) - xnoi=xnoi+s2(ios,i)**2 - enddo - xsnr=0.001 - if(xnoi.gt.0 .and. xnoi.lt.xsig) xsnr=xsig/xnoi-1.0 - xsnr=10.0*log10(xsnr)-27.0 - xsnr2=db(xsig/xbase - 1.0) - 32.0 - if(.not.nagain) xsnr=min(xsnr, xsnr2) - if(xsnr .lt. -24.0) xsnr=-24.0 - - msg37=origmsg//' ' - - msg37(22:22) = char(48 + i3bit) - - return - endif - enddo - - return -end subroutine ft8b - -subroutine normalizebmet(bmet,n) - real bmet(n) - - bmetav=sum(bmet)/real(n) - bmet2av=sum(bmet*bmet)/real(n) - var=bmet2av-bmetav*bmetav - if( var .gt. 0.0 ) then - bmetsig=sqrt(var) - else - bmetsig=sqrt(bmet2av) - endif - bmet=bmet/bmetsig - return -end subroutine normalizebmet - - -function bessi0(x) -! From Numerical Recipes - real bessi0,x - double precision p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9,y - save p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9 - data p1,p2,p3,p4,p5,p6,p7/1.0d0,3.5156229d0,3.0899424d0,1.2067492d0, & - 0.2659732d0,0.360768d-1,0.45813d-2/ - data q1,q2,q3,q4,q5,q6,q7,q8,q9/0.39894228d0,0.1328592d-1, & - 0.225319d-2,-0.157565d-2,0.916281d-2,-0.2057706d-1, & - 0.2635537d-1,-0.1647633d-1,0.392377d-2/ - - if (abs(x).lt.3.75) then - y=(x/3.75)**2 - bessi0=p1+y*(p2+y*(p3+y*(p4+y*(p5+y*(p6+y*p7))))) - else - ax=abs(x) - y=3.75/ax - bessi0=(exp(ax)/sqrt(ax))*(q1+y*(q2+y*(q3+y*(q4 & - +y*(q5+y*(q6+y*(q7+y*(q8+y*q9)))))))) - endif - return -end function bessi0 - diff --git a/lib/ft8/ft8code.f90 b/lib/ft8/ft8code.f90 deleted file mode 100644 index 3100148..0000000 --- a/lib/ft8/ft8code.f90 +++ /dev/null @@ -1,103 +0,0 @@ -program ft8code - -! Provides examples of message packing, LDPC(144,87) encoding, bit and -! symbol ordering, and other details of the FT8 protocol. - - use packjt - use crc - include 'ft8_params.f90' !Set various constants - include 'ft8_testmsg.f90' - parameter (NWAVE=NN*NSPS) - - character*40 msg,msgchk - character*37 msg37 - character*6 c1,c2 - character*9 comment - character*22 msgsent,message - character*6 mygrid6 - character bad*1,msgtype*10 - character*87 cbits - logical bcontest - integer itone(NN) - integer dgen(12) - integer*1 msgbits(KK),decoded(KK),decoded0(KK) - data mygrid6/'EM48 '/ - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.1 .and. nargs.ne.3) then - print* - print*,'Program ft8code: Provides examples of message packing, ', & - 'LDPC(174,87) encoding,' - print*,'bit and symbol ordering, and other details of the FT8 protocol.' - print* - print*,'Usage: ft8code [-c grid] "message" # Results for specified message' - print*,' ft8code -t # Examples of all message types' - go to 999 - endif - - bcontest=.false. - call getarg(1,msg) !Message to be transmitted - if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-t') then - testmsg(NTEST+1)='KA1ABC RR73; WB9XYZ -11' - nmsg=NTEST+1 - else if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-c') then - bcontest=.true. - call getarg(2,mygrid6) - call getarg(3,msg) - msgchk=msg - nmsg=1 - else - msgchk=msg - call fmtmsg(msgchk,iz) !To upper case; collapse multiple blanks - nmsg=1 - endif - - write(*,1010) -1010 format(" Message Decoded Err? Type"/76("-")) - - do imsg=1,nmsg - if(nmsg.gt.1) msg=testmsg(imsg) - call fmtmsg(msg,iz) !To upper case, collapse multiple blanks - msgchk=msg - -! Generate msgsent, msgbits, and itone - call packmsg(msg(1:22),dgen,itype,bcontest) - msgtype="" - if(itype.eq.1) msgtype="Std Msg" - if(itype.eq.2) msgtype="Type 1 pfx" - if(itype.eq.3) msgtype="Type 1 sfx" - if(itype.eq.4) msgtype="Type 2 pfx" - if(itype.eq.5) msgtype="Type 2 sfx" - if(itype.eq.6) msgtype="Free text" - i3bit=0 - call genft8(msg(1:22),mygrid6,bcontest,i3bit,msgsent,msgbits,itone) - - decoded=msgbits - i3bit=4*decoded(73) + 2*decoded(74) + decoded(75) - iFreeText=decoded(57) - decoded0=decoded - if(i3bit.eq.1) decoded(57:)=0 - call extractmessage174(decoded,message,ncrcflag) - decoded=decoded0 - - bad=" " - comment=' ' - if(itype.ne.6 .and. message.ne.msgchk) bad="*" - if(itype.eq.6 .and. message(1:13).ne.msgchk(1:13)) bad="*" - if(itype.eq.6 .and. len(trim(msgchk)).gt.13) comment='truncated' - write(*,1020) imsg,msgchk,message,bad,i3bit,itype,msgtype,comment -1020 format(i2,'.',1x,a22,1x,a22,1x,a1,2i2,1x,a10,1x,a9) - - enddo - - if(nmsg.eq.1) then - write(*,1030) msgbits(1:56) -1030 format(/'Call1: ',28i1,' Call2: ',28i1) - write(*,1032) msgbits(57:72),msgbits(73:75),msgbits(76:87) -1032 format('Grid: ',16i1,' 3Bit: ',3i1,' CRC12: ',12i1) - write(*,1034) itone -1034 format(/'Channel symbols:'/79i1) - endif - -999 end program ft8code diff --git a/lib/ft8/ft8d.f90 b/lib/ft8/ft8d.f90 deleted file mode 100644 index daee7b2..0000000 --- a/lib/ft8/ft8d.f90 +++ /dev/null @@ -1,63 +0,0 @@ -program ft8d - -! Decode FT8 data read from *.wav files. - - include 'ft8_params.f90' - character*12 arg - character infile*80,datetime*13,message*22 - real s(NH1,NHSYM) - real candidate(3,100) - integer ihdr(11) - integer*2 iwave(NMAX) !Generated full-length waveform - real dd(NMAX) - - nargs=iargc() - if(nargs.lt.3) then - print*,'Usage: ft8d MaxIt Norder file1 [file2 ...]' - print*,'Example ft8d 40 2 *.wav' - go to 999 - endif - call getarg(1,arg) - read(arg,*) max_iterations - call getarg(2,arg) - read(arg,*) norder - nfiles=nargs-2 - - twopi=8.0*atan(1.0) - fs=12000.0 !Sample rate - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of "itone" symbols (s) - ts=2*NSPS*dt !Duration of OQPSK symbols (s) - baud=1.0/tt !Keying rate (baud) - txt=NZ*dt !Transmission length (s) - nfa=100.0 - nfb=3000.0 - nfqso=1500.0 - - do ifile=1,nfiles - call getarg(ifile+2,infile) - open(10,file=infile,status='old',access='stream') - read(10,end=999) ihdr,iwave - close(10) - j2=index(infile,'.wav') - read(infile(j2-6:j2-1),*) nutc - datetime=infile(j2-13:j2-1) - call sync8(iwave,nfa,nfb,nfqso,s,candidate,ncand) - syncmin=2.0 - dd=iwave - do icand=1,ncand - sync=candidate(3,icand) - if( sync.lt.syncmin) cycle - f1=candidate(1,icand) - xdt=candidate(2,icand) - nsnr=min(99,nint(10.0*log10(sync)-25.5)) - call ft8b(dd,nfqso,f1,xdt,nharderrors,dmin,nbadcrc,message,xsnr) - nsnr=xsnr - xdt=xdt-0.6 - write(*,1110) datetime,0,nsnr,xdt,f1,message,nharderrors,dmin -1110 format(a13,2i4,f6.2,f7.1,' ~ ',a22,i6,f7.1) - enddo - enddo ! ifile loop - -999 end program ft8d - diff --git a/lib/ft8/ft8sim.f90 b/lib/ft8/ft8sim.f90 deleted file mode 100644 index a8bd496..0000000 --- a/lib/ft8/ft8sim.f90 +++ /dev/null @@ -1,172 +0,0 @@ -program ft8sim - -! Generate simulated data for a 15-second HF/6m mode using 8-FSK. -! Output is saved to a *.wav file. - - use wavhdr - include 'ft8_params.f90' !Set various constants - parameter (NWAVE=NN*NSPS) - type(hdr) h !Header for .wav file - character arg*12,fname*17 - character msg40*40,msg*22,msgsent*22,msg0*22 - character*6 mygrid6 - logical bcontest - complex c0(0:NMAX-1) - complex c(0:NMAX-1) - real wave(NMAX) - integer itone(NN) - integer*1 msgbits(KK) - integer*2 iwave(NMAX) !Generated full-length waveform - data mygrid6/'EM48 '/ - -! Get command-line argument(s) - nargs=iargc() - if(nargs.ne.8) then - print*,'Usage: ft8sim "message" nsig|f0 DT fdop del width nfiles snr' - print*,'Examples: ft8sim "K1ABC W9XYZ EN37" 1500.0 0.0 0.1 1.0 0 10 -18' - print*,' ft8sim "K1ABC W9XYZ EN37" 10 0.0 0.1 1.0 25 10 -18' - print*,' ft8sim "K1ABC W9XYZ EN37" 25 0.0 0.1 1.0 25 10 -18' - print*,' ft8sim "K1ABC RR73; W9XYZ -11" 300 0 0 0 25 1 -10' - print*,'Make nfiles negative to invoke 72-bit contest mode.' - go to 999 - endif - call getarg(1,msg40) !Message to be transmitted - call getarg(2,arg) - read(arg,*) f0 !Frequency (only used for single-signal) - call getarg(3,arg) - read(arg,*) xdt !Time offset from nominal (s) - call getarg(4,arg) - read(arg,*) fspread !Watterson frequency spread (Hz) - call getarg(5,arg) - read(arg,*) delay !Watterson delay (ms) - call getarg(6,arg) - read(arg,*) width !Filter transition width (Hz) - call getarg(7,arg) - read(arg,*) nfiles !Number of files - call getarg(8,arg) - read(arg,*) snrdb !SNR_2500 - nsig=1 - if(f0.lt.100.0) then - nsig=f0 - f0=1500 - endif - - bcontest=nfiles.lt.0 - nfiles=abs(nfiles) - twopi=8.0*atan(1.0) - fs=12000.0 !Sample rate (Hz) - dt=1.0/fs !Sample interval (s) - tt=NSPS*dt !Duration of symbols (s) - baud=1.0/tt !Keying rate (baud) - bw=8*baud !Occupied bandwidth (Hz) - txt=NZ*dt !Transmission length (s) - bandwidth_ratio=2500.0/(fs/2.0) - sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb) - if(snrdb.gt.90.0) sig=1.0 - txt=NN*NSPS/12000.0 - -! Source-encode, then get itone() - if(index(msg40,';').le.0) then - i3bit=0 - msg=msg40(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, & - ' BW:',f4.1,2x,a22) - else - call foxgen_wrap(msg40,msgbits,itone) - write(*,1001) f0,xdt,txt,snrdb,bw,msg40 -1001 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, & - ' BW:',f4.1,2x,a40) - endif - - write(*,1030) msgbits(1:56) -1030 format(/'Call1: ',28i1,' Call2: ',28i1) - write(*,1032) msgbits(57:72),msgbits(73:75),msgbits(76:87) -1032 format('Grid: ',16i1,' 3Bit: ',3i1,' CRC12: ',12i1) - write(*,1034) itone -1034 format(/'Channel symbols:'/79i1/) - - msg0=msg - do ifile=1,nfiles - c=0. - do isig=1,nsig - c0=0. - if(nsig.eq.2) then - if(index(msg,'R-').gt.0) f0=500 - i1=index(msg,' ') - msg(i1+4:i1+4)=char(ichar('A')+isig-1) - if(isig.eq.2) then - f0=f0+100 - endif - call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone) - endif - if(nsig.eq.25) then - f0=(isig+2)*100.0 - else if(nsig.eq.50) then - msg=msg0 - f0=1000.0 + (isig-1)*60.0 - i1=index(msg,' ') - i2=index(msg(i1+1:),' ') + i1 - msg(i1+2:i1+2)=char(ichar('0')+mod(isig-1,10)) - msg(i1+3:i1+3)=char(ichar('A')+mod(isig-1,26)) - msg(i1+4:i1+4)=char(ichar('A')+mod(isig-1,26)) - msg(i1+5:i1+5)=char(ichar('A')+mod(isig-1,26)) - write(msg(i2+3:i2+4),'(i2.2)') isig-1 - if(ifile.ge.2 .and. isig.eq.ifile-1) then - write(msg(i2+1:i2+4),1002) -isig -1002 format('R',i3.2) - f0=600.0 + mod(isig-1,5)*60.0 - endif - call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone) - endif - k=-1 + nint((xdt+0.5+0.01*gran())/dt) -! k=-1 + nint((xdt+0.5)/dt) - ia=k+1 - phi=0.0 - do j=1,NN !Generate complex waveform - dphi=twopi*(f0+itone(j)*baud)*dt - do i=1,NSPS - k=k+1 - phi=mod(phi+dphi,twopi) - if(k.ge.0 .and. k.lt.NMAX) c0(k)=cmplx(cos(phi),sin(phi)) - enddo - enddo - if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c0,NMAX,fs,delay,fspread) - c=c+sig*c0 - enddo - ib=k - wave=real(c) - peak=maxval(abs(wave(ia:ib))) - rms=sqrt(dot_product(wave(ia:ib),wave(ia:ib))/NWAVE) - nslots=1 - if(width.gt.0.0) call filt8(f0,nslots,width,wave) - - if(snrdb.lt.90) then - do i=1,NMAX !Add gaussian noise at specified SNR - xnoise=gran() -! wave(i)=wave(i) + xnoise -! if(i.ge.ia .and. i.le.ib) write(30,3001) i,wave(i)/peak -!3001 format(i8,f12.6) - wave(i)=wave(i) + xnoise - enddo - endif - - fac=32767.0 - rms=100.0 - if(snrdb.ge.90.0) iwave(1:NMAX)=nint(fac*wave) - if(snrdb.lt.90.0) iwave(1:NMAX)=nint(rms*wave) - - h=default_header(12000,NMAX) - write(fname,1102) ifile -1102 format('000000_',i6.6,'.wav') - open(10,file=fname,status='unknown',access='stream') - write(10) h,iwave !Save to *.wav file - close(10) - write(*,1110) ifile,xdt,f0,snrdb,fname -1110 format(i4,f7.2,f8.2,f7.1,2x,a17) - enddo - -999 end program ft8sim - - diff --git a/lib/ft8/genft8refsig.f90 b/lib/ft8/genft8refsig.f90 deleted file mode 100644 index 04c5612..0000000 --- a/lib/ft8/genft8refsig.f90 +++ /dev/null @@ -1,24 +0,0 @@ -subroutine genft8refsig(itone,cref,f0) - include 'ft8_params.f90' - - complex cref(NN*NSPS) - integer itone(NN) - real*8 twopi,phi,dphi,dt,xnsps - data twopi/0.d0/ - save twopi - if( twopi .lt. 0.1 ) twopi=8.d0*atan(1.d0) - - xnsps=NSPS*1.0d0 - dt=1.d0/12000.d0 - phi=0.d0 - k=1 - do i=1,NN - dphi=twopi*(f0*dt+itone(i)/xnsps) - do is=1,NSPS - cref(k)=cmplx(cos(phi),sin(phi)) - phi=mod(phi+dphi,twopi) - k=k+1 - enddo - enddo - return -end subroutine genft8refsig diff --git a/lib/ft8/subtractft8.f90 b/lib/ft8/subtractft8.f90 deleted file mode 100644 index f9a1180..0000000 --- a/lib/ft8/subtractft8.f90 +++ /dev/null @@ -1,63 +0,0 @@ -subroutine subtractft8(dd,itone,f0,dt) - -! Subtract an ft8 signal -! -! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) -! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) ) -! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ] -! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt} - - use timer_module, only: timer - - include 'ft8_params.f90' - parameter (NFRAME=NSPS*NN) - parameter (NFFT=NMAX, NFILT=1400) - - real*4 dd(NMAX), window(-NFILT/2:NFILT/2) - complex cref,camp,cfilt,cw - integer itone(NN) - logical first - data first/.true./ - common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX) - save first - - nstart=dt*12000+1 - call genft8refsig(itone,cref,f0) - camp=0. - do i=1,nframe - id=nstart-1+i - if(id.ge.1.and.id.le.NMAX) camp(i)=dd(id)*conjg(cref(i)) - enddo - - if(first) then -! Create and normalize the filter - pi=4.0*atan(1.0) - fac=1.0/float(nfft) - sum=0.0 - do j=-NFILT/2,NFILT/2 - window(j)=cos(pi*j/NFILT)**2 - sum=sum+window(j) - enddo - cw=0. - cw(1:NFILT+1)=window/sum - cw=cshift(cw,NFILT/2+1) - call four2a(cw,nfft,1,-1,1) - cw=cw*fac - first=.false. - endif - - cfilt=0.0 - cfilt(1:nframe)=camp(1:nframe) - call four2a(cfilt,nfft,1,-1,1) - cfilt(1:nfft)=cfilt(1:nfft)*cw(1:nfft) - call four2a(cfilt,nfft,1,1,1) - -! Subtract the reconstructed signal - do i=1,nframe - j=nstart+i-1 - if(j.ge.1 .and. j.le.NMAX) dd(j)=dd(j)-2*REAL(cfilt(i)*cref(i)) - enddo - - return -end subroutine subtractft8 - diff --git a/lib/ft8/sync8.f90 b/lib/ft8/sync8.f90 deleted file mode 100644 index 815191f..0000000 --- a/lib/ft8/sync8.f90 +++ /dev/null @@ -1,144 +0,0 @@ -subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) - - include 'ft8_params.f90' - complex cx(0:NH1) - real s(NH1,NHSYM) - real savg(NH1) - real sbase(NH1) - real x(NFFT1) - real sync2d(NH1,-JZ:JZ) - real red(NH1) - real candidate0(3,200) - real candidate(3,200) - real dd(NMAX) - integer jpeak(NH1) - integer indx(NH1) - integer ii(1) - integer icos7(0:6) - data icos7/4,2,5,6,1,3,0/ !Costas 7x7 tone pattern - equivalence (x,cx) - -! Compute symbol spectra, stepping by NSTEP steps. - savg=0. - tstep=NSTEP/12000.0 - df=12000.0/NFFT1 !3.125 Hz - fac=1.0/300.0 - do j=1,NHSYM - ia=(j-1)*NSTEP + 1 - ib=ia+NSPS-1 - x(1:NSPS)=fac*dd(ia:ib) - x(NSPS+1:)=0. - call four2a(x,NFFT1,1,-1,0) !r2c FFT - do i=1,NH1 - s(i,j)=real(cx(i))**2 + aimag(cx(i))**2 - enddo - savg=savg + s(1:NH1,j) !Average spectrum - enddo - call baseline(savg,nfa,nfb,sbase) - - ia=max(1,nint(nfa/df)) - ib=nint(nfb/df) - nssy=NSPS/NSTEP ! # steps per symbol - nfos=NFFT1/NSPS ! # frequency bin oversampling factor - jstrt=0.5/tstep - - candidate0=0. - k=0 - - do i=ia,ib - do j=-JZ,+JZ - ta=0. - tb=0. - tc=0. - t0a=0. - t0b=0. - t0c=0. - do n=0,6 - k=j+jstrt+nssy*n - if(k.ge.1.and.k.le.NHSYM) then - ta=ta + s(i+nfos*icos7(n),k) - t0a=t0a + sum(s(i:i+nfos*6:nfos,k)) - endif - tb=tb + s(i+nfos*icos7(n),k+nssy*36) - t0b=t0b + sum(s(i:i+nfos*6:nfos,k+nssy*36)) - if(k+nssy*72.le.NHSYM) then - tc=tc + s(i+nfos*icos7(n),k+nssy*72) - t0c=t0c + sum(s(i:i+nfos*6:nfos,k+nssy*72)) - endif - enddo - t=ta+tb+tc - t0=t0a+t0b+t0c - t0=(t0-t)/6.0 - sync_abc=t/t0 - - t=tb+tc - t0=t0b+t0c - t0=(t0-t)/6.0 - sync_bc=t/t0 - sync2d(i,j)=max(sync_abc,sync_bc) - enddo - enddo - - red=0. - do i=ia,ib - ii=maxloc(sync2d(i,-JZ:JZ)) - 1 - JZ - j0=ii(1) - jpeak(i)=j0 - red(i)=sync2d(i,j0) -! write(52,3052) i*df,red(i),db(red(i)) -!3052 format(3f12.3) - enddo - iz=ib-ia+1 - call indexx(red(ia:ib),iz,indx) - ibase=indx(nint(0.40*iz)) - 1 + ia - if(ibase.lt.1) ibase=1 - if(ibase.gt.nh1) ibase=nh1 - base=red(ibase) - red=red/base - - do i=1,min(200,iz) - n=ia + indx(iz+1-i) - 1 - if(red(n).lt.syncmin.or.isnan(red(n)).or.k.eq.200) exit - k=k+1 - candidate0(1,k)=n*df - candidate0(2,k)=(jpeak(n)-1)*tstep - candidate0(3,k)=red(n) - enddo - ncand=k - -! Put nfqso at top of list, and save only the best of near-dupe freqs. - do i=1,ncand - if(abs(candidate0(1,i)-nfqso).lt.10.0) candidate0(1,i)=-candidate0(1,i) - if(i.ge.2) then - do j=1,i-1 - fdiff=abs(candidate0(1,i))-abs(candidate0(1,j)) - if(abs(fdiff).lt.AZ) then ! note: this dedupe difference is dependent on symbol spacing - if(candidate0(3,i).ge.candidate0(3,j)) candidate0(3,j)=0. - if(candidate0(3,i).lt.candidate0(3,j)) candidate0(3,i)=0. - endif - enddo - endif - enddo - - fac=20.0/maxval(s) - s=fac*s - -! Sort by sync -! call indexx(candidate0(3,1:ncand),ncand,indx) -! Sort by frequency - call indexx(candidate0(1,1:ncand),ncand,indx) - k=1 -! do i=ncand,1,-1 - do i=1,ncand - j=indx(i) -! if( candidate0(3,j) .ge. syncmin .and. candidate0(2,j).ge.-1.5 ) then - if( candidate0(3,j) .ge. syncmin ) then - candidate(1,k)=abs(candidate0(1,j)) - candidate(2,k)=candidate0(2,j) - candidate(3,k)=candidate0(3,j) - k=k+1 - endif - enddo - ncand=k-1 - return -end subroutine sync8 diff --git a/lib/ft8/sync8d.f90 b/lib/ft8/sync8d.f90 deleted file mode 100644 index 07aca75..0000000 --- a/lib/ft8/sync8d.f90 +++ /dev/null @@ -1,56 +0,0 @@ -subroutine sync8d(cd0,i0,ctwk,itwk,sync) - -! Compute sync power for a complex, downsampled FT8 signal. - - include 'ft8_params.f90' - - parameter(NP2=2812) - complex cd0(3125) - complex csync(0:6,NDOWNSPS) - complex csync2(NDOWNSPS) - complex ctwk(NDOWNSPS) - complex z1,z2,z3 - logical first - integer icos7(0:6) - data icos7/4,2,5,6,1,3,0/ - data first/.true./ - save first,twopi,fs2,dt2,taus,baud,csync - - p(z1)=real(z1)**2 + aimag(z1)**2 !Statement function for power - -! Set some constants and compute the csync array. - if( first ) then - twopi=8.0*atan(1.0) - fs2=12000.0/NDOWN !Sample rate after downsampling - dt2=1/fs2 !Corresponding sample interval - taus=NDOWNSPS*dt2 !Symbol duration - baud=1.0/taus !Keying rate - do i=0,6 - phi=0.0 - dphi=twopi*icos7(i)*baud*dt2 - do j=1,NDOWNSPS - csync(i,j)=cmplx(cos(phi),sin(phi)) !Waveform for 7x7 Costas array - phi=mod(phi+dphi,twopi) - enddo - enddo - first=.false. - endif - - sync=0 - do i=0,6 !Sum over 7 Costas frequencies and - i1=i0+i*NDOWNSPS !three Costas arrays - i2=i1+36*NDOWNSPS - i3=i1+72*NDOWNSPS - csync2=csync(i,1:NDOWNSPS) - if(itwk.eq.1) csync2=ctwk*csync2 !Tweak the frequency - z1=0. - z2=0. - z3=0. - if(i1.ge.1 .and. i1+(NDOWNSPS-1).le.NP2) z1=sum(cd0(i1:i1+(NDOWNSPS-1))*conjg(csync2)) - if(i2.ge.1 .and. i2+(NDOWNSPS-1).le.NP2) z2=sum(cd0(i2:i2+(NDOWNSPS-1))*conjg(csync2)) - if(i3.ge.1 .and. i3+(NDOWNSPS-1).le.NP2) z3=sum(cd0(i3:i3+(NDOWNSPS-1))*conjg(csync2)) - sync = sync + p(z1) + p(z2) + p(z3) - enddo - - return -end subroutine sync8d diff --git a/lib/ft8_decode.mod b/lib/ft8_decode.mod new file mode 100644 index 0000000..d6e96ef Binary files /dev/null and b/lib/ft8_decode.mod differ diff --git a/lib/js8/js8_params.f90 b/lib/js8/js8_params.f90 index fc5512c..84631a3 100644 --- a/lib/js8/js8_params.f90 +++ b/lib/js8/js8_params.f90 @@ -1,2 +1 @@ -parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas) -parameter (NWRITELOG=0) !Write log file? +parameter (NWRITELOG=1) !Write log file? diff --git a/lib/js8/js8a_params.f90 b/lib/js8/js8a_params.f90 new file mode 100644 index 0000000..599ad04 --- /dev/null +++ b/lib/js8/js8a_params.f90 @@ -0,0 +1,19 @@ +parameter (NCOSTAS=1) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas) + +parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=62) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s + +parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz +parameter (ASTART=0.5) !Start delay in seconds +parameter (ASYNCMIN=1.5) !Minimum Sync + +parameter (KK=87) !Information bits (75 + CRC12) +parameter (ND=58) !Data symbols +parameter (NS=21) !Sync symbols (3 @ Costas 7x7) +parameter (NN=NS+ND) !Total channel symbols (79) +parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680) +parameter (NMAX=NTXDUR*12000) !Samples in iwave (180,000) +parameter (NFFT1=2*NSPS, NH1=NFFT1/2) !Length of FFTs for symbol spectra +parameter (NSTEP=NSPS/4) !Rough time-sync step size +parameter (NHSYM=NMAX/NSTEP-3) !Number of symbol spectra (1/4-sym steps) +parameter (NDOWN=NSPS/NDOWNSPS) !Downsample factor to 32 samples per symbol +parameter (NQSYMBOL=NDOWNSPS/4) !Downsample factor of a quarter symbol diff --git a/lib/js8/js8b_params.f90 b/lib/js8/js8b_params.f90 index 1377fd3..b29960f 100644 --- a/lib/js8/js8b_params.f90 +++ b/lib/js8/js8b_params.f90 @@ -1,23 +1,6 @@ -!parameter (NSPS=480) !Samples per symbol at 12000 S/s -!parameter (NTXDUR=5) !TX Duration in Seconds -!parameter (NDOWNSPS=16) !Downsampled samples per symbol -!parameter (AZ=6.0) !Near dupe sync spacing -!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins -!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ? +parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas) - -! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=16, NDD=150, JZ=116) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=16, NDD=160, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s -! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=116) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s -! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s -! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s -! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s - parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=144) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s -! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s -! parameter (NSPS=4000, NTXDUR=30, NDOWNSPS=20, NDD=90, JZ=62) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s +parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=144) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz parameter (ASTART=0.2) !Start delay in seconds diff --git a/lib/js8/js8c_params.f90 b/lib/js8/js8c_params.f90 index ae7ba98..2795d04 100644 --- a/lib/js8/js8c_params.f90 +++ b/lib/js8/js8c_params.f90 @@ -1,23 +1,6 @@ -!parameter (NSPS=480) !Samples per symbol at 12000 S/s -!parameter (NTXDUR=5) !TX Duration in Seconds -!parameter (NDOWNSPS=16) !Downsampled samples per symbol -!parameter (AZ=6.0) !Near dupe sync spacing -!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins -!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ? +parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas) - -! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=16, NDD=150, JZ=116) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=16, NDD=160, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s - parameter (NSPS=600, NTXDUR=6, NDOWNSPS=12, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s -! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s -! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s -! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s -! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s -! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s -! parameter (NSPS=4000, NTXDUR=30, NDOWNSPS=20, NDD=90, JZ=62) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s +parameter (NSPS=600, NTXDUR=6, NDOWNSPS=12, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz parameter (ASTART=0.1) !Start delay in seconds diff --git a/lib/js8/js8dec.f90 b/lib/js8/js8dec.f90 index 3370767..57627e5 100644 --- a/lib/js8/js8dec.f90 +++ b/lib/js8/js8dec.f90 @@ -494,3 +494,42 @@ subroutine js8dec(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & return end subroutine js8dec + +subroutine normalizebmet(bmet,n) + real bmet(n) + + bmetav=sum(bmet)/real(n) + bmet2av=sum(bmet*bmet)/real(n) + var=bmet2av-bmetav*bmetav + if( var .gt. 0.0 ) then + bmetsig=sqrt(var) + else + bmetsig=sqrt(bmet2av) + endif + bmet=bmet/bmetsig + return +end subroutine normalizebmet + + +function bessi0(x) +! From Numerical Recipes + real bessi0,x + double precision p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9,y + save p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9 + data p1,p2,p3,p4,p5,p6,p7/1.0d0,3.5156229d0,3.0899424d0,1.2067492d0, & + 0.2659732d0,0.360768d-1,0.45813d-2/ + data q1,q2,q3,q4,q5,q6,q7,q8,q9/0.39894228d0,0.1328592d-1, & + 0.225319d-2,-0.157565d-2,0.916281d-2,-0.2057706d-1, & + 0.2635537d-1,-0.1647633d-1,0.392377d-2/ + + if (abs(x).lt.3.75) then + y=(x/3.75)**2 + bessi0=p1+y*(p2+y*(p3+y*(p4+y*(p5+y*(p6+y*p7))))) + else + ax=abs(x) + y=3.75/ax + bessi0=(exp(ax)/sqrt(ax))*(q1+y*(q2+y*(q3+y*(q4 & + +y*(q5+y*(q6+y*(q7+y*(q8+y*q9)))))))) + endif + return +end function bessi0 diff --git a/lib/js8/js8e_params.f90 b/lib/js8/js8e_params.f90 index 393b557..10d9ce4 100644 --- a/lib/js8/js8e_params.f90 +++ b/lib/js8/js8e_params.f90 @@ -1,24 +1,6 @@ -!parameter (NSPS=480) !Samples per symbol at 12000 S/s -!parameter (NTXDUR=5) !TX Duration in Seconds -!parameter (NDOWNSPS=16) !Downsampled samples per symbol -!parameter (AZ=6.0) !Near dupe sync spacing -!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins -!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ? +parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas) - -! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=12, NDD=125, JZ=250) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s -! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s -! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s -! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s -! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s -! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s -! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s - parameter (NSPS=3840, NTXDUR=28, NDOWNSPS=32, NDD=90, JZ=32) ! 25 Hz 3.125 baud 8 wpm -28.0dB (1.0Eb/N0) 25.28s -! parameter (NSPS=4000, NTXDUR=28, NDOWNSPS=40, NDD=90, JZ=32) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s +parameter (NSPS=3840, NTXDUR=28, NDOWNSPS=32, NDD=90, JZ=32) ! 25 Hz 3.125 baud 8 wpm -28.0dB (1.0Eb/N0) 25.28s parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz parameter (ASTART=0.5) !Start delay in seconds diff --git a/lib/js8/js8i_params.f90 b/lib/js8/js8i_params.f90 index ee99f46..a6342dc 100644 --- a/lib/js8/js8i_params.f90 +++ b/lib/js8/js8i_params.f90 @@ -1,24 +1,6 @@ -!parameter (NSPS=480) !Samples per symbol at 12000 S/s -!parameter (NTXDUR=5) !TX Duration in Seconds -!parameter (NDOWNSPS=16) !Downsampled samples per symbol -!parameter (AZ=6.0) !Near dupe sync spacing -!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins -!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ? +parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas) - - parameter (NSPS=384, NTXDUR=4, NDOWNSPS=12, NDD=125, JZ=250) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s -! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s -! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s -! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s -! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s -! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s -! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s -! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s -! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s -! parameter (NSPS=3840, NTXDUR=30, NDOWNSPS=32, NDD=94, JZ=116) ! 24 Hz 3.125 baud 8 wpm -28.0dB (1.0Eb/N0) 25.28s -! parameter (NSPS=4000, NTXDUR=28, NDOWNSPS=20, NDD=90, JZ=32) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s +parameter (NSPS=384, NTXDUR=4, NDOWNSPS=12, NDD=125, JZ=250) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz parameter (ASTART=0.1) !Start delay in seconds diff --git a/lib/ft8/ldpcsim174.f90 b/lib/js8/ldpcsim174js8a.f90 similarity index 98% rename from lib/ft8/ldpcsim174.f90 rename to lib/js8/ldpcsim174js8a.f90 index d4239b4..299ca65 100644 --- a/lib/ft8/ldpcsim174.f90 +++ b/lib/js8/ldpcsim174js8a.f90 @@ -1,9 +1,10 @@ -program ldpcsim174 +program ldpcsim174js8 ! End to end test of the (174,75)/crc12 encoder and decoder. use crc use packjt -include 'ft8_params.f90' +include 'js8_params.f90' +include 'js8a_params.f90' character*22 msg,msgsent,msgreceived character*8 arg @@ -234,4 +235,4 @@ do i=1,87 enddo close(25) -end program ldpcsim174 +end program ldpcsim174js8 diff --git a/lib/js8/syncjs8.f90 b/lib/js8/syncjs8.f90 index a9c8890..fce733f 100644 --- a/lib/js8/syncjs8.f90 +++ b/lib/js8/syncjs8.f90 @@ -144,7 +144,6 @@ subroutine syncjs8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) enddo ncand=k - ! Save only the best of near-dupe freqs. do i=1,ncand if(i.ge.2) then @@ -158,23 +157,18 @@ subroutine syncjs8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase) endif enddo -! Put nfqso at top of list - do i=1,ncand - if(abs(candidate0(1,i)-nfqso).lt.10.0) candidate0(1,i)=-candidate0(1,i) - enddo - fac=20.0/maxval(s) s=fac*s ! Sort by sync ! call indexx(candidate0(3,1:ncand),ncand,indx) + ! Sort by frequency call indexx(candidate0(1,1:ncand),ncand,indx) + k=1 -! do i=ncand,1,-1 do i=1,ncand j=indx(i) -! if( candidate0(3,j) .ge. syncmin .and. candidate0(2,j).ge.-1.5 ) then if( candidate0(3,j) .ge. syncmin ) then candidate(1,k)=abs(candidate0(1,j)) candidate(2,k)=candidate0(2,j) diff --git a/lib/ft8_decode.f90 b/lib/js8a_decode.f90 similarity index 70% rename from lib/ft8_decode.f90 rename to lib/js8a_decode.f90 index 7595523..252d7ed 100644 --- a/lib/ft8_decode.f90 +++ b/lib/js8a_decode.f90 @@ -1,25 +1,16 @@ -module ft8_decode +module js8a_decode - parameter (MAXFOX=1000) - character*12 c2fox(MAXFOX) - character*4 g2fox(MAXFOX) - integer nsnrfox(MAXFOX) - integer nfreqfox(MAXFOX) - integer n30fox(MAXFOX) - integer n30z - integer nfox - - type :: ft8_decoder - procedure(ft8_decode_callback), pointer :: callback + type :: js8a_decoder + procedure(js8a_decode_callback), pointer :: callback contains procedure :: decode - end type ft8_decoder + end type js8a_decoder abstract interface - subroutine ft8_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual) - import ft8_decoder + subroutine js8a_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual) + import js8a_decoder implicit none - class(ft8_decoder), intent(inout) :: this + class(js8a_decoder), intent(inout) :: this real, intent(in) :: sync integer, intent(in) :: snr real, intent(in) :: dt @@ -27,7 +18,7 @@ module ft8_decode character(len=37), intent(in) :: decoded integer, intent(in) :: nap real, intent(in) :: qual - end subroutine ft8_decode_callback + end subroutine js8a_decode_callback end interface contains @@ -37,11 +28,11 @@ contains mycall12,mygrid6,hiscall12,hisgrid6) ! use wavhdr use timer_module, only: timer - include 'ft8/ft8_params.f90' ! type(hdr) h + use js8a_module - class(ft8_decoder), intent(inout) :: this - procedure(ft8_decode_callback) :: callback + class(js8a_decoder), intent(inout) :: this + procedure(js8a_decode_callback) :: callback real s(NH1,NHSYM) real sbase(NH1) real candidate(3,200) @@ -83,7 +74,7 @@ contains if(ndepth.ge.2) npass=3 do ipass=1,npass newdat=.true. ! Is this a problem? I hijacked newdat. - syncmin=1.5 + syncmin=ASYNCMIN if(ipass.eq.1) then lsubtract=.true. if(ndepth.eq.1) lsubtract=.false. @@ -96,9 +87,14 @@ contains lsubtract=.false. endif - call timer('sync8 ',0) - call sync8(dd,ifa,ifb,syncmin,nfqso,s,candidate,ncand,sbase) - call timer('sync8 ',1) + call timer('syncjs8 ',0) + call syncjs8(dd,ifa,ifb,syncmin,nfqso,s,candidate,ncand,sbase) + call timer('syncjs8 ',1) + + if(NWRITELOG.eq.1) then + write(*,*) '', ncand, "candidates" + flush(6) + endif do icand=1,ncand sync=candidate(3,icand) @@ -106,16 +102,28 @@ contains xdt=candidate(2,icand) xbase=10.0**(0.1*(sbase(nint(f1/(12000.0/NFFT1)))-40.0)) ! 3.125Hz nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ### - call timer('ft8b ',0) - call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & + + if(NWRITELOG.eq.1) then + write(*,*) ' candidate', icand, 'f1', f1, 'sync', sync, 'xdt', xdt, 'xbase', xbase + flush(6) + endif + + call timer('js8dec ',0) + call js8dec(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, & hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, & nbadcrc,iappass,iera,msg37,xsnr) message=msg37(1:22) !### nsnr=nint(xsnr) - xdt=xdt-0.5 + xdt=xdt-ASTART hd=nharderrors+dmin - call timer('ft8b ',1) + + if(NWRITELOG.eq.1) then + write(*,*) ' candidate', icand, 'hard', hd, 'nbadcrc', nbadcrc + flush(6) + endif + + call timer('js8dec ',1) if(nbadcrc.eq.0) then ldupe=.false. do id=1,ndecodes @@ -131,9 +139,14 @@ contains call this%callback(sync,nsnr,xdt,f1,msg37,iaptype,qual) endif endif + + if(NWRITELOG.eq.1) then + write(*,*) ' ---' + flush(6) + endif enddo enddo return end subroutine decode -end module ft8_decode +end module js8a_decode diff --git a/lib/js8a_module.f90 b/lib/js8a_module.f90 new file mode 100644 index 0000000..4dfd1c6 --- /dev/null +++ b/lib/js8a_module.f90 @@ -0,0 +1,13 @@ +module js8a_module + include 'js8/js8_params.f90' + include 'js8/js8a_params.f90' + +contains + include 'js8/baselinejs8.f90' + include 'js8/syncjs8.f90' + include 'js8/js8_downsample.f90' + include 'js8/syncjs8d.f90' + include 'js8/genjs8refsig.f90' + include 'js8/subtractjs8.f90' + include 'js8/js8dec.f90' +end module js8a_module diff --git a/lib/ldpcsim144.f90 b/lib/ldpcsim144.f90 deleted file mode 100644 index 66dbfbf..0000000 --- a/lib/ldpcsim144.f90 +++ /dev/null @@ -1,175 +0,0 @@ -program ldpcsim - -use, intrinsic :: iso_c_binding -use iso_c_binding, only: c_loc,c_size_t -use hashing -use packjt -parameter(NRECENT=10) -character*12 recent_calls(NRECENT) -character*22 msg,msgsent,msgreceived -character*8 arg -integer*1, allocatable :: codeword(:), decoded(:), message(:) -integer*1, target:: i1Msg8BitBytes(10) -integer*1 i1hash(4) -integer*1 msgbits(80) -integer*4 i4Msg6BitWords(13) -integer ihash -integer nerrtot(128),nerrdec(128) -real*8, allocatable :: lratio(:), rxdata(:), rxavgd(:) -real, allocatable :: yy(:), llr(:) -equivalence(ihash,i1hash) - -do i=1,NRECENT - recent_calls(i)=' ' -enddo -nerrtot=0 -nerrdec=0 - -nargs=iargc() -if(nargs.ne.4) then - print*,'Usage: ldpcsim niter navg #trials s ' - print*,'eg: ldpcsim 10 1 1000 0.75' - return -endif -call getarg(1,arg) -read(arg,*) max_iterations -call getarg(2,arg) -read(arg,*) navg -call getarg(3,arg) -read(arg,*) ntrials -call getarg(4,arg) -read(arg,*) s - -! don't count hash bits as data bits -N=128 -K=72 -rate=real(K)/real(N) - -write(*,*) "rate: ",rate - -write(*,*) "niter= ",max_iterations," navg= ",navg," s= ",s - -allocate ( codeword(N), decoded(K), message(K) ) -allocate ( lratio(N), rxdata(N), rxavgd(N), yy(N), llr(N) ) - -msg="K9AN K1JT EN50" - call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes - call unpackmsg(i4Msg6BitWords,msgsent,.false.,' ') !Unpack to get msgsent - write(*,*) "message sent ",msgsent - - i4=0 - ik=0 - im=0 - do i=1,12 - nn=i4Msg6BitWords(i) - do j=1, 6 - ik=ik+1 - i4=i4+i4+iand(1,ishft(nn,j-6)) - i4=iand(i4,255) - if(ik.eq.8) then - im=im+1 -! if(i4.gt.127) i4=i4-256 - i1Msg8BitBytes(im)=i4 - ik=0 - endif - enddo - enddo - - ihash=nhash(c_loc(i1Msg8BitBytes),int(9,c_size_t),146) - ihash=2*iand(ihash,32767) !Generate the 8-bit hash - i1Msg8BitBytes(10)=i1hash(1) !Hash code to byte 10 - mbit=0 - do i=1, 10 - i1=i1Msg8BitBytes(i) - do ibit=1,8 - mbit=mbit+1 - msgbits(mbit)=iand(1,ishft(i1,ibit-8)) - enddo - enddo - call encode_msk144(msgbits,codeword) - call init_random_seed() - -write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadhash sigma" -do idb = -6, 14 - db=idb/2.0-1.0 - sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) - ngood=0 - nue=0 - nbadhash=0 - - do itrial=1, ntrials - rxavgd=0d0 - do iav=1,navg - call sgran() -! Create a realization of a noisy received word - do i=1,N - rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() - enddo - rxavgd=rxavgd+rxdata - enddo - rxdata=rxavgd - nerr=0 - do i=1,N - if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1 - enddo - nerrtot(nerr)=nerrtot(nerr)+1 - -! Correct signal normalization is important for this decoder. - rxav=sum(rxdata)/N - rx2av=sum(rxdata*rxdata)/N - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig -! To match the metric to the channel, s should be set to the noise standard deviation. -! For now, set s to the value that optimizes decode probability near threshold. -! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of -! magnitude in UER - if( s .lt. 0 ) then - ss=sigma - else - ss=s - endif - - llr=2.0*rxdata/(ss*ss) - lratio=exp(llr) - yy=rxdata - -! max_iterations is max number of belief propagation iterations -! call ldpc_decode(lratio, decoded, max_iterations, niterations, max_dither, ndither) -! call amsdecode(yy, max_iterations, decoded, niterations) -! call bitflipmsk144(rxdata, decoded, niterations) - call bpdecode144(llr, max_iterations, decoded, niterations) - -! If the decoder finds a valid codeword, niterations will be .ge. 0. - if( niterations .ge. 0 ) then - call extractmessage144(decoded,msgreceived,nhashflag,recent_calls,nrecent) - if( nhashflag .ne. 1 ) then - nbadhash=nbadhash+1 - endif - nueflag=0 - -! Check the message plus hash against what was sent. - do i=1,K - if( msgbits(i) .ne. decoded(i) ) then - nueflag=1 - endif - enddo - if( nhashflag .eq. 1 .and. nueflag .eq. 0 ) then - ngood=ngood+1 - nerrdec(nerr)=nerrdec(nerr)+1 - else if( nhashflag .eq. 1 .and. nueflag .eq. 1 ) then - nue=nue+1; - endif - endif - enddo - snr2500=db-3.5 - write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2)") db,snr2500,ngood,nue,nbadhash,ss - -enddo - -open(unit=23,file='nerrhisto.dat',status='unknown') -do i=1,128 - write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10) -enddo -close(23) - -end program ldpcsim