From 9b6dd092c5b6e85bea3e2991b66e1e42bff9e402 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 5 May 2020 11:59:43 -0500 Subject: [PATCH] Streamline decoding to use a single call to decode174_91. --- lib/fsk4hf/ldpcsim174_91.f90 | 14 +- lib/ft4_decode.f90 | 30 ++-- lib/ft8/decode174_91.f90 | 256 +++++++++++++++++++---------------- lib/ft8/ft8b.f90 | 35 ++--- 4 files changed, 167 insertions(+), 168 deletions(-) diff --git a/lib/fsk4hf/ldpcsim174_91.f90 b/lib/fsk4hf/ldpcsim174_91.f90 index d57cf8bd1..994b7837d 100644 --- a/lib/fsk4hf/ldpcsim174_91.f90 +++ b/lib/fsk4hf/ldpcsim174_91.f90 @@ -105,19 +105,9 @@ program ldpcsim174_91 llr(1:nap)=5*(2.0*msgbits(1:nap)-1.0) apmask=0 apmask(1:nap)=1 -! max_iterations is max number of belief propagation iterations - call bpdecode174_91(llr, apmask, max_iterations, message77, cw, nhardbp,niterations,ncheck) - if( ndepth .ge. 0 .and. nhardbp .lt. 0 ) then - dmin=0.0 - if(nbposd.eq.0) then - call osd174_91(llr,Keff,apmask,ndepth,message91,cw,nhardosd,dmin) - elseif(nbposd.gt.0) then - maxsuper=nbposd - call decode174_91(llr,Keff,ndepth,apmask,maxsuper,message91,cw,nhardosd,niterations,ncheck,dmin) - endif + call decode174_91(llr,Keff,nbposd,ndepth,apmask,message91,cw,ntype,nharderrors,dmin) ! If the decoder finds a valid codeword, nharderrors will be .ge. 0. - endif - if( nhardbp .ge. 0 .or. nhardosd.ge.0 ) then + if( nharderrors.ge.0 ) then nhw=count(cw.ne.codeword) if(nhw.eq.0) then ! this is a good decode ngood=ngood+1 diff --git a/lib/ft4_decode.f90 b/lib/ft4_decode.f90 index 4a008b333..865377c09 100644 --- a/lib/ft4_decode.f90 +++ b/lib/ft4_decode.f90 @@ -407,27 +407,19 @@ contains endif message77=0 dmin=0.0 - call timer('bpdec174',0) - call bpdecode174_91(llr,apmask,max_iterations,message77, & - cw,nharderror,niterations,ncheck) - call timer('bpdec174',1) - if(doosd .and. nharderror.lt.0) then -! ndeep=3 - ndeep=2 - if(abs(nfqso-f1).le.napwid) then -! ndeep=4 - ndeep=3 - endif - call timer('osd174_91 ',0) - Keff=91 - maxsuper=1 -! call osd174_91(llr,Keff,apmask,ndeep,message91,cw,nharderror,dmin) - call decode174_91(llr,Keff,ndeep,apmask,maxsuper,message91,cw,nharderror, & - niterations,ncheck,dmin) - message77=message91(1:77) - call timer('osd174_91 ',1) + ndeep=2 + maxosd=1 + if(abs(nfqso-f1).le.napwid) then + maxosd=2 endif + if(.not.doosd) maxosd = -1 + call timer('dec174_91 ',0) + Keff=91 + call decode174_91(llr,Keff,maxosd,ndeep,apmask,message91,cw, & + ntype,nharderror,dmin) + message77=message91(1:77) + call timer('dec174_91 ',1) if(sum(message77).eq.0) cycle if( nharderror.ge.0 ) then diff --git a/lib/ft8/decode174_91.f90 b/lib/ft8/decode174_91.f90 index 161306830..6cc4ae807 100644 --- a/lib/ft8/decode174_91.f90 +++ b/lib/ft8/decode174_91.f90 @@ -1,133 +1,155 @@ -subroutine decode174_91(llr,Keff,ndeep,apmask,maxsuper,message91,cw,nharderror,iter,ncheck,dmin) +subroutine decode174_91(llr,Keff,maxosd,norder,apmask,message91,cw,ntype,nharderror,dmin) ! ! A hybrid bp/osd decoder for the (174,91) code. ! -integer, parameter:: N=174, K=91, M=N-K -integer*1 cw(N),apmask(N) -integer*1 nxor(N),hdec(N) -integer*1 message91(91),m96(96) -integer nrw(M),ncw -integer Nm(7,M) -integer Mn(3,N) ! 3 checks per bit -integer synd(M) -real tov(3,N) -real toc(7,M) -real tanhtoc(7,M) -real zn(N),zsum(N) -real llr(N) -real Tmn +! maxosd<0: do bp only +! maxosd=0: do bp and then call osd once with channel llrs +! maxosd>1: do bp and then call osd maxosd times with saved bp outputs +! norder : osd decoding depth +! + integer, parameter:: N=174, K=91, M=N-K + integer*1 cw(N),apmask(N) + integer*1 nxor(N),hdec(N) + integer*1 message91(91),m96(96) + integer nrw(M),ncw + integer Nm(7,M) + integer Mn(3,N) ! 3 checks per bit + integer synd(M) + real tov(3,N) + real toc(7,M) + real tanhtoc(7,M) + real zn(N),zsum(N),zsave(N,3) + real llr(N) + real Tmn -include "ldpc_174_91_c_reordered_parity.f90" + include "ldpc_174_91_c_reordered_parity.f90" -toc=0 -tov=0 -tanhtoc=0 + maxiterations=30 + nosd=0 + if(maxosd.gt.3) maxosd=3 + if(maxosd.eq.0) then ! osd with channel llrs + nosd=1 + zsave(:,1)=llr + elseif(maxosd.gt.0) then ! + nosd=maxosd + elseif(maxosd.lt.0) then ! just bp + nosd=0 + endif + + toc=0 + tov=0 + tanhtoc=0 ! initialize messages to checks -do j=1,M - do i=1,nrw(j) - toc(i,j)=llr((Nm(i,j))) - enddo -enddo - -ncnt=0 -nclast=0 - -maxiterations=1 - -zsum=0.0 -do isuper=1,maxsuper - -do iter=0,maxiterations -! Update bit log likelihood ratios (tov=0 in iteration 0). - do i=1,N - if( apmask(i) .ne. 1 ) then - zn(i)=llr(i)+sum(tov(1:ncw,i)) - else - zn(i)=llr(i) - endif - enddo -zsum=zsum+zn -! Check to see if we have a codeword (check before we do any iteration). - cw=0 - where( zn .gt. 0. ) cw=1 - ncheck=0 - do i=1,M - synd(i)=sum(cw(Nm(1:nrw(i),i))) - if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1 -! if( mod(synd(i),2) .ne. 0 ) write(*,*) 'check ',i,' unsatisfied' - enddo -! write(*,*) 'number of unsatisfied parity checks ',ncheck - if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it - m96=0 - m96(1:77)=cw(1:77) - m96(83:96)=cw(78:91) - call get_crc14(m96,96,nbadcrc) - nharderror=count( (2*cw-1)*llr .lt. 0.0 ) - if(nbadcrc.eq.0) then - message91=cw(1:91) - dmin=0.0 - return - endif - endif - -! if( iter.gt.0 ) then ! this code block implements an early stopping criterion - if( iter.gt.10000 ) then ! this code block implements an early stopping criterion - nd=ncheck-nclast - if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased - ncnt=0 ! reset counter - else - ncnt=ncnt+1 - endif -! write(*,*) iter,ncheck,nd,ncnt - if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then - nharderror=-1 - - return - endif - endif - nclast=ncheck - -! Send messages from bits to check nodes - do j=1,M - do i=1,nrw(j) - ibj=Nm(i,j) - toc(i,j)=zn(ibj) - do kk=1,ncw ! subtract off what the bit had received from the check - if( Mn(kk,ibj) .eq. j ) then - toc(i,j)=toc(i,j)-tov(kk,ibj) - endif + do j=1,M + do i=1,nrw(j) + toc(i,j)=llr((Nm(i,j))) + enddo + enddo + + ncnt=0 + nclast=0 + zsum=0.0 + do iter=0,maxiterations +! Update bit log likelihood ratios (tov=0 in iteration 0). + do i=1,N + if( apmask(i) .ne. 1 ) then + zn(i)=llr(i)+sum(tov(1:ncw,i)) + else + zn(i)=llr(i) + endif + enddo + zsum=zsum+zn + if(iter.gt.0 .and. iter.le.maxosd) then + zsave(:,iter)=zsum + endif + +! Check to see if we have a codeword (check before we do any iteration). + cw=0 + where( zn .gt. 0. ) cw=1 + ncheck=0 + do i=1,M + synd(i)=sum(cw(Nm(1:nrw(i),i))) + if( mod(synd(i),2) .ne. 0 ) ncheck=ncheck+1 + enddo + if( ncheck .eq. 0 ) then ! we have a codeword - if crc is good, return it + m96=0 + m96(1:77)=cw(1:77) + m96(83:96)=cw(78:91) + call get_crc14(m96,96,nbadcrc) + nharderror=count( (2*cw-1)*llr .lt. 0.0 ) + if(nbadcrc.eq.0) then + message91=cw(1:91) + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + dmin=sum(nxor*abs(llr)) + ntype=1 + return + endif + endif + + if( iter.gt.0 ) then ! this code block implements an early stopping criterion +! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion + nd=ncheck-nclast + if( nd .lt. 0 ) then ! # of unsatisfied parity checks decreased + ncnt=0 ! reset counter + else + ncnt=ncnt+1 + endif +! write(*,*) iter,ncheck,nd,ncnt + if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then + nharderror=-1 + exit + endif + endif + nclast=ncheck + +! Send messages from bits to check nodes + do j=1,M + do i=1,nrw(j) + ibj=Nm(i,j) + toc(i,j)=zn(ibj) + do kk=1,ncw ! subtract off what the bit had received from the check + if( Mn(kk,ibj) .eq. j ) then + toc(i,j)=toc(i,j)-tov(kk,ibj) + endif + enddo + enddo enddo - enddo - enddo ! send messages from check nodes to variable nodes - do i=1,M - tanhtoc(1:7,i)=tanh(-toc(1:7,i)/2) - enddo + do i=1,M + tanhtoc(1:7,i)=tanh(-toc(1:7,i)/2) + enddo - do j=1,N - do i=1,ncw - ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j - Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j) - call platanh(-Tmn,y) + do j=1,N + do i=1,ncw + ichk=Mn(i,j) ! Mn(:,j) are the checks that include bit j + Tmn=product(tanhtoc(1:nrw(ichk),ichk),mask=Nm(1:nrw(ichk),ichk).ne.j) + call platanh(-Tmn,y) ! y=atanh(-Tmn) - tov(i,j)=2*y - enddo - enddo + tov(i,j)=2*y + enddo + enddo -enddo ! bp iterations + enddo ! bp iterations - call osd174_91(zsum,Keff,apmask,ndeep,message91,cw,nharderror,dminosd) - if(nharderror.gt.0) then - hdec=0 - where(llr .ge. 0) hdec=1 - nxor=ieor(hdec,cw) - dmin=sum(nxor*abs(llr)) - return - endif -enddo ! super iterations + do i=1,nosd + zn=zsave(:,i) + call osd174_91(zn,Keff,apmask,norder,message91,cw,nharderror,dminosd) + if(nharderror.gt.0) then + hdec=0 + where(llr .ge. 0) hdec=1 + nxor=ieor(hdec,cw) + dmin=sum(nxor*abs(llr)) + ntype=2 + return + endif + enddo -nharderror=-1 + ntype=0 + nharderror=-1 + dminosd=0.0 -return + return end subroutine decode174_91 diff --git a/lib/ft8/ft8b.f90 b/lib/ft8/ft8b.f90 index f72a52c6a..b92bde34c 100644 --- a/lib/ft8/ft8b.f90 +++ b/lib/ft8/ft8b.f90 @@ -400,28 +400,23 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,nzhsym,lapon, & endif cw=0 - call timer('bpd174_91 ',0) - call bpdecode174_91(llrz,apmask,max_iterations,message77,cw,nharderrors, & - niterations,ncheck) - call timer('bpd174_91 ',1) dmin=0.0 - if(nharderrors.lt.0 .and. ncheck.le.30 .and. ndepth.ge.2) then -! ndeep=ndepth - ndeep=ndepth-1 - if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid .or. ncontest.eq.7) then -! ndeep=4 - ndeep=3 - endif -! if(nagain) ndeep=5 - if(nagain) ndeep=4 - call timer('osd174_91 ',0) - Keff=91 -! call osd174_91(llrz,Keff,apmask,ndeep,message91,cw,nharderrors,dmin) - maxsuper=1 - call decode174_91(llrz,Keff,ndeep,apmask,maxsuper,message91,cw,nharderrors,niterations,ncheck,dmin) - if(nharderrors.ge.0) message77=message91(1:77) - call timer('osd174_91 ',1) + norder=2 + maxosd=2 + if(ndepth.lt.3) maxosd=1 + if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid .or. ncontest.eq.7) then + maxosd=2 endif + if(nagain) then + norder=3 + maxosd=1 + endif + call timer('dec174_91 ',0) + Keff=91 + call decode174_91(llrz,Keff,maxosd,norder,apmask,message91,cw, & + ntype,nharderrors,dmin) + if(nharderrors.ge.0) message77=message91(1:77) + call timer('dec174_91 ',1) msg37=' ' if(nharderrors.lt.0 .or. nharderrors.gt.36) cycle