diff --git a/lib/fsk4hf/ft8b.f90 b/lib/fsk4hf/ft8b.f90 index 30ae86bb8..bcb21d1be 100644 --- a/lib/fsk4hf/ft8b.f90 +++ b/lib/fsk4hf/ft8b.f90 @@ -1,5 +1,6 @@ -subroutine ft8b(dd0,newdat,nfqso,ndepth,lapon,napwid,lsubtract,iaptype,icand, & - sync0,f1,xdt,apsym,nharderrors,dmin,nbadcrc,iap,ipass,iera,message,xsnr) +subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, & + lsubtract,iaptype,icand,sync0,f1,xdt,apsym,nharderrors,dmin, & + nbadcrc,ipass,iera,message,xsnr) use timer_module, only: timer include 'ft8_params.f90' @@ -14,16 +15,56 @@ subroutine ft8b(dd0,newdat,nfqso,ndepth,lapon,napwid,lsubtract,iaptype,icand, & real dd0(15*12000) integer*1 decoded(KK),apmask(3*ND),cw(3*ND) integer*1 msgbits(KK) - integer apsym(KK),rr73(11),cq(28) + integer apsym(KK) + integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16) integer itone(NN) integer icos7(0:6),ip(1) + integer nappasses(0:5) ! the number of decoding passes to use for each QSO state + integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now complex cd0(3200) complex ctwk(32) complex csymb(32) - logical newdat,lsubtract,lapon + logical first,newdat,lsubtract,lapon data icos7/2,5,6,0,4,1,3/ - data rr73/-1,1,1,1,1,1,1,-1,1,1,-1/ - data cq/1,1,1,1,1,-1,1,-1,-1,-1,-1,-1,1,-1,-1,-1,-1,-1,1,1,-1,-1,-1,1,1,-1,-1,1/ + 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 + 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 DE ??? ??? +! 3 MyCall ??? ??? +! 4 MyCall DxCall ??? +! 5 MyCall DxCall RRR +! 6 MyCall DxCall 73 +! 7 MyCall DxCall RR73 +! 8 ??? DxCall ??? + + naptypes(0,1:4)=(/1,3,0,0/) + naptypes(1,1:4)=(/3,4,0,0/) + naptypes(2,1:4)=(/3,4,0,0/) + naptypes(3,1:4)=(/4,5,6,7/) + naptypes(4,1:4)=(/4,5,6,7/) + naptypes(5,1:4)=(/4,1,3,0/) !? + first=.false. + endif max_iterations=30 nharderrors=-1 @@ -125,32 +166,38 @@ subroutine ft8b(dd0,newdat,nfqso,ndepth,lapon,napwid,lsubtract,iaptype,icand, & rxdatap(i4)=r4 rxdatap(i2)=r2 rxdatap(i1)=r1 + 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 -! rxdatap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1)) -! rxdatap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2)) -! else -! rxdatap(i2)=max(ps(6),ps(7))-max(ps(4),ps(5)) -! rxdatap(i1)=max(ps(5),ps(7))-max(ps(4),ps(6)) -! endif -! endif + if(j.eq.39) then ! take care of bits that live in symbol 39 + if(apsym(28).lt.0) then + rxdatap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1)) + rxdatap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2)) + else + rxdatap(i2)=max(ps(6),ps(7))-max(ps(4),ps(5)) + rxdatap(i1)=max(ps(5),ps(7))-max(ps(4),ps(6)) + endif + endif + endif + +! MyCall and DxCall are AP info ! 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) rxdatap(i4)=ps(4)-ps(0) - if(iii.eq.1) rxdatap(i4)=ps(5)-ps(1) - if(iii.eq.2) rxdatap(i4)=ps(6)-ps(2) - if(iii.eq.3) rxdatap(i4)=ps(7)-ps(3) - endif +! 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) rxdatap(i4)=ps(4)-ps(0) +! if(iii.eq.1) rxdatap(i4)=ps(5)-ps(1) +! if(iii.eq.2) rxdatap(i4)=ps(6)-ps(2) +! if(iii.eq.3) rxdatap(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 rxdatap(i4)=max(ps(5),ps(7))-max(ps(1),ps(3)) rxdatap(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. @@ -180,130 +227,127 @@ subroutine ft8b(dd0,newdat,nfqso,ndepth,lapon,napwid,lsubtract,iaptype,icand, & if(lapon.and.(iaptype.eq.1 .or. (iaptype.eq.2.and.abs(nfqso-f1).le.napwid))) nap=2 if(lapon.and.iaptype.eq.2.and.abs(nfqso-f1).gt.napwid) nap=1 - do iap=0,nap - nera=1 - if(iap.eq.0) nera=3 - do iera=1,nera - llr=llr0 - nblank=0 - if(nera.eq.3 .and. iera.eq.1) nblank=0 - if(nera.eq.3 .and. iera.eq.2) nblank=24 - if(nera.eq.3 .and. iera.eq.3) nblank=48 - if(nblank.gt.0) llr(1:nblank)=0. - if(iap.eq.0) then - apmask=0 -! apmask(160:162)=1 - llrap=llr -! llrap(160:162)=apmag*apsym(73:75)/ss - endif - if(iaptype.eq.1) then - if(iap.eq.1) then ! look for plain CQ - apmask=0 - apmask(88:115)=1 ! plain CQ - apmask(144)=1 ! not free text -! apmask(160:162)=1 ! 3 extra bits - llrap=llr - llrap(88:115)=apmag*cq/ss - llrap(116:117)=llra(116:117) - llrap(142:143)=llra(142:143) - llrap(144)=-apmag/ss -! llrap(160:162)=apmag*apsym(73:75)/ss - endif - if(iap.eq.2) then ! look for mycall - apmask=0 - apmask(88:115)=1 ! mycall - apmask(144)=1 ! not free text -! apmask(160:162)=1 ! 3 extra bits - llrap=llr - llrap(88:115)=apmag*apsym(1:28)/ss - llrap(116:117)=llra(116:117) - llrap(142:143)=llra(142:143) - llrap(144)=-apmag/ss -! llrap(160:162)=apmag*apsym(73:75)/ss - endif - endif - if(iaptype.eq.2) then - if(iap.eq.1) then ! look for dxcall - apmask=0 -! apmask(88:115)=1 ! mycall - apmask(116:143)=1 ! hiscall - apmask(144)=1 ! not free text -! apmask(160:162)=1 ! 3 extra bits - llrap=llr -! llrap(88:143)=apmag*apsym(1:56)/ss - llrap(115)=llra(115) - llrap(116:143)=apmag*apsym(29:56)/ss - llrap(144)=-apmag/ss -! llrap(160:162)=apmag*apsym(73:75)/ss - endif - if(iap.eq.2) then ! look mycall, dxcall - apmask=0 - apmask(88:115)=1 ! mycall - apmask(116:143)=1 ! hiscall - apmask(144)=1 ! not free text -! apmask(144:154)=1 ! RRR or 73 -! apmask(160:162)=1 ! 3 extra bits - llrap=llr - llrap(88:143)=apmag*apsym(1:56)/ss - llrap(144)=-apmag/ss -! llrap(144:154)=apmag*rr73/ss -! llrap(155:156)=llra(155:156) -! llrap(160:162)=apmag*apsym(73:75)/ss - endif - endif +! 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. - 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 - norder=1 - if(abs(nfqso-f1).le.napwid) then - if(iap.eq.0) then - norder=2 - else - norder=3 - endif - endif - call timer('osd174 ',0) - call osd174(llrap,apmask,norder,decoded,cw,nharderrors,dmin) - call timer('osd174 ',1) + npasses=1+2+nappasses(nQSOProgress) + do ipass=1,npasses + + llr=llr0 + if(ipass.ne.2 .and. ipass.ne.3) nblank=0 + if(ipass.eq.2) nblank=24 + if(ipass.eq.3) nblank=48 + if(nblank.gt.0) llr(1:nblank)=0. + + if(ipass.le.3) then + apmask=0 + llrap=llr + iaptype=0 + endif + + if(ipass .gt. 3) then + iaptype=naptypes(nQSOProgress,ipass-3) + if(iaptype.eq.1 .or. iaptype.eq.2 .or. iaptype.eq.3) 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/ss + if(iaptype.eq.2) llrap(88:115)=apmag*mde/ss + if(iaptype.eq.3) llrap(88:115)=apmag*apsym(1:28)/ss + llrap(116:117)=llra(116:117) + llrap(142:143)=llra(142:143) + llrap(144)=-apmag/ss endif - nbadcrc=1 - message=' ' - xsnr=-99.0 - if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword - if(any(decoded(75:75).ne.0)) cycle !Reject if any of the 3 extra bits are nonzero - if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. & - .not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. & - .not.(iap.gt.0 .and. nharderrors.gt.39) .and. & - .not.(iera.ge.2 .and. nharderrors.gt.30) & - ) then - call chkcrc12a(decoded,nbadcrc) - else - nharderrors=-1 - cycle + if(iaptype.eq.4) 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)/ss + llrap(144)=-apmag/ss endif - if(nbadcrc.eq.0) then - call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent) - call genft8(message,msgsent,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 - if(xsnr .lt. -24.0) xsnr=-24.0 - return + if(iaptype.eq.5 .or. iaptype.eq.6 .or. iaptype.eq.7) 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)/ss + if(iaptype.eq.5) llrap(144:159)=apmag*mrrr/ss + if(iaptype.eq.6) llrap(144:159)=apmag*m73/ss + if(iaptype.eq.7) llrap(144:159)=apmag*mrr73/ss endif - enddo + if(iaptype.eq.8) 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)/ss + llrap(144)=-apmag/ss + 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 + norder=1 + if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid) then + if(ipass.le.3) then + norder=2 + else ! norder=3 for AP decodes because a smaller number of codewords needs to be looked at + norder=3 + endif + endif + call timer('osd174 ',0) + call osd174(llrap,apmask,norder,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(any(decoded(75:75).ne.0)) cycle !Reject if any of the 3 extra bits are nonzero + if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. & + .not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. & + .not.(ipass.gt.1 .and. nharderrors.gt.39) .and. & + .not.(ipass.eq.3 .and. nharderrors.gt.30) & + ) then + call chkcrc12a(decoded,nbadcrc) + else + nharderrors=-1 + cycle + endif + if(nbadcrc.eq.0) then + call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent) + call genft8(message,msgsent,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 + if(xsnr .lt. -24.0) xsnr=-24.0 + return + endif enddo return diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index eba4d88ee..de3dad5ba 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -83,8 +83,9 @@ contains xdt=candidate(2,icand) nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ### call timer('ft8b ',0) - call ft8b(dd,newdat,nfqso,ndepth,lapon,napwid,lsubtract,iaptype,icand,sync,f1, & - xdt,apsym,nharderrors,dmin,nbadcrc,iap,ipass,iera,message,xsnr) + call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,napwid, & + lsubtract,iaptype,icand,sync,f1,xdt,apsym,nharderrors,dmin, & + nbadcrc,iappass,iera,message,xsnr) nsnr=nint(xsnr) xdt=xdt-0.5 hd=nharderrors+dmin @@ -102,25 +103,19 @@ contains allmessages(ndecodes)=message allsnrs(ndecodes)=nsnr endif -! write(81,1004) nutc,ncand,icand,ipass,iaptype,iap,iera, & -! iflag,nharderrors,dmin,hd,min(sync,999.0),nint(xsnr), & -! xdt,nint(f1),message -! flush(81) - if(.not.ldupe .and. associated(this%callback)) then -! nap: 0=no ap, 1=CQ; 2=MyCall; 3=DxCall; 4=MyCall,DxCall - if(iap.eq.0) then - nap=0 - else - nap=(iaptype-1)*2+iap - endif - qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0] - call this%callback(sync,nsnr,xdt,f1,message,nap,qual) - endif - else - write(19,1004) nutc,ncand,icand,ipass,iaptype,iap,iera, & + write(81,1004) nutc,ncand,icand,ipass,iaptype,iappass, & iflag,nharderrors,dmin,hd,min(sync,999.0),nint(xsnr), & xdt,nint(f1),message -1004 format(i6.6,2i4,4i2,2i3,3f6.1,i4,f6.2,i5,2x,a22) + flush(81) + if(.not.ldupe .and. associated(this%callback)) then + qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0] + call this%callback(sync,nsnr,xdt,f1,message,iaptype,qual) + endif + else + write(19,1004) nutc,ncand,icand,ipass,iaptype,iappass, & + iflag,nharderrors,dmin,hd,min(sync,999.0),nint(xsnr), & + xdt,nint(f1),message +1004 format(i6.6,2i4,3i2,2i3,3f6.1,i4,f6.2,i5,2x,a22) flush(19) endif endif