mirror of https://github.com/saitohirga/WSJT-X.git
Move CRC13 creation into encode128_90.f90 and CRC checking into bpdecode128_90.f90.
This commit is contained in:
parent
e16e78790a
commit
2cdb164446
|
@ -425,7 +425,7 @@ set (wsjt_FSRCS
|
||||||
lib/extract.f90
|
lib/extract.f90
|
||||||
lib/extract4.f90
|
lib/extract4.f90
|
||||||
lib/extractmessage144.f90
|
lib/extractmessage144.f90
|
||||||
lib/extractmessage128_90.f90
|
lib/extractmessage77.f90
|
||||||
lib/fsk4hf/extractmessage168.f90
|
lib/fsk4hf/extractmessage168.f90
|
||||||
lib/ft8/extractmessage174.f90
|
lib/ft8/extractmessage174.f90
|
||||||
lib/ft8/extractmessage174_91.f90
|
lib/ft8/extractmessage174_91.f90
|
||||||
|
|
|
@ -1,12 +1,16 @@
|
||||||
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.
|
! A log-domain belief propagation decoder for the (128,90) code.
|
||||||
!
|
!
|
||||||
|
use iso_c_binding, only: c_loc,c_size_t
|
||||||
|
use crc
|
||||||
integer, parameter:: N=128, K=90, M=N-K
|
integer, parameter:: N=128, K=90, M=N-K
|
||||||
integer*1 codeword(N),cw(N),apmask(N)
|
integer*1 cw(N),apmask(N)
|
||||||
integer*1 decoded(K)
|
integer*1 decoded(K)
|
||||||
|
integer*1 message77(77)
|
||||||
integer Nm(12,M)
|
integer Nm(12,M)
|
||||||
integer Mn(4,N)
|
integer Mn(4,N)
|
||||||
|
integer nrw(M),ncw(N)
|
||||||
integer synd(M)
|
integer synd(M)
|
||||||
real tov(4,N)
|
real tov(4,N)
|
||||||
real toc(12,M)
|
real toc(12,M)
|
||||||
|
@ -14,7 +18,6 @@ real tanhtoc(12,M)
|
||||||
real zn(N)
|
real zn(N)
|
||||||
real llr(N)
|
real llr(N)
|
||||||
real Tmn
|
real Tmn
|
||||||
integer nrw(M),ncw(N)
|
|
||||||
|
|
||||||
include "ldpc_128_90_b_reordered_parity.f90"
|
include "ldpc_128_90_b_reordered_parity.f90"
|
||||||
|
|
||||||
|
@ -53,15 +56,14 @@ do iter=0,maxiterations
|
||||||
enddo
|
enddo
|
||||||
! write(*,*) 'number of unsatisfied parity checks ',ncheck
|
! write(*,*) 'number of unsatisfied parity checks ',ncheck
|
||||||
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
|
if( ncheck .eq. 0 ) then ! we have a codeword - reorder the columns and return it
|
||||||
codeword=cw
|
decoded=cw(1:K)
|
||||||
decoded=codeword(1:K)
|
call chkcrc13a(decoded,nbadcrc)
|
||||||
nerr=0
|
if(nbadcrc.eq.0) then
|
||||||
do i=1,N
|
message77=decoded(1:77)
|
||||||
if( (2*cw(i)-1)*llr(i) .lt. 0.0 ) nerr=nerr+1
|
nharderror=count( (2*cw-1)*llr .lt. 0.0 )
|
||||||
enddo
|
|
||||||
nharderror=nerr
|
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
if( iter.gt.0 ) then ! this code block implements an early stopping criterion
|
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
|
! if( iter.gt.10000 ) then ! this code block implements an early stopping criterion
|
||||||
|
@ -110,4 +112,5 @@ do iter=0,maxiterations
|
||||||
enddo
|
enddo
|
||||||
nharderror=-1
|
nharderror=-1
|
||||||
return
|
return
|
||||||
|
|
||||||
end subroutine bpdecode128_90
|
end subroutine bpdecode128_90
|
||||||
|
|
|
@ -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.
|
! Encode an 90-bit message and return a 128-bit codeword.
|
||||||
! The generator matrix has dimensions (38,90).
|
! The generator matrix has dimensions (38,90).
|
||||||
! The code is a (128,90) regular ldpc code with column weight 3.
|
! 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
|
integer, parameter:: N=128, K=90, M=N-K
|
||||||
|
character*90 tmpchar
|
||||||
integer*1 codeword(N)
|
integer*1 codeword(N)
|
||||||
integer*1 gen(M,K)
|
integer*1 gen(M,K)
|
||||||
integer*1 message(K)
|
integer*1 message77(77),message(K)
|
||||||
integer*1 pchecks(M)
|
integer*1 pchecks(M)
|
||||||
|
integer*1, target :: i1MsgBytes(12)
|
||||||
include "ldpc_128_90_b_generator.f90"
|
include "ldpc_128_90_b_generator.f90"
|
||||||
logical first
|
logical first
|
||||||
data first/.true./
|
data first/.true./
|
||||||
|
@ -31,6 +35,15 @@ if( first ) then ! fill the generator matrix
|
||||||
first=.false.
|
first=.false.
|
||||||
endif
|
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
|
do i=1,M
|
||||||
nsum=0
|
nsum=0
|
||||||
do j=1,K
|
do j=1,K
|
||||||
|
|
|
@ -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
|
|
|
@ -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
|
|
@ -1,23 +1,19 @@
|
||||||
program ldpcsim
|
program ldpcsim
|
||||||
|
|
||||||
use, intrinsic :: iso_c_binding
|
|
||||||
use iso_c_binding, only: c_loc,c_size_t
|
|
||||||
use crc
|
|
||||||
use packjt
|
use packjt
|
||||||
integer, parameter:: NRECENT=10, N=128, K=90, M=N-K
|
integer, parameter:: NRECENT=10, N=128, K=90, M=N-K
|
||||||
character*12 recent_calls(NRECENT)
|
character*12 recent_calls(NRECENT)
|
||||||
character*22 msg,msgsent,msgreceived
|
character*22 msg,msgsent,msgreceived
|
||||||
character*96 tmpchar
|
character*96 tmpchar
|
||||||
character*8 arg
|
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 apmask(N),cw(N)
|
||||||
integer*1 msgbits(90)
|
integer*1 msgbits(77)
|
||||||
integer*2 ncrc13
|
integer*2 ncrc13
|
||||||
integer*4 i4Msg6BitWords(13)
|
integer*4 i4Msg6BitWords(13)
|
||||||
integer nerrtot(0:N),nerrdec(0:N),nmpcbad(0:K),nbadwt(0:N)
|
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
|
do i=1,NRECENT
|
||||||
recent_calls(i)=' '
|
recent_calls(i)=' '
|
||||||
|
@ -45,12 +41,8 @@ read(arg,*) s
|
||||||
rate=real(K)/real(N)
|
rate=real(K)/real(N)
|
||||||
|
|
||||||
write(*,*) "rate: ",rate
|
write(*,*) "rate: ",rate
|
||||||
|
|
||||||
write(*,*) "niter= ",max_iterations," navg= ",navg," s= ",s
|
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="K9AN K1JT EN50"
|
||||||
msg="G4WJS K1JT FN20"
|
msg="G4WJS K1JT FN20"
|
||||||
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
|
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
|
||||||
|
@ -60,21 +52,17 @@ msg="G4WJS K1JT FN20"
|
||||||
tmpchar=' '
|
tmpchar=' '
|
||||||
write(tmpchar,'(12b6.6)') i4Msg6BitWords(1:12)
|
write(tmpchar,'(12b6.6)') i4Msg6BitWords(1:12)
|
||||||
tmpchar(73:77)="00000" !i5bit
|
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(*,*) 'msgbits'
|
||||||
write(*,'(28i1,1x,28i1,1x,16i1,1x,5i1,1x,13i1)') 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 encode128_90(msgbits,codeword)
|
||||||
|
|
||||||
call init_random_seed()
|
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
|
do idb = 14,-6,-1
|
||||||
db=idb/2.0-1.0
|
db=idb/2.0-1.0
|
||||||
sigma=1/sqrt( 2*rate*(10**(db/10.0)) )
|
sigma=1/sqrt( 2*rate*(10**(db/10.0)) )
|
||||||
|
@ -113,35 +101,28 @@ do idb = 14,-6,-1
|
||||||
endif
|
endif
|
||||||
|
|
||||||
llr=2.0*rxdata/(ss*ss)
|
llr=2.0*rxdata/(ss*ss)
|
||||||
lratio=exp(llr)
|
|
||||||
yy=rxdata
|
|
||||||
|
|
||||||
apmask=0
|
apmask=0
|
||||||
! max_iterations is max number of belief propagation iterations
|
! 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 the decoder finds a valid codeword, nharderrors will be .ge. 0.
|
||||||
if( nharderrors .ge. 0 ) then
|
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
|
endif
|
||||||
else
|
|
||||||
nbadcrc=nbadcrc+1
|
|
||||||
nbadwt(nhw)=nbadwt(nhw)+1 ! store the weight of the error vector
|
|
||||||
endif
|
|
||||||
endif
|
endif
|
||||||
nsumerr=nsumerr+nerr
|
nsumerr=nsumerr+nerr
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
snr2500=db-2.5
|
snr2500=db-2.5
|
||||||
pberr=real(nsumerr)/real(ntrials*N)
|
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
|
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)
|
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
|
||||||
enddo
|
enddo
|
||||||
close(23)
|
close(23)
|
||||||
|
|
||||||
open(unit=25,file='badcrc_hamming_weight.dat',status='unknown')
|
open(unit=25,file='badcrc_hamming_weight.dat',status='unknown')
|
||||||
do i=0,N
|
do i=0,N
|
||||||
write(25,'(i4,2x,i10)') i,nbadwt(i)
|
write(25,'(i4,2x,i10)') i,nbadwt(i)
|
||||||
|
|
Loading…
Reference in New Issue