mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-10-30 20:40:28 -04:00 
			
		
		
		
	
		
			
	
	
		
			117 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
		
		
			
		
	
	
			117 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
|  | 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 |