From 7ba75b79c908b0182c20bad1cf8e50094c9a64c1 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sun, 28 Aug 2016 01:02:03 +0000 Subject: [PATCH] Add routines to decode msk40 and msk144 messages using log-domain belief propagation. Also add new routines to test msk144/msk40 encoding and decoding. git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@7035 ab8295b8-cf94-4d9e-aec4-7959e3be5d79 --- lib/bpdecode144.f90 | 290 +++++++++++++++++++++++++++++ lib/bpdecode40.f90 | 157 ++++++++++++++++ lib/ldpcsim144.f90 | 162 ++++++++++++++++ lib/{ldpcsim.f90 => ldpcsim40.f90} | 64 ++++--- lib/msk144sim.f90 | 3 +- 5 files changed, 646 insertions(+), 30 deletions(-) create mode 100644 lib/bpdecode144.f90 create mode 100644 lib/bpdecode40.f90 create mode 100644 lib/ldpcsim144.f90 rename lib/{ldpcsim.f90 => ldpcsim40.f90} (67%) diff --git a/lib/bpdecode144.f90 b/lib/bpdecode144.f90 new file mode 100644 index 000000000..e1f5b5d2e --- /dev/null +++ b/lib/bpdecode144.f90 @@ -0,0 +1,290 @@ +subroutine bpdecode144(llr,maxiterations,decoded,niterations) +! +! A log-domain belief propagation decoder for the msk144 code. +! The code is a regular (128,80) code with column weight 3 and row weight 8. +! k9an August, 2016 +! +integer, parameter:: N=128, K=80, M=N-K +integer*1 codeword(N),cw(N) +integer*1 colorder(N) +integer*1 decoded(K) +integer Nm(8,M) ! 8 bits per check +integer Mn(3,N) ! 3 checks per bit +integer synd(M) +real*8 tov(3,N) +real*8 toc(8,M) +real*8 tanhtoc(8,M) +real*8 zn(N) +real*8 llr(N) +real*8 Tmn +real*8 xth + +data colorder/0,1,2,3,4,5,6,7,8,9, & + 10,11,12,13,14,15,24,26,29,30, & + 32,43,44,47,60,77,79,97,101,111, & + 96,38,64,53,93,34,59,94,74,90, & + 108,123,85,57,70,25,69,62,48,49, & + 50,51,52,33,54,55,56,21,58,36, & + 16,61,23,63,20,65,66,67,68,46, & + 22,71,72,73,31,75,76,45,78,17, & + 80,81,82,83,84,42,86,87,88,89, & + 39,91,92,35,37,95,19,27,98,99, & + 100,28,102,103,104,105,106,107,40,109, & + 110,18,112,113,114,115,116,117,118,119, & + 120,121,122,41,124,125,126,127/ + +data Mn/ & + 1, 14, 38, & + 2, 4, 41, & + 3, 19, 39, & + 5, 29, 34, & + 6, 35, 40, & + 7, 20, 45, & + 8, 28, 48, & + 9, 22, 25, & + 10, 24, 36, & + 11, 12, 37, & + 13, 43, 44, & + 15, 18, 46, & + 16, 17, 47, & + 21, 32, 33, & + 23, 30, 31, & + 26, 27, 42, & + 1, 12, 46, & + 2, 36, 38, & + 3, 5, 10, & + 4, 9, 23, & + 6, 13, 39, & + 7, 15, 17, & + 8, 18, 27, & + 11, 33, 40, & + 14, 28, 44, & + 16, 29, 31, & + 19, 20, 22, & + 21, 30, 42, & + 24, 26, 47, & + 25, 37, 48, & + 32, 34, 45, & + 8, 35, 41, & + 12, 31, 43, & + 1, 19, 21, & + 2, 43, 45, & + 3, 4, 11, & + 5, 18, 33, & + 6, 25, 47, & + 7, 28, 30, & + 9, 14, 34, & + 10, 35, 42, & + 13, 15, 22, & + 16, 37, 38, & + 17, 41, 44, & + 20, 24, 29, & + 18, 23, 39, & + 12, 26, 32, & + 27, 38, 40, & + 15, 36, 48, & + 2, 30, 46, & + 1, 4, 13, & + 3, 28, 32, & + 5, 43, 47, & + 6, 34, 46, & + 7, 9, 40, & + 8, 11, 45, & + 10, 17, 23, & + 14, 31, 35, & + 16, 22, 42, & + 19, 37, 44, & + 20, 33, 48, & + 21, 24, 41, & + 25, 27, 29, & + 26, 39, 48, & + 19, 31, 36, & + 1, 5, 7, & + 2, 29, 39, & + 3, 16, 46, & + 4, 26, 37, & + 6, 28, 45, & + 8, 22, 33, & + 9, 21, 43, & + 10, 25, 38, & + 11, 14, 24, & + 12, 17, 40, & + 13, 27, 30, & + 15, 32, 35, & + 18, 44, 47, & + 20, 23, 36, & + 34, 41, 42, & + 1, 32, 48, & + 2, 3, 33, & + 4, 29, 42, & + 5, 14, 37, & + 6, 7, 36, & + 8, 9, 39, & + 10, 13, 19, & + 11, 18, 30, & + 12, 16, 20, & + 15, 29, 44, & + 17, 34, 38, & + 6, 21, 22, & + 23, 32, 40, & + 24, 27, 46, & + 25, 41, 45, & + 7, 26, 43, & + 28, 31, 47, & + 20, 35, 38, & + 1, 33, 41, & + 2, 42, 44, & + 3, 23, 48, & + 4, 31, 45, & + 5, 8, 30, & + 9, 16, 36, & + 10, 40, 47, & + 11, 17, 46, & + 12, 21, 34, & + 13, 24, 28, & + 14, 18, 43, & + 15, 25, 26, & + 19, 27, 35, & + 22, 37, 39, & + 1, 16, 18, & + 2, 6, 20, & + 3, 30, 43, & + 4, 28, 33, & + 5, 22, 23, & + 7, 39, 42, & + 8, 12, 38, & + 9, 35, 46, & + 10, 27, 32, & + 11, 15, 34, & + 13, 36, 37, & + 14, 41, 47, & + 17, 21, 25, & + 19, 29, 45, & + 24, 31, 48, & + 26, 40, 44/ + +data Nm/ & + 1, 17, 34, 51, 66, 81, 99, 113, & + 2, 18, 35, 50, 67, 82, 100, 114, & + 3, 19, 36, 52, 68, 82, 101, 115, & + 2, 20, 36, 51, 69, 83, 102, 116, & + 4, 19, 37, 53, 66, 84, 103, 117, & + 5, 21, 38, 54, 70, 85, 92, 114, & + 6, 22, 39, 55, 66, 85, 96, 118, & + 7, 23, 32, 56, 71, 86, 103, 119, & + 8, 20, 40, 55, 72, 86, 104, 120, & + 9, 19, 41, 57, 73, 87, 105, 121, & + 10, 24, 36, 56, 74, 88, 106, 122, & + 10, 17, 33, 47, 75, 89, 107, 119, & + 11, 21, 42, 51, 76, 87, 108, 123, & + 1, 25, 40, 58, 74, 84, 109, 124, & + 12, 22, 42, 49, 77, 90, 110, 122, & + 13, 26, 43, 59, 68, 89, 104, 113, & + 13, 22, 44, 57, 75, 91, 106, 125, & + 12, 23, 37, 46, 78, 88, 109, 113, & + 3, 27, 34, 60, 65, 87, 111, 126, & + 6, 27, 45, 61, 79, 89, 98, 114, & + 14, 28, 34, 62, 72, 92, 107, 125, & + 8, 27, 42, 59, 71, 92, 112, 117, & + 15, 20, 46, 57, 79, 93, 101, 117, & + 9, 29, 45, 62, 74, 94, 108, 127, & + 8, 30, 38, 63, 73, 95, 110, 125, & + 16, 29, 47, 64, 69, 96, 110, 128, & + 16, 23, 48, 63, 76, 94, 111, 121, & + 7, 25, 39, 52, 70, 97, 108, 116, & + 4, 26, 45, 63, 67, 83, 90, 126, & + 15, 28, 39, 50, 76, 88, 103, 115, & + 15, 26, 33, 58, 65, 97, 102, 127, & + 14, 31, 47, 52, 77, 81, 93, 121, & + 14, 24, 37, 61, 71, 82, 99, 116, & + 4, 31, 40, 54, 80, 91, 107, 122, & + 5, 32, 41, 58, 77, 98, 111, 120, & + 9, 18, 49, 65, 79, 85, 104, 123, & + 10, 30, 43, 60, 69, 84, 112, 123, & + 1, 18, 43, 48, 73, 91, 98, 119, & + 3, 21, 46, 64, 67, 86, 112, 118, & + 5, 24, 48, 55, 75, 93, 105, 128, & + 2, 32, 44, 62, 80, 95, 99, 124, & + 16, 28, 41, 59, 80, 83, 100, 118, & + 11, 33, 35, 53, 72, 96, 109, 115, & + 11, 25, 44, 60, 78, 90, 100, 128, & + 6, 31, 35, 56, 70, 95, 102, 126, & + 12, 17, 50, 54, 68, 94, 106, 120, & + 13, 29, 38, 53, 78, 97, 105, 124, & + 7, 30, 49, 61, 64, 81, 101, 127/ + +nrw=8 +ncw=3 + +toc=0 +tov=0 +tanhtoc=0 + +! initial messages to checks +do j=1,M + do i=1,nrw + toc(i,j)=llr((Nm(i,j))) + enddo +enddo + +do iter=0,maxiterations + +! Update bit log likelihood ratios + do i=1,N + zn(i)=llr(i)+sum(tov(1:ncw,i)) + enddo + +! Check to see if we have a codeword + cw=0 + where( zn .gt. 0. ) cw=1 + ncheck=0 + do i=1,M + synd(i)=sum(cw(Nm(1:nrw,i))) + synd(i)=mod(synd(i),2) + if( synd(i) .ne. 0 ) ncheck=ncheck+1 + enddo + + if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it. + niterations=iter + codeword=cw(colorder+1) + decoded=codeword(M+1:N) + return + endif + +! Send messages from bits to check nodes + do j=1,M + do i=1,nrw + toc(i,j)=zn(Nm(i,j)) + do kk=1,ncw ! subtract off what the bit had received from the check + if( Mn(kk,Nm(i,j)) .eq. j ) then ! Mn(3,128) + toc(i,j)=toc(i,j)-tov(kk,Nm(i,j)) + endif + enddo + enddo + enddo + +! send messages from check nodes to variable nodes + do i=1,M + tanhtoc(1:nrw,i)=tanh(-toc(1:nrw,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=1.0 + do kk=1,nrw + if( Nm(kk,ichk) .ne. j ) then + Tmn=Tmn*tanhtoc(kk,ichk) + endif + enddo + tov(i,j)=2*atanh(-Tmn) + enddo + enddo + + xth=35.0 + where(tov .gt. xth) tov=xth + where(tov .lt. -xth) tov=-xth + +enddo +niterations=-1 +end subroutine bpdecode144 diff --git a/lib/bpdecode40.f90 b/lib/bpdecode40.f90 new file mode 100644 index 000000000..73eaf0a0c --- /dev/null +++ b/lib/bpdecode40.f90 @@ -0,0 +1,157 @@ +subroutine bpdecode40(llr,maxiterations,decoded,niterations) +! +! A log-domain belief propagation decoder for the msk40 code. +! The code is a regular (32,16) code with column weight 3 and row weights 5,6,7. +! k9an August, 2016 +! +integer, parameter:: N=32, K=16, M=N-K +integer*1 codeword(N),cw(N) +integer*1 colorder(N) +integer*1 decoded(K) +integer Nm(7,M) +integer Mn(3,N) ! 3 checks per bit +integer synd(M) +real*8 tov(3,N) +real*8 toc(7,M) +real*8 tanhtoc(7,M) +real*8 zn(N) +real*8 llr(N) +real*8 Tmn +real*8 xth +integer nrw(M) + +data colorder/ & + 4, 1, 2, 3, 0, 8, 6, 10, & + 13, 28, 20, 23, 17, 15, 27, 25, & + 16, 12, 18, 19, 7, 21, 22, 11, & + 24, 5, 26, 14, 9, 29, 30, 31/ + +data Mn/ & + 1, 6, 13, & + 2, 3, 14, & + 4, 8, 15, & + 5, 11, 12, & + 7, 10, 16, & + 6, 9, 15, & + 1, 11, 16, & + 2, 4, 5, & + 3, 7, 9, & + 8, 10, 12, & + 8, 13, 14, & + 1, 4, 12, & + 2, 6, 10, & + 3, 11, 15, & + 5, 9, 14, & + 7, 13, 15, & + 12, 14, 16, & + 1, 2, 8, & + 3, 5, 6, & + 4, 9, 11, & + 1, 7, 14, & + 5, 10, 13, & + 3, 4, 16, & + 2, 15, 16, & + 6, 7, 12, & + 7, 8, 11, & + 1, 9, 10, & + 2, 11, 13, & + 3, 12, 13, & + 4, 6, 14, & + 1, 5, 15, & + 8, 9, 16/ + +data Nm/ & +1, 7, 12, 18, 21, 27, 31, & +2, 8, 13, 18, 24, 28, 0, & +2, 9, 14, 19, 23, 29, 0, & +3, 8, 12, 20, 23, 30, 0, & +4, 8, 15, 19, 22, 31, 0, & +1, 6, 13, 19, 25, 30, 0, & +5, 9, 16, 21, 25, 26, 0, & +3, 10, 11, 18, 26, 32, 0, & +6, 9, 15, 20, 27, 32, 0,& +5, 10, 13, 22, 27, 0, 0, & +4, 7, 14, 20, 26, 28, 0, & +4, 10, 12, 17, 25, 29, 0, & +1, 11, 16, 22, 28, 29, 0, & +2, 11, 15, 17, 21, 30, 0, & +3, 6, 14, 16, 24, 31, 0, & +5, 7, 17, 23, 24, 32, 0/ + +data nrw/7,6,6,6,6,6,6,6,6,5,6,6,6,6,6,6/ + +ncw=3 + +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 + +do iter=0,maxiterations + +! Update bit log likelihood ratios (tov=0 in iteration 0). + do i=1,N + zn(i)=llr(i)+sum(tov(1:ncw,i)) + 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))) + synd(i)=mod(synd(i),2) + if( synd(i) .ne. 0 ) ncheck=ncheck+1 + enddo + + if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it + niterations=iter + codeword=cw(colorder+1) + decoded=codeword(M+1:N) + return + endif + +! Send messages from bits to check nodes + do j=1,M + do i=1,nrw(j) + toc(i,j)=zn(Nm(i,j)) + do kk=1,ncw ! subtract off what the bit had received from the check + if( Mn(kk,Nm(i,j)) .eq. j ) then + toc(i,j)=toc(i,j)-tov(kk,Nm(i,j)) + endif + enddo + enddo + enddo + +! send messages from check nodes to variable nodes + do i=1,M + tanhtoc(1:nrw(i),i)=tanh(-toc(1:nrw(i),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=1.0 + do kk=1,nrw(ichk) + if( Nm(kk,ichk) .ne. j ) then + Tmn=Tmn*tanhtoc(kk,ichk) + endif + enddo + tov(i,j)=2.*atanh(-Tmn) + enddo + enddo + + xth=35.0 + where(tov .gt. xth) tov=xth + where(tov .lt. -xth) tov=-xth + +enddo +niterations=-1 +return +end subroutine bpdecode40 diff --git a/lib/ldpcsim144.f90 b/lib/ldpcsim144.f90 new file mode 100644 index 000000000..ccdf226ae --- /dev/null +++ b/lib/ldpcsim144.f90 @@ -0,0 +1,162 @@ +program ldpcsim + +use, intrinsic :: iso_c_binding +use iso_c_binding, only: c_loc,c_size_t +use hashing +use packjt +character*22 msg,msgsent,msgreceived +character*80 prefix +character*85 pchk_file,gen_file +character*8 arg +integer*1, allocatable :: codeword(:), decoded(:), message(:) +integer*1, target:: i1Msg8BitBytes(10) +integer*1 i1hash(4) +integer*1 msgbits(80) +integer*1 bitseq(144) +integer*4 i4Msg6BitWords(13) +integer ihash +real*8, allocatable :: lratio(:), rxdata(:), llr(:) +real, allocatable :: yy(:) +equivalence(ihash,i1hash) + +nargs=iargc() +if(nargs.ne.7) then + print*,'Usage: ldpcsim N K niter ndither #trials s ' + print*,'eg: ldpcsim "/pathto/peg-32-16-reg3" 32 16 10 1 1000 0.75' + return +endif +call getarg(1,prefix) +call getarg(2,arg) +read(arg,*) N +call getarg(3,arg) +read(arg,*) K +call getarg(4,arg) +read(arg,*) max_iterations +call getarg(5,arg) +read(arg,*) max_dither +call getarg(6,arg) +read(arg,*) ntrials +call getarg(7,arg) +read(arg,*) s + +pchk_file=trim(prefix)//".pchk" +gen_file=trim(prefix)//".gen" + +!rate=real(K)/real(N) +! don't count hash bits as data bits +rate=72.0/real(N) + +write(*,*) "rate: ",rate + +write(*,*) "pchk file: ",pchk_file +write(*,*) "niter= ",max_iterations," ndither= ",max_dither," s= ",s + +allocate ( codeword(N), decoded(K), message(K) ) +allocate ( lratio(N), rxdata(N), yy(N), llr(N) ) + +call init_ldpc(trim(pchk_file)//char(0),trim(gen_file)//char(0)) +msg="K9AN K1JT EN50" + call packmsg(msg,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes + call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent + write(*,*) "message sent ",msgsent + + i4=0 + ik=0 + im=0 + do i=1,12 + nn=i4Msg6BitWords(i) + do j=1, 6 + ik=ik+1 + i4=i4+i4+iand(1,ishft(nn,j-6)) + i4=iand(i4,255) + if(ik.eq.8) then + im=im+1 +! if(i4.gt.127) i4=i4-256 + i1Msg8BitBytes(im)=i4 + ik=0 + endif + enddo + enddo + + ihash=nhash(c_loc(i1Msg8BitBytes),int(9,c_size_t),146) + ihash=2*iand(ihash,32767) !Generate the 8-bit hash + i1Msg8BitBytes(10)=i1hash(1) !CRC to byte 10 + mbit=0 + do i=1, 10 + i1=i1Msg8BitBytes(i) + do ibit=1,8 + mbit=mbit+1 + msgbits(mbit)=iand(1,ishft(i1,ibit-8)) + enddo + enddo + + call encode_msk144(msgbits,codeword) + call init_random_seed() + +write(*,*) "Eb/N0 ngood nundetected nbadhash" +do idb = -6, 14 + db=idb/2.0-1.0 + sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) + ngood=0 + nue=0 + nbadhash=0 + + do itrial=1, ntrials + call sgran() +! Create a realization of a noisy received word + do i=1,N + rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() + enddo + +! Correct signal normalization is important for this decoder. + rxav=sum(rxdata)/N + 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 + ss=s + endif + + llr=2.0*rxdata/(ss*ss) + lratio=exp(llr) + yy=rxdata + +! max_iterations is max number of belief propagation iterations +! call ldpc_decode(lratio, decoded, max_iterations, niterations, max_dither, ndither) +! call amsdecode(yy, max_iterations, decoded, niterations) +! call bitflipmsk144(rxdata, decoded, niterations) + call bpdecode144(llr, max_iterations, decoded, niterations) + +! If the decoder finds a valid codeword, niterations will be .ge. 0. + if( niterations .ge. 0 ) then + call extractmessage144(decoded,msgreceived,nhashflag) + if( nhashflag .ne. 1 ) then + nbadhash=nbadhash+1 + endif + nueflag=0 + +! Check the message plus hash against what was sent. + do i=1,K + if( msgbits(i) .ne. decoded(i) ) then + nueflag=1 + endif + enddo + if( nhashflag .eq. 1 .and. nueflag .eq. 0 ) then + ngood=ngood+1 + else if( nhashflag .eq. 1 .and. nueflag .eq. 1 ) then + nue=nue+1; + endif + endif + enddo + + write(*,"(f4.1,1x,i8,1x,i8,1x,i8,1x,f5.2)") db,ngood,nue,nbadhash,ss + +enddo + +end program ldpcsim diff --git a/lib/ldpcsim.f90 b/lib/ldpcsim40.f90 similarity index 67% rename from lib/ldpcsim.f90 rename to lib/ldpcsim40.f90 index 1e08a7714..db836125c 100644 --- a/lib/ldpcsim.f90 +++ b/lib/ldpcsim40.f90 @@ -9,8 +9,9 @@ character*80 prefix character*85 pchk_file,gen_file character*8 arg integer*1, allocatable :: codeword(:), decoded(:), message(:) -real*8, allocatable :: lratio(:), rxdata(:) +real*8, allocatable :: lratio(:), rxdata(:), llr(:) integer ihash +integer*1 hardbits(32) nargs=iargc() if(nargs.ne.7) then @@ -36,45 +37,48 @@ pchk_file=trim(prefix)//".pchk" gen_file=trim(prefix)//".gen" rate=real(K)/real(N) -write(*,*) "rate: ",rate ! don't count hash bits as data bits !rate=5.0/real(N) - +write(*,*) "rate: ",rate write(*,*) "pchk file: ",pchk_file write(*,*) "niter= ",max_iterations," ndither= ",max_dither," s= ",s allocate ( codeword(N), decoded(K), message(K) ) -allocate ( lratio(N), rxdata(N) ) +allocate ( lratio(N), rxdata(N), llr(N) ) call init_ldpc(trim(pchk_file)//char(0),trim(gen_file)//char(0)) -msg="K9AN K1JT RRR" -irpt=62 +msg="K1JT K9AN RRR " +irpt=14 call hash(msg,22,ihash) -ihash=iand(ihash,1023) !10-bit hash -ig=64*ihash + irpt !6-bit report +ihash=iand(ihash,4095) !12-bit hash +ig=16*ihash + irpt !4-bit report write(*,*) irpt,ihash,ig do i=1,16 message(i)=iand(1,ishft(ig,1-i)) enddo - -call ldpc_encode(message,codeword) +write(*,'(16i1)') message +!call ldpc_encode(message,codeword) +!write(*,'(32i1)') codeword +call encode_msk40(message,codeword) +write(*,'(32i1)') codeword call init_random_seed() write(*,*) "Eb/N0 ngood nundetected nbadhash" do idb = -6, 14 +!do idb = 14, 14 db=idb/2.0-1.0 sigma=1/sqrt( 2*rate*(10**(db/10.0)) ) ngood=0 nue=0 nbadhash=0 + itsum=0 do itrial=1, ntrials -call sgran() + call sgran() ! Create a realization of a noisy received word do i=1,N - rxdata(i) = 2.0*(codeword(i)-0.5) + sigma*gran() -!write(*,*) i,gran() + rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran() enddo ! Correct signal normalization is important for this decoder. @@ -82,34 +86,27 @@ call sgran() 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 .le. 0 ) then ss=sigma else ss=s endif - do i=1,N - lratio(i)=exp(2.0*rxdata(i)/(ss*ss)) - enddo + llr=2.0*rxdata/(ss*ss) + lratio=exp(llr) -! max_iterations is max number of belief propagation iterations - call ldpc_decode(lratio, decoded, max_iterations, niterations, max_dither, ndither) +! call ldpc_decode(lratio, decoded, max_iterations, niterations, max_dither, ndither) + call bpdecode40(llr, max_iterations, decoded, niterations) ! If the decoder finds a valid codeword, niterations will be .ge. 0. if( niterations .ge. 0 ) then nueflag=0 nhashflag=0 - imsg=0 do i=1,16 imsg=ishft(imsg,1)+iand(1,decoded(17-i)) enddo - nrxrpt=iand(imsg,63) - nrxhash=(imsg-nrxrpt)/64 - + nrxrpt=iand(imsg,15) + nrxhash=(imsg-nrxrpt)/16 if( nrxhash .ne. ihash ) then nbadhash=nbadhash+1 nhashflag=1 @@ -124,13 +121,24 @@ call sgran() if( nhashflag .eq. 0 .and. nueflag .eq. 0 ) then ngood=ngood+1 + itsum=itsum+niterations else if( nhashflag .eq. 0 .and. nueflag .eq. 1 ) then nue=nue+1; endif + else + hardbits=0 + where(llr .gt. 0) hardbits=1 +! write(*,'(32i1)') hardbits +! write(*,'(32i1)') codeword + isum=0 + do i=1,32 + if( hardbits(i) .ne. codeword(i) ) isum=isum+1 + enddo +! write(*,*) 'number of errors ',isum endif enddo - - write(*,"(f4.1,1x,i8,1x,i8,1x,i8)") db,ngood,nue,nbadhash + avits=real(itsum)/real(ngood+0.1) + write(*,"(f4.1,1x,i8,1x,i8,1x,i8,1x,f8.2,1x,f8.1)") db,ngood,nue,nbadhash,ss,avits enddo diff --git a/lib/msk144sim.f90 b/lib/msk144sim.f90 index 2a7b27885..38548764f 100644 --- a/lib/msk144sim.f90 +++ b/lib/msk144sim.f90 @@ -39,8 +39,7 @@ program msk144sim h=default_header(12000,NMAX) ichk=0 - encode_exe_file="./encode " - call genmsk144(msg,ichk,msgsent,itone,itype,pchk_file,ldpc_msg_file,encode_exe_file) + call genmsk144(msg,ichk,msgsent,itone,itype) twopi=8.d0*atan(1.d0) nsym=144