diff --git a/CMakeLists.txt b/CMakeLists.txt index cc1e2edf7..654ddd1e9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -392,7 +392,9 @@ set (wsjt_FSRCS lib/fqso_first.f90 lib/freqcal.f90 lib/fsk4hf/fsk4hf.f90 + lib/fsk4hf/ft8b.f90 lib/fsk4hf/ft8d.f90 + lib/fsk4hf/ft8filbig.f90 lib/fsk4hf/ft8sim.f90 lib/gen4.f90 lib/gen65.f90 diff --git a/lib/fsk4hf/ft8b.f90 b/lib/fsk4hf/ft8b.f90 new file mode 100644 index 000000000..1293b31a8 --- /dev/null +++ b/lib/fsk4hf/ft8b.f90 @@ -0,0 +1,74 @@ +subroutine ft8b(datetime,s,candidate,ncand) + + include 'ft8_params.f90' + parameter(NRECENT=10) + character*12 recent_calls(NRECENT) + character message*22,datetime*13 + real s(NH1,NHSYM) + real s1(0:7,ND) + real ps(0:7) + real rxdata(3*ND),llr(3*ND) !Soft symbols + real candidate(3,100) + integer*1 decoded(KK),apmask(3*ND),cw(3*ND) + + max_iterations=40 + norder=2 + tstep=0.5*NSPS/12000.0 + df=12000.0/NFFT1 + + do icand=1,ncand + f1=candidate(1,icand) + xdt=candidate(2,icand) + sync=candidate(3,icand) + i0=nint(f1/df) + j0=nint(xdt/tstep) + + j=0 + ia=i0 + ib=i0+14 + do k=1,NN + if(k.le.7) cycle + if(k.ge.37 .and. k.le.43) cycle + if(k.gt.72) cycle + n=j0+2*(k-1)+1 + if(n.lt.1) cycle + j=j+1 + s1(0:7,j)=s(ia:ib:2,n) + enddo + + do j=1,ND + ps=s1(0:7,j) + ps=log(ps) + 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)) + rxdata(3*j-2)=r4 + rxdata(3*j-1)=r2 + rxdata(3*j)=r1 + enddo + rxav=sum(rxdata)/ND + rx2av=sum(rxdata*rxdata)/ND + rxsig=sqrt(rx2av-rxav*rxav) + rxdata=rxdata/rxsig + ss=0.84 + llr=2.0*rxdata/(ss*ss) + apmask=0 + call bpdecode174(llr,apmask,max_iterations,decoded,niterations) + if(niterations.lt.0) call osd174(llr,norder,decoded,nharderrors,cw) + nbadcrc=0 + call chkcrc12a(decoded,nbadcrc) + + message=' ' + if(nbadcrc.eq.0) then + call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent) + nsnr=nint(10.0*log10(sync) - 25.5) !### empirical ### + write(13,1110) datetime,0,nsnr,xdt,f1,xdta,f1a,niterations, & + nharderrors,message +1110 format(a13,2i4,2(f6.2,f7.1),2i4,2x,a22) + write(*,1112) datetime(8:13),nsnr,xdt,nint(f1),message +1112 format(a6,i4,f5.1,i6,2x,a22) + endif + enddo + + return +end subroutine ft8b diff --git a/lib/fsk4hf/ft8d.f90 b/lib/fsk4hf/ft8d.f90 index d632f6007..df2f85595 100644 --- a/lib/fsk4hf/ft8d.f90 +++ b/lib/fsk4hf/ft8d.f90 @@ -11,18 +11,12 @@ program ft8d ! ... tbd ... include 'ft8_params.f90' - parameter(NRECENT=10) - character*12 recent_calls(NRECENT),arg - character message*22,infile*80,datetime*13 + character*12 arg + character infile*80,datetime*13 real s(NH1,NHSYM) - real s1(0:7,ND) - real ps(0:7) - real rxdata(3*ND),llr(3*ND) !Soft symbols + real candidate(3,100) integer ihdr(11) integer*2 iwave(NMAX) !Generated full-length waveform -! integer*1 idat(7) - integer*1 decoded(KK),apmask(3*ND),cw(3*ND) - integer*8 count0,count1,clkfreq nargs=iargc() if(nargs.lt.3) then @@ -43,10 +37,6 @@ program ft8d ts=2*NSPS*dt !Duration of OQPSK symbols (s) baud=1.0/tt !Keying rate (baud) txt=NZ*dt !Transmission length (s) - nsync=0 - ngood=0 - nbad=0 - tsec=0. do ifile=1,nfiles call getarg(ifile+2,infile) @@ -56,72 +46,9 @@ program ft8d j2=index(infile,'.wav') read(infile(j2-6:j2-1),*) nutc datetime=infile(j2-13:j2-1) - call system_clock(count0,clkfreq) - -! call ft8filbig(iwave,NN*NSPS,xdta,f1a,xsnr) - call sync8(iwave,xdt,f1,s) - - tstep=0.5*NSPS/12000.0 - df=12000.0/NFFT1 - i0=nint(f1/df) - j0=nint(xdt/tstep) - fac=20.0/maxval(s) - s=fac*s - - j=0 - ia=i0 - ib=i0+14 - do k=1,NN - if(k.le.7) cycle - if(k.ge.37 .and. k.le.43) cycle - if(k.gt.72) cycle - n=j0+2*(k-1)+1 - if(n.lt.1) cycle - j=j+1 - s1(0:7,j)=s(ia:ib:2,n) - enddo - - do j=1,ND - ps=s1(0:7,j) - ps=log(ps) - 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)) - rxdata(3*j-2)=r4 - rxdata(3*j-1)=r2 - rxdata(3*j)=r1 - enddo - rxav=sum(rxdata)/ND - rx2av=sum(rxdata*rxdata)/ND - rxsig=sqrt(rx2av-rxav*rxav) - rxdata=rxdata/rxsig - ss=0.84 - llr=2.0*rxdata/(ss*ss) - apmask=0 - call bpdecode174(llr,apmask,max_iterations,decoded,niterations) - if(niterations.lt.0) call osd174(llr,norder,decoded,nharderrors,cw) - nbadcrc=0 - call chkcrc12a(decoded,nbadcrc) - - message=' ' - if(nbadcrc.eq.0) then - call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent) - endif - nsnr=nint(xsnr) - write(13,1110) datetime,0,nsnr,xdt,f1,xdta,f1a,niterations,nharderrors,message -1110 format(a13,2i4,2(f6.2,f7.1),2i4,2x,a22) - write(*,1112) datetime(8:13),nsnr,xdt,nint(f1),message -1112 format(a6,i4,f5.1,i6,2x,a22) - if(abs(xdt).le.0.1 .or. abs(f1-1500).le.2.93) nsync=nsync+1 - if(message.eq.'K1ABC W9XYZ EN37 ') ngood=ngood+1 - if(message.ne.'K1ABC W9XYZ EN37 ' .and. & - message.ne.' ') nbad=nbad+1 - call system_clock(count1,clkfreq) - tsec=tsec+float(count1-count0)/float(clkfreq) + call sync8(iwave,s,candidate,ncand) + call ft8b(datetime,s,candidate,ncand) enddo ! ifile loop - write(21,1100) max_iterations,norder,float(nsync)/nfiles,float(ngood)/nfiles, & - float(nbad)/nfiles,tsec/nfiles -1100 format(2i5,3f8.4,f9.3) - 999 end program ft8d + diff --git a/lib/fsk4hf/ft8sim.f90 b/lib/fsk4hf/ft8sim.f90 index 42c5f775f..393b22825 100644 --- a/lib/fsk4hf/ft8sim.f90 +++ b/lib/fsk4hf/ft8sim.f90 @@ -15,23 +15,21 @@ program ft8sim ! Get command-line argument(s) nargs=iargc() - if(nargs.ne.7) then - print*,'Usage: ft8sim "message" f0 DT fdop del nfiles snr' - print*,'Example: ft8sim "K1ABC W9XYZ EN37" 1500 0.0 0.1 1.0 10 -18' + if(nargs.ne.6) then + print*,'Usage: ft8sim "message" DT fdop del nfiles snr' + print*,'Example: ft8sim "K1ABC W9XYZ EN37" 0.0 0.1 1.0 10 -18' go to 999 endif call getarg(1,msg) !Message to be transmitted call getarg(2,arg) - read(arg,*) f0 !Freq of tone 0 (Hz) - call getarg(3,arg) read(arg,*) xdt !Time offset from nominal (s) - call getarg(4,arg) + call getarg(3,arg) read(arg,*) fspread !Watterson frequency spread (Hz) - call getarg(5,arg) + call getarg(4,arg) read(arg,*) delay !Watterson delay (ms) - call getarg(6,arg) + call getarg(5,arg) read(arg,*) nfiles !Number of files - call getarg(7,arg) + call getarg(6,arg) read(arg,*) snrdb !SNR_2500 twopi=8.0*atan(1.0) @@ -50,27 +48,30 @@ program ft8sim 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) - phi=0.0 - c0=0. - k=-1 + nint(xdt/dt) - do j=1,NN !Generate 8-FSK waveform from itone - dphi=twopi*(f0+itone(j)*baud)*dt - if(k.eq.0) phi=-dphi - do i=1,NSPS - k=k+1 - phi=phi+dphi - if(phi.gt.twopi) phi=phi-twopi - xphi=phi - if(k.ge.0 .and. k.lt.NMAX) c0(k)=cmplx(cos(xphi),sin(xphi)) - enddo - enddo - + ! call sgran() + c=0. do ifile=1,nfiles - c=c0 - if( fspread .ne. 0.0 .or. delay .ne. 0.0 ) then - call watterson(c,NZ,fs,delay,fspread) - endif + + c0=0. + do isig=1,25 + f0=(isig+2)*100.0 + phi=0.0 + k=-1 + nint(xdt/dt) + do j=1,NN !Generate complex waveform + dphi=twopi*(f0+itone(j)*baud)*dt + if(k.eq.0) phi=-dphi + do i=1,NSPS + k=k+1 + phi=phi+dphi + if(phi.gt.twopi) phi=phi-twopi + xphi=phi + if(k.ge.0 .and. k.lt.NMAX) c0(k)=cmplx(cos(xphi),sin(xphi)) + enddo + enddo + if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,NZ,fs,delay,fspread) + c=c+c0 + enddo c=c*sig if(snrdb.lt.90) then do i=0,NZ-1 !Add gaussian noise at specified SNR diff --git a/lib/fsk4hf/sync8.f90 b/lib/fsk4hf/sync8.f90 index 8edadd467..39b966740 100644 --- a/lib/fsk4hf/sync8.f90 +++ b/lib/fsk4hf/sync8.f90 @@ -1,13 +1,18 @@ -subroutine sync8(iwave,xdt,f1,s) +subroutine sync8(iwave,s,candidate,ncand) include 'ft8_params.f90' - parameter (IZ=10,JZ=20) + parameter (JZ=20) complex cx(0:NH1) real s(NH1,NHSYM) real savg(NH1) real x(NFFT1) - real sync2d(-IZ:IZ,-JZ:JZ) + real sync2d(NH1,-JZ:JZ) + real red(NH1) + real candidate(3,100) integer*2 iwave(NMAX) + integer jpeak(NH1) + integer indx(NH1) + integer ii(1) integer icos7(0:6) data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern equivalence (x,cx) @@ -31,43 +36,56 @@ subroutine sync8(iwave,xdt,f1,s) savg=savg + s(1:NH1,j) enddo - ia=nint(30.0/df) - ib=nint(3000.0/df) + ia=nint(200.0/df) + ib=nint(4000.0/df) savg=savg/NHSYM - pmax=0. - i0=0 - do i=ia,ib - p=sum(savg(i-8:i+8))/17.0 - if(p.gt.pmax) then - pmax=p - i0=i-7 - endif - enddo - tmax=0. - ipk=0 - jpk=0 - j0=1 - do i=-IZ,IZ + do i=ia,ib do j=-JZ,JZ t=0. do n=0,6 - k=j0+j+2*n - if(k.ge.1) t=t + s(i0+i+2*icos7(n),k) - t=t + s(i0+i+2*icos7(n),k+72) - if(k+144.le.NHSYM) t=t + s(i0+i+2*icos7(n),k+144) + k=j+2*n + if(k.ge.1) t=t + s(i+2*icos7(n),k) + t=t + s(i+2*icos7(n),k+72) + if(k+144.le.NHSYM) t=t + s(i+2*icos7(n),k+144) enddo sync2d(i,j)=t - if(t.gt.tmax) then - tmax=t - jpk=j - ipk=i - endif enddo enddo - f0=i0*df - f1=(i0+ipk)*df - xdt=jpk*tstep + + 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) + enddo + iz=ib-ia+1 + call indexx(red(ia:ib),iz,indx) + ibase=indx(nint(0.40*iz)) - 1 + ia + base=red(ibase) + red=red/base + + candidate=0. + k=0 + do i=1,100 + n=ia + indx(iz+1-i) - 1 + if(red(n).lt.2.0) exit + do j=1,k !Eliminate near-dupe freqs + f=n*df + if(abs(f-candidate(1,j)).lt.3.0) go to 10 + enddo + k=k+1 + candidate(1,k)=n*df + candidate(2,k)=(jpeak(n)-1)*tstep + candidate(3,k)=red(n) +! write(*,3024) k,candidate(1:3,k) +!3024 format(i3,3f10.2) +10 continue + enddo + ncand=k + fac=20.0/maxval(s) + s=fac*s return end subroutine sync8 diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index b233c2664..caeda4d22 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -23,19 +23,31 @@ module ft8_decode contains - subroutine decode(this,callback,ss,id2,nfqso,newdat,npts8,nfa, & + subroutine decode(this,callback,ss,iwave,nfqso,newdat,npts8,nfa, & nfsplit,nfb,ntol,nzhsym,nagain,ndepth,nmode,nsubmode,nexp_decode) use timer_module, only: timer - include 'constants.f90' +! include 'constants.f90' + include 'fsk4hf/ft8_params.f90' + class(ft8_decoder), intent(inout) :: this procedure(ft8_decode_callback) :: callback - real ss(184,NSMAX) + real ss(1,1) !### dummy, to be removed ### + real s(NH1,NHSYM) + real candidate(3,100) logical, intent(in) :: newdat, nagain - integer*2 id2(NTMAX*12000) + integer*2 iwave(15*12000) + character*13 datetime - print*,'A',nfqso,npts8,nfa,nfsplit,nfb,ntol,nzhsym,ndepth - + datetime="000000_000000" !### TEMPORARY ### + + call sync8(iwave,s,candidate,ncand) + call ft8b(datetime,s,candidate,ncand) +! if (associated(this%callback)) then +! call this%callback(sync,nsnr,xdt,freq,ndrift,msg) +! end if + return end subroutine decode + end module ft8_decode diff --git a/mainwindow.cpp b/mainwindow.cpp index 75fea7ace..aaa9f6055 100644 --- a/mainwindow.cpp +++ b/mainwindow.cpp @@ -1911,6 +1911,8 @@ void MainWindow::setup_status_bar (bool vhf) mode_label.setStyleSheet ("QLabel{background-color: #99ff33}"); } else if ("MSK144" == m_mode) { mode_label.setStyleSheet ("QLabel{background-color: #ff6666}"); + } else if ("FT8" == m_mode) { + mode_label.setStyleSheet ("QLabel{background-color: #6699ff}"); } else if ("FreqCal" == m_mode) { mode_label.setStyleSheet ("QLabel{background-color: #ff9933}"); } last_tx_label.setText (QString {});