From 529cc1bae13aa5133532e2381b674f562bf7f66e Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 21 Apr 2020 13:44:24 -0500 Subject: [PATCH 1/2] Speed up wspr4d. --- CMakeLists.txt | 2 +- lib/fsk4hf/ldpcsim174_74.f90 | 7 ++----- lib/fsk4hf/osd174_74.f90 | 2 +- lib/fsk4hf/wspr4d.f90 | 18 ++++++++++++------ 4 files changed, 16 insertions(+), 13 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2efeea807..b1bb81118 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -602,7 +602,7 @@ set (wsjt_FSRCS lib/fsk4hf/osd204.f90 lib/fsk4hf/genwsprcpm.f90 lib/fsk4hf/encode204.f90 -# lib/ft8/decode174_91.f90 + lib/fsk4hf/decode174_74.f90 lib/fsk4hf/ldpcsim174_91.f90 lib/fsk4hf/ldpcsim174_74.f90 lib/fsk4hf/ldpcsim174_101.f90 diff --git a/lib/fsk4hf/ldpcsim174_74.f90 b/lib/fsk4hf/ldpcsim174_74.f90 index 27e59838c..1db5f066e 100644 --- a/lib/fsk4hf/ldpcsim174_74.f90 +++ b/lib/fsk4hf/ldpcsim174_74.f90 @@ -98,10 +98,6 @@ program ldpcsim174_74 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 @@ -114,7 +110,8 @@ program ldpcsim174_74 call bpdecode174_74(llr,apmask,max_iterations,message,cw,nharderror,niterations) dmin=0.0 if( (nharderror .lt. 0) .and. (ndeep .ge. 0) ) then - call osd174_74(llr, Keff, apmask, ndeep, message, cw, nharderror, dmin) +! call osd174_74(llr, Keff, apmask, ndeep, message, cw, nharderror, dmin) +call decode174_74(llr,Keff,ndeep,apmask,max_iterations,message,cw,nharderror,niterations,ncheck,dmin,isuper) endif if(nharderror.ge.0) then diff --git a/lib/fsk4hf/osd174_74.f90 b/lib/fsk4hf/osd174_74.f90 index 8417e7864..e954f4eff 100644 --- a/lib/fsk4hf/osd174_74.f90 +++ b/lib/fsk4hf/osd174_74.f90 @@ -22,7 +22,7 @@ subroutine osd174_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) integer indices(N),nxor(N) integer*1 cw(N),ce(N),c0(N),hdec(N) integer*1, allocatable :: decoded(:) - integer*1 message50(50),message74(74) + integer*1 message74(74) integer indx(N) real llr(N),rx(N),absrx(N) diff --git a/lib/fsk4hf/wspr4d.f90 b/lib/fsk4hf/wspr4d.f90 index 131fff0c3..78d66b7fa 100644 --- a/lib/fsk4hf/wspr4d.f90 +++ b/lib/fsk4hf/wspr4d.f90 @@ -119,13 +119,13 @@ program wspr4d enddo if(smax .lt. 100.0 ) cycle + idecoded=0 - do ijitter=0,4 + do ijitter=0,2 if(idecoded.eq.1) exit - if(ijitter.eq.1) ioffset=20 - if(ijitter.eq.2) ioffset=-20 - if(ijitter.eq.3) ioffset=40 - if(ijitter.eq.4) ioffset=-40 + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=50 + if(ijitter.eq.2) ioffset=-50 is0=isbest+ioffset if(is0.lt.0) cycle cframe=c2(is0:is0+103*416-1) @@ -168,7 +168,13 @@ program wspr4d dmin=0.0 call bpdecode174_74(llr,apmask,max_iterations,message,cw,nhardbp,niterations) Keff=64 - if(nhardbp.lt.0) call osd174_74(llr,Keff,apmask,5,message,cw,nhardosd,dmin) +! if(nhardbp.lt.0) call osd174_74(llr,Keff,apmask,5,message,cw,nhardosd,dmin) + maxsuperits=2 + ndeep=4 + if(nhardbp.lt.0) then + call decode174_74(llr,Keff,ndeep,apmask,maxsuperits,message,cw,nhardosd,iter,ncheck,dmin,isuper) + endif + if(nhardbp.ge.0 .or. nhardosd.ge.0) then write(c77,'(50i1)') message c77(51:77)='000000000000000000000110000' From 01d555c898300b2438c8664a251bde4b5e1a8257 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 21 Apr 2020 13:46:43 -0500 Subject: [PATCH 2/2] Add hybrid bp/osd decoder for (174,K) crc-aided code. --- lib/fsk4hf/decode174_74.f90 | 128 ++++++++++++++++++++++++++++++++++++ 1 file changed, 128 insertions(+) create mode 100644 lib/fsk4hf/decode174_74.f90 diff --git a/lib/fsk4hf/decode174_74.f90 b/lib/fsk4hf/decode174_74.f90 new file mode 100644 index 000000000..d4ed89edd --- /dev/null +++ b/lib/fsk4hf/decode174_74.f90 @@ -0,0 +1,128 @@ +subroutine decode174_74(llr,Keff,ndeep,apmask,maxsuper,message74,cw,nharderror,iter,ncheck,dmin,isuper) +! +! A hybrid bp/osd decoder for the (174,74) code. +! +integer, parameter:: N=174, K=74, M=N-K +integer*1 cw(N),apmask(N) +integer*1 decoded(K) +integer*1 message74(74) +integer nrw(M),ncw +integer Nm(6,M) +integer Mn(3,N) ! 3 checks per bit +integer synd(M) +real tov(3,N) +real toc(6,M) +real tanhtoc(6,M) +real zn(N),zsum(N) +real llr(N) +real Tmn + +include "ldpc_174_74_parity.f90" + +decoded=0 +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 + decoded=cw(1:K) + call get_crc24(decoded,74,nbadcrc) + nharderror=count( (2*cw-1)*llr .lt. 0.0 ) + if(nbadcrc.eq.0) then + message74=decoded(1:74) +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 + enddo + enddo + enddo + +! send messages from check nodes to variable nodes + do i=1,M + tanhtoc(1:6,i)=tanh(-toc(1:6,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) +! y=atanh(-Tmn) + tov(i,j)=2*y + enddo + enddo + +enddo ! bp iterations +llr=zsum + call osd174_74(llr,Keff,apmask,ndeep,message74,cw,nharderror,dmin) + if(nharderror.gt.0) then + return + endif +enddo ! super iterations + +nharderror=-1 + +return +end subroutine decode174_74