mirror of
				https://github.com/saitohirga/WSJT-X.git
				synced 2025-10-31 04:50:34 -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
 |