diff --git a/CMakeLists.txt b/CMakeLists.txt index a2c46a685..c48973fd7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -448,9 +448,7 @@ set (wsjt_FSRCS lib/fqso_first.f90 lib/freqcal.f90 lib/ft8/ft8apset.f90 - lib/ft8/ft8apset_174_91.f90 - lib/ft8/ft8b_1.f90 - lib/ft8/ft8b_2.f90 + lib/ft8/ft8b.f90 lib/ft8/ft8code.f90 lib/ft8/ft8_downsample.f90 lib/ft8/ft8sim.f90 @@ -459,7 +457,6 @@ set (wsjt_FSRCS lib/gen9.f90 lib/geniscat.f90 lib/ft8/genft8.f90 - lib/ft8/genft8_174_91.f90 lib/genmsk_128_90.f90 lib/genmsk40.f90 lib/genqra64.f90 diff --git a/lib/ft8/foxgen.f90 b/lib/ft8/foxgen.f90 index 853eabc1a..806b20648 100644 --- a/lib/ft8/foxgen.f90 +++ b/lib/ft8/foxgen.f90 @@ -39,10 +39,7 @@ subroutine foxgen() do n=1,nslots msg=cmsg(n)(1:37) - call genft8_174_91(msg,i3,n3,msgsent,msgbits,itone) -! print*,'Foxgen:',n,msg,msgsent,i3,n3 -! write(*,'(77i1)') msgbits - + call genft8(msg,i3,n3,msgsent,msgbits,itone) ! Make copies of itone() and msgbits() for ft8sim itone2=itone msgbits2=msgbits diff --git a/lib/ft8/ft8apset.f90 b/lib/ft8/ft8apset.f90 index 00cc55f5d..178c61161 100644 --- a/lib/ft8/ft8apset.f90 +++ b/lib/ft8/ft8apset.f90 @@ -1,22 +1,44 @@ subroutine ft8apset(mycall12,hiscall12,apsym) - parameter(NAPM=4,KK=87) - character*12 mycall12,hiscall12 - character*37 msg,msgsent - character*6 mycall,hiscall - character*6 hisgrid6 - character*4 hisgrid - integer apsym(75) + use packjt77 + character*77 c77 + character*37 msg + character*12 mycall12,hiscall12,hiscall + integer apsym(58) integer*1 msgbits(77) - integer itone(79) - - mycall=mycall12(1:6) - hiscall=hiscall12(1:6) - if(len(trim(hiscall)).eq.0) hiscall="K9ABC" - msg=mycall//' '//hiscall//' RRR' - i3=0 - n3=0 - isync=1 - call genft8(msg,i3,n3,isync,msgsent,msgbits,itone) - apsym=2*msgbits(1:75)-1 + logical nohiscall + + if(len(trim(mycall12)).eq.0) then + apsym=0 + apsym(1)=99 + apsym(30)=99 + return + endif + + nohiscall=.false. + hiscall=hiscall12 + if(len(trim(hiscall)).eq.0) then + hiscall="K9ABC" + nohiscall=.true. + endif + +! Encode a dummy standard message: i3=1, 28 1 28 1 1 15 +! + msg=trim(mycall12)//' '//trim(hiscall)//' RRR' + call pack77(msg,i3,n3,c77) + if(i3.ne.1) then + apsym=0 + apsym(1)=99 + apsym(30)=99 + return + + endif + + read(c77,'(58i1)',err=1) apsym(1:58) + if(nohiscall) apsym(30)=99 + return + +1 apsym=0 + apsym(1)=99 + apsym(30)=99 return end subroutine ft8apset diff --git a/lib/ft8/ft8apset_174_91.f90 b/lib/ft8/ft8apset_174_91.f90 deleted file mode 100644 index d979aeac1..000000000 --- a/lib/ft8/ft8apset_174_91.f90 +++ /dev/null @@ -1,43 +0,0 @@ -subroutine ft8apset_174_91(mycall12,hiscall12,apsym) - use packjt77 - character*77 c77 - character*37 msg - character*12 mycall12,hiscall12,hiscall - integer apsym(58) - integer*1 msgbits(77) - logical nohiscall - - if(len(trim(mycall12)).eq.0) then - apsym=0 - apsym(1)=99 - apsym(30)=99 - return - endif - - nohiscall=.false. - hiscall=hiscall12 - if(len(trim(hiscall)).eq.0) then - hiscall="K9ABC" - nohiscall=.true. - endif - -! Encode a dummy standard message: i3=1, 28 1 28 1 1 15 -! - msg=trim(mycall12)//' '//trim(hiscall)//' RRR' - call pack77(msg,i3,n3,c77) - if(i3.ne.1) then - apsym=0 - apsym(1)=99 - apsym(30)=99 - return - endif - - read(c77,'(58i1)',err=1) apsym(1:58) - if(nohiscall) apsym(30)=99 - return - -1 apsym=0 - apsym(1)=99 - apsym(30)=99 - return -end subroutine ft8apset_174_91 diff --git a/lib/ft8/ft8b_2.f90 b/lib/ft8/ft8b.f90 similarity index 91% rename from lib/ft8/ft8b_2.f90 rename to lib/ft8/ft8b.f90 index 9cb4560a9..68d148c65 100644 --- a/lib/ft8/ft8b_2.f90 +++ b/lib/ft8/ft8b.f90 @@ -1,4 +1,4 @@ -subroutine ft8b_2(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) @@ -116,7 +116,7 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & 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,2,sync) + call sync8d(cd0,idt,ctwk,0,sync) if(sync.gt.smax) then smax=sync ibest=idt @@ -135,7 +135,7 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & ctwk(i)=cmplx(cos(phi),sin(phi)) phi=mod(phi+dphi,twopi) enddo - call sync8d(cd0,i0,ctwk,1,2,sync) + call sync8d(cd0,i0,ctwk,1,sync) if( sync .gt. smax ) then smax=sync delfbest=delf @@ -146,7 +146,7 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & call twkfreq1(cd0,NP2,fs2,a,cd0) xdt=xdt2 f1=f1+delfbest !Improved estimate of DF - call sync8d(cd0,i0,ctwk,0,2,sync) + call sync8d(cd0,i0,ctwk,0,sync) do k=1,NN i1=ibest+(k-1)*32 @@ -445,22 +445,43 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & return enddo return -end subroutine ft8b_2 +end subroutine ft8b -! This currently resides in ft8b_1.f90 -!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 +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/ft8b_1.f90 b/lib/ft8/ft8b_1.f90 deleted file mode 100644 index b35fa8a26..000000000 --- a/lib/ft8/ft8b_1.f90 +++ /dev/null @@ -1,484 +0,0 @@ -subroutine ft8b_1(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, & - napwid,lsubtract,nagain,iaptype,mycall12,hiscall12, & - 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,msgsent37 - character message*22,msgsent*22 - character*12 mycall12,hiscall12 - character*6 mycall6,hiscall6,c1,c2 - character*87 cbits - 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(15*12000) - integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND) - integer*1 msgbits(KK) - integer apsym(75) - 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(32) - complex csymb(32) - logical first,newdat,lsubtract,lapon,lapcqonly,nagain - equivalence (s1,s1sort) - data icos7/2,5,6,0,4,1,3/ - 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,1,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,32 - ctwk(i)=cmplx(cos(phi),sin(phi)) - phi=mod(phi+dphi,twopi) - enddo - call sync8d(cd0,i0,ctwk,1,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,1,sync) - - j=0 - do k=1,NN - i1=ibest+(k-1)*32 - csymb=cmplx(0.0,0.0) - if( i1.ge.0 .and. i1+31 .le. NP2-1 ) csymb=cd0(i1:i1+31) - call four2a(csymb,32,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 - nbadcrc=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) - iFreeText=decoded(57) - if(nbadcrc.eq.0) then - decoded0=decoded - if(i3bit.eq.1) decoded(57:)=0 - call extractmessage174(decoded,message,ncrcflag) - decoded=decoded0 -! This needs fixing for messages with i3bit=1: - i3=0 !TEMPORARY - n3=0 - isync=1 - msg37=' ' - msg37(1:22)=message - call genft8(msg37,i3,n3,isync,msgsent37,msgbits,itone) - if(lsubtract) call subtractft8(dd0,itone,f1,xdt2) - xsig=0.0 - xnoi=0.0 - do i=1,79 - 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=xsnr2 - if(xsnr .lt. -24.0) xsnr=-24.0 - - if(i3bit.eq.1) then - do i=1,12 - i1hiscall(i)=ichar(hiscall12(i:i)) - enddo - icrc10=crc10(c_loc(i1hiscall),12) - 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)//' ' - - if(ncrc10.eq.icrc10) msg37=c1//' RR73; '//c2//' <'// & - trim(hiscall12)//'> ' - if(ncrc10.ne.icrc10) msg37=c1//' RR73; '//c2//' <...> ' - -! msg37=c1//' RR73; '//c2//' <...> ' - write(msg37(35:37),1010) irpt -1010 format(i3.2) - if(msg37(35:35).ne.'-') msg37(35:35)='+' - - iz=len(trim(msg37)) - do iter=1,10 !Collapse multiple blanks - ib2=index(msg37(1:iz),' ') - if(ib2.lt.1) exit - msg37=msg37(1:ib2)//msg37(ib2+2:) - iz=iz-1 - enddo - else - msg37=message//' ' - endif - - return - endif - enddo - - return -end subroutine ft8b_1 - -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 index 2aed02bf2..c20aaaa38 100644 --- a/lib/ft8/ft8code.f90 +++ b/lib/ft8/ft8code.f90 @@ -47,7 +47,7 @@ program ft8code ! Generate msgsent, msgbits, and itone i3=-1 n3=-1 - call genft8_174_91(msg,i3,n3,msgsent,msgbits,itone) + call genft8(msg,i3,n3,msgsent,msgbits,itone) msgtype="" if(i3.eq.0) then if(n3.eq.0) msgtype="Free text" diff --git a/lib/ft8/ft8sim.f90 b/lib/ft8/ft8sim.f90 index 80f98fcfb..a1de4061f 100644 --- a/lib/ft8/ft8sim.f90 +++ b/lib/ft8/ft8sim.f90 @@ -66,7 +66,7 @@ program ft8sim i3=-1 n3=-1 call pack77(msg37,i3,n3,c77) - call genft8_174_91(msg37,i3,n3,msgsent37,msgbits,itone) + call genft8(msg37,i3,n3,msgsent37,msgbits,itone) write(*,*) write(*,'(a23,a37,3x,a7,i1,a1,i1)') 'New Style FT8 Message: ',msgsent37,'i3.n3: ',i3,'.',n3 diff --git a/lib/ft8/genft8.f90 b/lib/ft8/genft8.f90 index 30af71787..3c6a5cee7 100644 --- a/lib/ft8/genft8.f90 +++ b/lib/ft8/genft8.f90 @@ -1,46 +1,31 @@ -subroutine genft8(msg37,i3,n3,isync,msgsent37,msgbits77,itone) +subroutine genft8(msg,i3,n3,msgsent,msgbits,itone) ! Encode an FT8 message, producing array itone(). - use crc - use packjt + use packjt77 include 'ft8_params.f90' - character*22 msg,msgsent - character*37 msg37,msgsent37 - character*87 cbits - logical checksumok - integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words - integer*1 msgbits(KK),codeword(3*ND) - integer*1 msgbits77(77) - integer*1, target:: i1Msg8BitBytes(11) - integer itone(NN) + character msg*37,msgsent*37 + character*77 c77 + integer*1 msgbits(77),codeword(174) + integer itone(79) integer icos7(0:6) - data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern + integer graymap(0:7) + logical unpk77_success + data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern + data graymap/0,1,3,2,5,6,4,7/ - if(isync.eq.2 ) goto 900 - - msg=msg37(1:22) - call packmsg(msg,i4Msg6BitWords,istdtype) !Pack into 12 6-bit bytes - call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent - msgsent37(1:22)=msgsent - msgsent37(23:37)=' ' + i3=-1 + n3=-1 + call pack77(msg,i3,n3,c77) + call unpack77(c77,msgsent,unpk77_success) + read(c77,'(77i1)',err=1) msgbits + go to 2 +1 write(81,*) msg,c77 ; flush(81) - write(cbits,1000) i4Msg6BitWords,32*i3 -1000 format(12b6.6,b8.8) - read(cbits,1001) i1Msg8BitBytes(1:10) -1001 format(10b8) - i1Msg8BitBytes(10)=iand(i1Msg8BitBytes(10),128+64+32) - i1Msg8BitBytes(11)=0 - icrc12=crc12(c_loc(i1Msg8BitBytes),11) +entry get_tones_from_77bits(msgbits,itone) - write(cbits,1003) i4Msg6BitWords,i3,icrc12 -1003 format(12b6.6,b3.3,b12.12) - read(cbits,1004) msgbits -1004 format(87i1) +2 call encode174_91(msgbits,codeword) !Encode the test message - call encode174(msgbits,codeword) !Encode the test message - msgbits77=-1 - msgbits77(1:75)=msgbits(1:75) ! Message structure: S7 D29 S7 D29 S7 itone(1:7)=icos7 itone(36+1:36+7)=icos7 @@ -50,13 +35,9 @@ subroutine genft8(msg37,i3,n3,isync,msgsent37,msgbits77,itone) i=3*j -2 k=k+1 if(j.eq.30) k=k+7 - itone(k)=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2) + indx=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2) + itone(k)=graymap(indx) enddo - return - -900 continue - - call genft8_174_91(msg37,i3,n3,msgsent37,msgbits77,itone) return end subroutine genft8 diff --git a/lib/ft8/genft8_174_91.f90 b/lib/ft8/genft8_174_91.f90 deleted file mode 100644 index 97297efab..000000000 --- a/lib/ft8/genft8_174_91.f90 +++ /dev/null @@ -1,43 +0,0 @@ -subroutine genft8_174_91(msg,i3,n3,msgsent,msgbits,itone) - -! Encode an FT8 message, producing array itone(). - - use packjt77 - include 'ft8_params.f90' - character msg*37,msgsent*37 - character*77 c77 - integer*1 msgbits(77),codeword(174) - integer itone(79) - integer icos7(0:6) - integer graymap(0:7) - logical unpk77_success - data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern - data graymap/0,1,3,2,5,6,4,7/ - - i3=-1 - n3=-1 - call pack77(msg,i3,n3,c77) - call unpack77(c77,msgsent,unpk77_success) - read(c77,'(77i1)',err=1) msgbits - go to 2 -1 write(81,*) msg,c77 ; flush(81) - -entry get_tones_from_77bits(msgbits,itone) - -2 call encode174_91(msgbits,codeword) !Encode the test message - -! Message structure: S7 D29 S7 D29 S7 - itone(1:7)=icos7 - itone(36+1:36+7)=icos7 - itone(NN-6:NN)=icos7 - k=7 - do j=1,ND - i=3*j -2 - k=k+1 - if(j.eq.30) k=k+7 - indx=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2) - itone(k)=graymap(indx) - enddo - - return -end subroutine genft8_174_91 diff --git a/lib/ft8/sync8.f90 b/lib/ft8/sync8.f90 index c4d3d3efa..50817a93c 100644 --- a/lib/ft8/sync8.f90 +++ b/lib/ft8/sync8.f90 @@ -1,4 +1,5 @@ -subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sbase) +subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate, & + ncand,sbase) include 'ft8_params.f90' ! Search over +/- 2.5s relative to 0.5s TX start time. @@ -11,15 +12,14 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb real x(NFFT1) real sync2d(NH1,-JZ:JZ) real red(NH1) - real candidate0(4,maxcand) - real candidate(4,maxcand) + real candidate0(3,maxcand) + real candidate(3,maxcand) real dd(NMAX) integer jpeak(NH1) integer indx(NH1) integer ii(1) - integer icos7_1(0:6),icos7_2(0:6),icos7(0:6) - data icos7_1/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern - data icos7_2/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern + integer icos7(0:6) + data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern equivalence (x,cx) ! Compute symbol spectra, stepping by NSTEP steps. @@ -49,13 +49,8 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb candidate0=0. k=0 - is1=1 - if(ldecode77) is1=2 - do isync=is1,2 - if(isync.eq.1) icos7=icos7_1 - if(isync.eq.2) icos7=icos7_2 - do i=ia,ib - do j=-JZ,+JZ + do i=ia,ib + do j=-JZ,+JZ ta=0. tb=0. tc=0. @@ -79,42 +74,37 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb 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 + 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 + 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 + if(ibase.lt.1) ibase=1 + if(ibase.gt.nh1) ibase=nh1 + base=red(ibase) + red=red/base - do i=1,min(maxcand,iz) - n=ia + indx(iz+1-i) - 1 - if(red(n).lt.syncmin.or.isnan(red(n)).or.k.eq.maxcand) exit - k=k+1 - candidate0(1,k)=n*df - candidate0(2,k)=(jpeak(n)-1)*tstep - candidate0(3,k)=red(n) - candidate0(4,k)=isync - enddo - enddo ! isync loop + do i=1,min(maxcand,iz) + n=ia + indx(iz+1-i) - 1 + if(red(n).lt.syncmin.or.isnan(red(n)).or.k.eq.maxcand) 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. @@ -144,10 +134,7 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb 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) - candidate(4,k)=candidate0(4,j) + candidate(1:3,k)=abs(candidate0(1:3,j)) k=k+1 endif enddo diff --git a/lib/ft8/sync8d.f90 b/lib/ft8/sync8d.f90 index 1fad12b4d..798f2831b 100644 --- a/lib/ft8/sync8d.f90 +++ b/lib/ft8/sync8d.f90 @@ -1,20 +1,18 @@ -subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync) +subroutine sync8d(cd0,i0,ctwk,itwk,sync) ! Compute sync power for a complex, downsampled FT8 signal. -! itype specifies which Costas array to use parameter(NP2=2812,NDOWN=60) complex cd0(0:3199) - complex csync_1(0:6,32),csync_2(0:6,32) + complex csync(0:6,32) complex csync2(32) complex ctwk(32) complex z1,z2,z3 logical first - integer icos7_1(0:6),icos7_2(0:6) - data icos7_1/2,5,6,0,4,1,3/ - data icos7_2/3,1,4,0,6,5,2/ + integer icos7(0:6) + data icos7/3,1,4,0,6,5,2/ data first/.true./ - save first,twopi,fs2,dt2,taus,baud,csync_1,csync_2 + save first,twopi,fs2,dt2,taus,baud,csync p(z1)=real(z1)**2 + aimag(z1)**2 !Statement function for power @@ -26,15 +24,11 @@ subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync) taus=32*dt2 !Symbol duration baud=1.0/taus !Keying rate do i=0,6 - phi1=0.0 - phi2=0.0 - dphi1=twopi*icos7_1(i)*baud*dt2 - dphi2=twopi*icos7_2(i)*baud*dt2 + phi=0.0 + dphi=twopi*icos7(i)*baud*dt2 do j=1,32 - csync_1(i,j)=cmplx(cos(phi1),sin(phi1)) !Waveform for 7x7 Costas array - csync_2(i,j)=cmplx(cos(phi2),sin(phi2)) !Waveform for 7x7 Costas array - phi1=mod(phi1+dphi1,twopi) - phi2=mod(phi2+dphi2,twopi) + csync(i,j)=cmplx(cos(phi),sin(phi)) !Waveform for 7x7 Costas array + phi=mod(phi+dphi,twopi) enddo enddo first=.false. @@ -45,11 +39,7 @@ subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync) i1=i0+i*32 !three Costas arrays i2=i1+36*32 i3=i1+72*32 - if(itype.eq.1) then - csync2=csync_1(i,1:32) - else - csync2=csync_2(i,1:32) - endif + csync2=csync(i,1:32) if(itwk.eq.1) csync2=ctwk*csync2 !Tweak the frequency z1=0. z2=0. diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index 7c40c904c..4d2a7152d 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -45,7 +45,7 @@ contains parameter (MAXCAND=300) real s(NH1,NHSYM) real sbase(NH1) - real candidate(4,MAXCAND) + real candidate(3,MAXCAND) real dd(15*12000) logical, intent(in) :: lft8apon,lapcqonly,ldecode77,nagain logical newdat,lsubtract,ldupe @@ -69,8 +69,7 @@ contains write(datetime,1001) nutc !### TEMPORARY ### 1001 format("000000_",i6.6) - call ft8apset(mycall12,hiscall12,apsym1) - call ft8apset_174_91(mycall12,hiscall12,apsym2) + call ft8apset(mycall12,hiscall12,apsym2) dd=iwave ndecodes=0 allmessages=' ' @@ -104,32 +103,24 @@ contains endif call timer('sync8 ',0) maxc=MAXCAND - call sync8(dd,ifa,ifb,syncmin,nfqso,ldecode77,maxc,s,candidate,ncand,sbase) + call sync8(dd,ifa,ifb,syncmin,nfqso,ldecode77,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) - isync=candidate(4,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) - if(isync.eq.1) then - call ft8b_1(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, & - lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12, & - hiscall12,sync,f1,xdt,xbase,apsym1,nharderrors,dmin, & - nbadcrc,iappass,iera,msg37,xsnr) - else - call ft8b_2(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) - endif -! message=msg37(1:22) !### + 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 - call timer('ft8b ',1) if(nbadcrc.eq.0) then ldupe=.false. do id=1,ndecodes @@ -142,8 +133,8 @@ contains endif ! write(81,1004) nutc,ncand,icand,ipass,iaptype,iappass, & ! nharderrors,dmin,hd,min(sync,999.0),nint(xsnr), & -! xdt,nint(f1),msg37,isync -!1004 format(i6.6,2i4,3i2,i3,3f6.1,i4,f6.2,i5,2x,a37,i4) +! xdt,nint(f1),msg37 +!1004 format(i6.6,2i4,3i2,i3,3f6.1,i4,f6.2,i5,2x,a37) ! flush(81) if(.not.ldupe .and. associated(this%callback)) then qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0] diff --git a/mainwindow.cpp b/mainwindow.cpp index 63d651bd0..c7bde04ff 100644 --- a/mainwindow.cpp +++ b/mainwindow.cpp @@ -81,8 +81,8 @@ extern "C" { fortran_charlen_t, fortran_charlen_t, fortran_charlen_t, fortran_charlen_t, fortran_charlen_t); - void genft8_(char* msg, int* i3, int* n3, int* isync, char* msgsent, - char ft8msgbits[], int itone[], fortran_charlen_t, fortran_charlen_t); + void genft8_(char* msg, int* i3, int* n3, char* msgsent, char ft8msgbits[], + int itone[], fortran_charlen_t, fortran_charlen_t); void gen4_(char* msg, int* ichk, char* msgsent, int itone[], int* itext, fortran_charlen_t, fortran_charlen_t); @@ -3560,11 +3560,11 @@ void MainWindow::guiUpdate() if(SpecOp::FOX==m_config.special_op_id() and ui->tabWidget->currentIndex()==2) { foxTxSequencer(); } else { - m_isync=2; - m_i3=0; + int i3=0; + int n3=0; char ft8msgbits[77]; - genft8_(message, &m_i3, &m_n3, &m_isync, msgsent, - const_cast (ft8msgbits), const_cast (itone), 37, 37); + genft8_(message, &i3, &n3, msgsent, const_cast (ft8msgbits), + const_cast (itone), 37, 37); if(SpecOp::FOX == m_config.special_op_id()) { //Fox must generate the full Tx waveform, not just an itone[] array. QString fm = QString::fromStdString(message).trimmed(); @@ -3591,8 +3591,7 @@ void MainWindow::guiUpdate() } } } - if(m_isync==1) msgsent[22]=0; - if(m_isync==2) msgsent[37]=0; + msgsent[37]=0; } } diff --git a/mainwindow.h b/mainwindow.h index 856a1ff6a..9dce607ec 100644 --- a/mainwindow.h +++ b/mainwindow.h @@ -430,9 +430,6 @@ private: qint32 m_nTx73; qint32 m_UTCdisk; qint32 m_wait; - qint32 m_i3; - qint32 m_n3; - qint32 m_isync; qint32 m_isort; qint32 m_max_dB; qint32 m_nDXped=0;