Move CRC13 creation into encode128_90.f90 and CRC checking into bpdecode128_90.f90.

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

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
+  use iso_c_binding, only: c_loc,c_size_t
-integer*1 codeword(N),cw(N),apmask(N)
+  use crc
-integer*1 decoded(K)
+  integer, parameter:: N=128, K=90, M=N-K
-integer Nm(12,M)   
+  integer*1 cw(N),apmask(N)
-integer Mn(4,N) 
+  integer*1 decoded(K)
-integer synd(M)
+  integer*1 message77(77)
-real tov(4,N)
+  integer Nm(12,M)   
-real toc(12,M)
+  integer Mn(4,N) 
-real tanhtoc(12,M)
+  integer nrw(M),ncw(N)
-real zn(N)
+  integer synd(M)
-real llr(N)
+  real tov(4,N)
-real Tmn
+  real toc(12,M)
-integer nrw(M),ncw(N)
+  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
+  decoded=0
-toc=0
+  toc=0
-tov=0
+  tov=0
-tanhtoc=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)=llr((Nm(i,j)))
-      toc(i,j)=zn(ibj)  
+    enddo
-      do kk=1,4 ! subtract off what the bit had received from the check
+  enddo
-        if( Mn(kk,ibj) .eq. j ) then  
+
-          toc(i,j)=toc(i,j)-tov(kk,ibj)
+  ncnt=0
-        endif
+
+  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
+    do i=1,M
-    tanhtoc(1:12,i)=tanh(-toc(1:12,i)/2)
+      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
     enddo
-  enddo
 
-enddo
+    do j=1,N
-nharderror=-1
+      do i=1,ncw(j)
-return
+        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

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 

lib/extractmessage128_90.f90

@@ -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

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

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 codeword(N), message77(77)
-integer*1, target:: i1Msg8BitBytes(12)
 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*8 rxdata(N), rxavgd(N)
-real, allocatable :: yy(:), llr(:)
+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)
+  read(tmpchar,'(77i1)') msgbits(1:77)
-  i1Msg8BitBytes(10:12)=0 
-  ncrc13 = crc13 (c_loc (i1Msg8BitBytes), 12)
-
-  write(tmpchar(78:90),'(b13)') ncrc13
-  read(tmpchar,'(90i1)') msgbits(1:90)
 
   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)
+       call extractmessage77(message77,msgreceived)
-       nhw=count(cw.ne.codeword)
+       nhw=count(message77.ne.codeword(1:77))
-       if(ncrcflag.eq.1) then
+       if(nhw.eq.0) then ! this is a good decode
-          if(nhw.eq.0) then ! this is a good decode
+          ngood=ngood+1
-             ngood=ngood+1
+          nerrdec(nerr)=nerrdec(nerr)+1 
-             nerrdec(nerr)=nerrdec(nerr)+1 
+       else              ! this is an undetected error
-          else              ! this is an undetected error
+          nue=nue+1
-             nue=nue+1
-          endif
-       else
-          nbadcrc=nbadcrc+1
-          nbadwt(nhw)=nbadwt(nhw)+1  ! store the weight of the error vector
        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)