w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-22 04:11:16 -05:00
Code Issues Packages Projects Releases Wiki Activity

Working toward whole-hog switchover to new LDPC code with 77 bit messages in MSK144.

Browse Source
This commit is contained in:
Steve Franke 2018-07-07 09:44:52 -05:00
parent 42f75bf404
commit 622ed4a3ab
6 changed files with 405 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lib/bpdecode128_90.f90
View File

@ -8,18 +8,18 @@ subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter)
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 Nm(11,M)
integer Mn(3,N)
integer nrw(M)
integer synd(M)
real tov(4,N)
real toc(12,M)
real tanhtoc(12,M)
real toc(11,M)
real tanhtoc(11,M)
real zn(N)
real llr(N)
real Tmn
include "ldpc_128_90_b_reordered_parity.f90"
include "ldpc_128_90_reordered_parity.f90"
decoded=0
toc=0
@ -39,7 +39,7 @@ subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter)
! 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))
zn(i)=llr(i)+sum(tov(1:ncw,i))
else
zn(i)=llr(i)
endif
@ -74,7 +74,7 @@ subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter)
ncnt=ncnt+1
endif
! write(*,*) iter,ncheck,nd,ncnt
if( ncnt .ge. 5 .and. iter .ge. 10 .and. ncheck .gt. 15) then
if( ncnt .ge. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) then
nharderror=-1
return
endif
@ -86,7 +86,7 @@ subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter)
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
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
@ -96,11 +96,11 @@ subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter)
! send messages from check nodes to variable nodes
do i=1,M
tanhtoc(1:12,i)=tanh(-toc(1:12,i)/2)
tanhtoc(1:11,i)=tanh(-toc(1:11,i)/2)
enddo
do j=1,N
do i=1,ncw(j)
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)

116
lib/bpdecode128_90.f90.save Normal file
View File

@ -0,0 +1,116 @@
subroutine bpdecode128_90(llr,apmask,maxiterations,message77,cw,nharderror,iter)
!
! 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*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"
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
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. 3 .and. iter .ge. 5 .and. ncheck .gt. 10) 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
! 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
enddo
enddo
enddo
nharderror=-1
return
end subroutine bpdecode128_90

58
lib/encode_128_90.f90 Normal file
View File

@ -0,0 +1,58 @@
subroutine encode_128_90(message77,codeword)
!
! Add a 13-bit CRC to a 77-bit message and return a 128-bit codeword
!
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 message77(77),message(K)
integer*1 pchecks(M)
integer*1, target :: i1MsgBytes(12)
include "ldpc_128_90_generator.f90"
logical first
data first/.true./
save first,gen
if( first ) then ! fill the generator matrix
gen=0
do i=1,M
do j=1,23
read(g(i)(j:j),"(Z1)") istr
ibmax=4
if(j.eq.23) ibmax=2
do jj=1, ibmax
icol=(j-1)*4+jj
if( btest(istr,4-jj) ) gen(i,icol)=1
enddo
enddo
enddo
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
nsum=nsum+message(j)*gen(i,j)
enddo
pchecks(i)=mod(nsum,2)
enddo
codeword(1:K)=message
codeword(K+1:N)=pchecks
return
end subroutine encode_128_90

114
lib/genmsk_128_90.f90 Normal file
View File

@ -0,0 +1,114 @@
subroutine genmsk_128_90(msg0,mygrid,ichk,bcontest,msgsent,i4tone,itype)
! s8 + 48bits + s8 + 80 bits = 144 bits (72ms message duration)
!
! Encode an MSK144 message
! Input:
! - msg0 requested message to be transmitted
! - ichk if ichk=1, return only msgsent
! if ichk.ge.10000, set imsg=ichk-10000 for short msg
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, 0 or 1
! - itype message type
! 1 = standard message "Call_1 Call_2 Grid/Rpt"
! 2 = type 1 prefix
! 3 = type 1 suffix
! 4 = type 2 prefix
! 5 = type 2 suffix
! 6 = free text (up to 13 characters)
! 7 = short message "<Call_1 Call2> Rpt"
use iso_c_binding, only: c_loc,c_size_t
use packjt77
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
character*77 c77
character*6 mygrid
integer*4 i4tone(144)
integer*1 codeword(128)
integer*1 msgbits(77)
integer*1 bitseq(144) !Tone #s, data and sync (values 0-1)
integer*1 s8(8)
logical bcontest
real*8 pp(12)
real*8 xi(864),xq(864),pi,twopi
data s8/0,1,1,1,0,0,1,0/
equivalence (ihash,i1hash)
logical first
data first/.true./
save
if(first) then
first=.false.
nsym=128
pi=4.0*atan(1.0)
twopi=8.*atan(1.0)
do i=1,12
pp(i)=sin((i-1)*pi/12)
enddo
endif
if(msg0(1:1).eq.'@') then !Generate a fixed tone
read(msg0(2:5),*,end=1,err=1) nfreq !at specified frequency
go to 2
1 nfreq=1000
2 i4tone(1)=nfreq
else
message=msg0
do i=1,22
if(ichar(message(i:i)).eq.0) then
message(i:)=' '
exit
endif
enddo
do i=1,22 !Strip leading blanks
if(message(1:1).ne.' ') exit
message=message(i+1:)
enddo
if(message(1:1).eq.'<') then
call genmsk40(message,msgsent,ichk,i4tone,itype)
if(itype.lt.0) go to 999
i4tone(41)=-40
go to 999
endif
call pack77(message,i3,n3,c77)
call unpack77(c77,msgsent) !Unpack to get msgsent
if(ichk.eq.1) go to 999
read(c77,"77i1") msgbits
call encode_128_90(msgbits,codeword)
!Create 144-bit channel vector:
!8-bit sync word + 48 bits + 8-bit sync word + 80 bits
bitseq=0
bitseq(1:8)=s8
bitseq(9:56)=codeword(1:48)
bitseq(57:64)=s8
bitseq(65:144)=codeword(49:128)
bitseq=2*bitseq-1
xq(1:6)=bitseq(1)*pp(7:12) !first bit is mapped to 1st half-symbol on q
do i=1,71
is=(i-1)*12+7
xq(is:is+11)=bitseq(2*i+1)*pp
enddo
xq(864-5:864)=bitseq(1)*pp(1:6) !last half symbol
do i=1,72
is=(i-1)*12+1
xi(is:is+11)=bitseq(2*i)*pp
enddo
! Map I and Q to tones.
i4tone=0
do i=1,72
i4tone(2*i-1)=(bitseq(2*i)*bitseq(2*i-1)+1)/2;
i4tone(2*i)=-(bitseq(2*i)*bitseq(mod(2*i,144)+1)-1)/2;
enddo
endif
! Flip polarity
i4tone=-i4tone+1
999 return
end subroutine genmsk_128_90

46
lib/ldpcsim128_90.f90
View File

@ -1,10 +1,13 @@
program ldpcsim
program ldpcsim128_90
use packjt
! Simulate the performance of the (128,90) code that is used in
! the second incarnation of MSK144.
use packjt77
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*37 msg,msgsent,msgreceived
character*77 c77
character*8 arg
integer*1 codeword(N), message77(77)
integer*1 apmask(N),cw(N)
@ -35,32 +38,30 @@ read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
rate=real(K)/real(N)
rate=real(77)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," navg= ",navg," s= ",s
!msg="K9AN K1JT EN50"
msg="G4WJS K1JT FN20"
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent,.false.,' ') !Unpack to get msgsent
msg="K1ABC RR73; W9XYZ <KH1/KH7Z> -12"
i3=0
n3=1
call pack77(msg,i3,n3,c77)
call unpack77(c77,msgsent)
read(c77,'(77i1)') msgbits
write(*,*) "message sent ",msgsent
tmpchar=' '
write(tmpchar,'(12b6.6)') i4Msg6BitWords(1:12)
tmpchar(73:77)="00000" !i5bit
read(tmpchar,'(77i1)') msgbits(1:77)
write(*,*) 'msgbits'
write(*,'(28i1,1x,28i1,1x,16i1,1x,5i1)') msgbits
write(*,'(77i1)') msgbits
! msgbits is the 77-bit message, codeword is 128 bits
call encode128_90(msgbits,codeword)
call encode_128_90(msgbits,codeword)
call init_random_seed()
! call init_random_seed()
write(*,*) "Eb/N0 SNR2500 ngood nundetected sigma psymerr"
do idb = 14,-6,-1
do idb = 14,0,-1
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) )
ngood=0
@ -71,7 +72,7 @@ do idb = 14,-6,-1
do itrial=1, ntrials
rxavgd=0d0
do iav=1,navg
call sgran()
! call sgran()
! Create a realization of a noisy received word
do i=1,N
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
@ -105,7 +106,8 @@ do idb = 14,-6,-1
! If the decoder finds a valid codeword, nharderrors will be .ge. 0.
if( nharderrors .ge. 0 ) then
call extractmessage77(message77,msgreceived)
write(c77,'(77i1)') message77
call unpack77(c77,msgreceived)
nhw=count(cw.ne.codeword)
if(nhw.eq.0) then ! this is a good decode
ngood=ngood+1
@ -117,7 +119,7 @@ do idb = 14,-6,-1
nsumerr=nsumerr+nerr
enddo
snr2500=db-2.5
snr2500=db+10*log10(rate*2000.0/2500.0) ! symbol rate is 2000 s^-1 and ref BW is 2500 Hz.
pberr=real(nsumerr)/real(ntrials*N)
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,7x,f5.2,3x,e10.3)") db,snr2500,ngood,nue,ss,pberr
@ -129,4 +131,4 @@ do i=0,N
enddo
close(23)
end program ldpcsim
end program ldpcsim128_90

4
lib/ldpcsim144.f90
View File

@ -41,7 +41,7 @@ call getarg(4,arg)
read(arg,*) s
! don't count hash bits as data bits
K=80
K=72
N=128
rate=real(K)/real(N)
@ -161,7 +161,7 @@ do idb = 14,-6,-1
endif
endif
enddo
snr2500=db-3.0
snr2500=db-3.5
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2)") db,snr2500,ngood,nue,nbadhash,ss
enddo