From 2cdb164446554023985fa4622770188ebd13d4b7 Mon Sep 17 00:00:00 2001 From: Steve Franke Date: Sat, 16 Jun 2018 16:42:02 -0500 Subject: [PATCH] Move CRC13 creation into encode128_90.f90 and CRC checking into bpdecode128_90.f90. --- CMakeLists.txt | 2 +- lib/bpdecode128_90.f90 | 199 ++++++++++++++++++----------------- lib/encode128_90.f90 | 19 +++- lib/extractmessage128_90.f90 | 35 ------ lib/extractmessage77.f90 | 18 ++++ lib/ldpcsim128_90.f90 | 52 +++------ 6 files changed, 153 insertions(+), 172 deletions(-) delete mode 100644 lib/extractmessage128_90.f90 create mode 100644 lib/extractmessage77.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index cf89605f9..06630df01 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -425,7 +425,7 @@ set (wsjt_FSRCS lib/extract.f90 lib/extract4.f90 lib/extractmessage144.f90 - lib/extractmessage128_90.f90 + lib/extractmessage77.f90 lib/fsk4hf/extractmessage168.f90 lib/ft8/extractmessage174.f90 lib/ft8/extractmessage174_91.f90 diff --git a/lib/bpdecode128_90.f90 b/lib/bpdecode128_90.f90 index 05ae51032..763b91963 100644 --- a/lib/bpdecode128_90.f90 +++ b/lib/bpdecode128_90.f90 @@ -1,113 +1,116 @@ -subroutine bpdecode128_90(llr,apmask,maxiterations,decoded,cw,nharderror,iter) +subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter) ! ! A log-domain belief propagation decoder for the (128,90) code. ! -integer, parameter:: N=128, K=90, M=N-K -integer*1 codeword(N),cw(N),apmask(N) -integer*1 decoded(K) -integer Nm(12,M) -integer Mn(4,N) -integer synd(M) -real tov(4,N) -real toc(12,M) -real tanhtoc(12,M) -real zn(N) -real llr(N) -real Tmn -integer nrw(M),ncw(N) + use iso_c_binding, only: c_loc,c_size_t + use crc + integer, parameter:: N=128, K=90, M=N-K + integer*1 cw(N),apmask(N) + integer*1 decoded(K) + integer*1 message77(77) + integer Nm(12,M) + integer Mn(4,N) + integer nrw(M),ncw(N) + integer synd(M) + real tov(4,N) + real toc(12,M) + real tanhtoc(12,M) + real zn(N) + real llr(N) + real Tmn -include "ldpc_128_90_b_reordered_parity.f90" + include "ldpc_128_90_b_reordered_parity.f90" -decoded=0 -toc=0 -tov=0 -tanhtoc=0 + 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 - -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),i)) - else - zn(i)=llr(i) - endif - enddo - -! 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 - reorder the columns and return it - codeword=cw - decoded=codeword(1:K) - nerr=0 - do i=1,N - if( (2*cw(i)-1)*llr(i) .lt. 0.0 ) nerr=nerr+1 - enddo - nharderror=nerr - return - 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,4 ! 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 + toc(i,j)=llr((Nm(i,j))) + enddo + enddo + + ncnt=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),i)) + else + zn(i)=llr(i) + endif + enddo + +! 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 - reorder the columns and return it + decoded=cw(1:K) + call chkcrc13a(decoded,nbadcrc) + if(nbadcrc.eq.0) then + message77=decoded(1:77) + nharderror=count( (2*cw-1)*llr .lt. 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,4 ! 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 ! send messages from check nodes to variable nodes - do i=1,M - tanhtoc(1:12,i)=tanh(-toc(1:12,i)/2) - enddo - - do j=1,N - do i=1,ncw(j) - 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 + do i=1,M + tanhtoc(1:12,i)=tanh(-toc(1:12,i)/2) enddo - enddo -enddo -nharderror=-1 -return + do j=1,N + do i=1,ncw(j) + 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 + nharderror=-1 + return + end subroutine bpdecode128_90 diff --git a/lib/encode128_90.f90 b/lib/encode128_90.f90 index c6daaa8c0..808eb1ccd 100644 --- a/lib/encode128_90.f90 +++ b/lib/encode128_90.f90 @@ -1,15 +1,19 @@ -subroutine encode128_90(message,codeword) +subroutine encode128_90(message77,codeword) ! Encode an 90-bit message and return a 128-bit codeword. ! The generator matrix has dimensions (38,90). ! The code is a (128,90) regular ldpc code with column weight 3. ! +use, intrinsic :: iso_c_binding +use iso_c_binding, only: c_loc,c_size_t +use crc integer, parameter:: N=128, K=90, M=N-K - +character*90 tmpchar integer*1 codeword(N) integer*1 gen(M,K) -integer*1 message(K) +integer*1 message77(77),message(K) integer*1 pchecks(M) +integer*1, target :: i1MsgBytes(12) include "ldpc_128_90_b_generator.f90" logical first data first/.true./ @@ -31,6 +35,15 @@ if( first ) then ! fill the generator matrix first=.false. endif +! Add 13 bit CRC to form 90-bit message+CRC13 +write(tmpchar,'(77i1)') message77 +tmpchar(78:80)='000' +i1MsgBytes=0 +read(tmpchar,'(10b8)') i1MsgBytes(1:10) +ncrc13 = crc13 (c_loc (i1MsgBytes), 12) +write(tmpchar(78:90),'(b13)') ncrc13 +read(tmpchar,'(90i1)') message + do i=1,M nsum=0 do j=1,K diff --git a/lib/extractmessage128_90.f90 b/lib/extractmessage128_90.f90 deleted file mode 100644 index 6319bf513..000000000 --- a/lib/extractmessage128_90.f90 +++ /dev/null @@ -1,35 +0,0 @@ -subroutine extractmessage128_90(decoded,msgreceived,ncrcflag) - use iso_c_binding, only: c_loc,c_size_t - use crc - use packjt - - character*22 msgreceived - character*90 cbits - integer*1 decoded(90) - integer*1, target:: i1Dec8BitBytes(12) - integer*2 icrc13 - integer*4 i4Dec6BitWords(12) - -! Write decoded bits into cbits: 77-bit message plus 13-bit CRC - write(cbits,1000) decoded -1000 format(90i1) - read(cbits,1001) i1Dec8BitBytes -1001 format(12b8) - read(cbits,1002) ncrc13 !Received CRC12 -1002 format(77x,b13) - - i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),128+64+32+16+8) - i1Dec8BitBytes(11:12)=0 - icrc13=crc13(c_loc(i1Dec8BitBytes),12) !CRC13 computed from 77 msg bits - - if(ncrc13.eq.icrc13) then !### Kludge ### ??? -! CRC13 checks out --- unpack 72-bit message - read(cbits,'(12b6)') i4Dec6BitWords - call unpackmsg(i4Dec6BitWords,msgreceived,.false.,' ') - ncrcflag=1 - else - msgreceived=' ' - ncrcflag=-1 - endif - return - end subroutine extractmessage128_90 diff --git a/lib/extractmessage77.f90 b/lib/extractmessage77.f90 new file mode 100644 index 000000000..38a80189b --- /dev/null +++ b/lib/extractmessage77.f90 @@ -0,0 +1,18 @@ +subroutine extractmessage77(decoded77,msgreceived) + use packjt + + character*22 msgreceived + character*77 cbits + integer*1 decoded77(77) + integer*1, target:: i1Dec8BitBytes(12) + integer*4 i4Dec6BitWords(12) + + write(cbits,'(77i1)') decoded77 +!**** Temporary: For now, just handle i5bit=0. + read(cbits,'(12b6)') i4Dec6BitWords + read(cbits,'(72x,i5.5)') i5bit + if( i5bit .eq. 0 ) then + call unpackmsg(i4Dec6BitWords,msgreceived,.false.,' ') + endif + return +end subroutine extractmessage77 diff --git a/lib/ldpcsim128_90.f90 b/lib/ldpcsim128_90.f90 index 81a2fc55f..a3346b5b9 100644 --- a/lib/ldpcsim128_90.f90 +++ b/lib/ldpcsim128_90.f90 @@ -1,23 +1,19 @@ program ldpcsim -use, intrinsic :: iso_c_binding -use iso_c_binding, only: c_loc,c_size_t -use crc use packjt integer, parameter:: NRECENT=10, N=128, K=90, M=N-K character*12 recent_calls(NRECENT) character*22 msg,msgsent,msgreceived character*96 tmpchar character*8 arg -integer*1, allocatable :: codeword(:), decoded(:), message(:) -integer*1, target:: i1Msg8BitBytes(12) +integer*1 codeword(N), message77(77) integer*1 apmask(N),cw(N) -integer*1 msgbits(90) +integer*1 msgbits(77) integer*2 ncrc13 integer*4 i4Msg6BitWords(13) integer nerrtot(0:N),nerrdec(0:N),nmpcbad(0:K),nbadwt(0:N) -real*8, allocatable :: lratio(:), rxdata(:), rxavgd(:) -real, allocatable :: yy(:), llr(:) +real*8 rxdata(N), rxavgd(N) +real llr(N) do i=1,NRECENT recent_calls(i)=' ' @@ -45,12 +41,8 @@ read(arg,*) s rate=real(K)/real(N) write(*,*) "rate: ",rate - write(*,*) "niter= ",max_iterations," navg= ",navg," s= ",s -allocate ( codeword(N), decoded(K), message(K) ) -allocate ( lratio(N), rxdata(N), rxavgd(N), yy(N), llr(N) ) - !msg="K9AN K1JT EN50" msg="G4WJS K1JT FN20" call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes @@ -60,21 +52,17 @@ msg="G4WJS K1JT FN20" tmpchar=' ' write(tmpchar,'(12b6.6)') i4Msg6BitWords(1:12) tmpchar(73:77)="00000" !i5bit - read(tmpchar,'(10b8)') i1Msg8BitBytes(1:10) - i1Msg8BitBytes(10:12)=0 - ncrc13 = crc13 (c_loc (i1Msg8BitBytes), 12) - - write(tmpchar(78:90),'(b13)') ncrc13 - read(tmpchar,'(90i1)') msgbits(1:90) + read(tmpchar,'(77i1)') msgbits(1:77) write(*,*) 'msgbits' write(*,'(28i1,1x,28i1,1x,16i1,1x,5i1,1x,13i1)') msgbits +! msgbits is the 77-bit message, codeword is 128 bits call encode128_90(msgbits,codeword) call init_random_seed() -write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadcrc sigma psymerr" +write(*,*) "Eb/N0 SNR2500 ngood nundetected sigma psymerr" do idb = 14,-6,-1 db=idb/2.0-1.0 sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) @@ -113,27 +101,20 @@ do idb = 14,-6,-1 endif llr=2.0*rxdata/(ss*ss) - lratio=exp(llr) - yy=rxdata apmask=0 ! max_iterations is max number of belief propagation iterations - call bpdecode128_90(llr, apmask, max_iterations, decoded, cw, nharderrors, niterations) + call bpdecode128_90(llr, apmask, max_iterations, message77, cw, nharderrors, niterations) ! If the decoder finds a valid codeword, nharderrors will be .ge. 0. if( nharderrors .ge. 0 ) then - call extractmessage128_90(decoded,msgreceived,ncrcflag) - nhw=count(cw.ne.codeword) - if(ncrcflag.eq.1) then - if(nhw.eq.0) then ! this is a good decode - ngood=ngood+1 - nerrdec(nerr)=nerrdec(nerr)+1 - else ! this is an undetected error - nue=nue+1 - endif - else - nbadcrc=nbadcrc+1 - nbadwt(nhw)=nbadwt(nhw)+1 ! store the weight of the error vector + call extractmessage77(message77,msgreceived) + nhw=count(message77.ne.codeword(1:77)) + if(nhw.eq.0) then ! this is a good decode + ngood=ngood+1 + nerrdec(nerr)=nerrdec(nerr)+1 + else ! this is an undetected error + nue=nue+1 endif endif nsumerr=nsumerr+nerr @@ -141,7 +122,7 @@ do idb = 14,-6,-1 snr2500=db-2.5 pberr=real(nsumerr)/real(ntrials*N) - write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,7x,f5.2,3x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr + write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,7x,f5.2,3x,e10.3)") db,snr2500,ngood,nue,ss,pberr enddo @@ -150,6 +131,7 @@ do i=0,N write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10) enddo close(23) + open(unit=25,file='badcrc_hamming_weight.dat',status='unknown') do i=0,N write(25,'(i4,2x,i10)') i,nbadwt(i)