diff --git a/lib/ft8/bpdecode174_91.f90 b/lib/ft8/bpdecode174_91.f90 index 12a5b347b..0a3cbb0d8 100644 --- a/lib/ft8/bpdecode174_91.f90 +++ b/lib/ft8/bpdecode174_91.f90 @@ -33,6 +33,7 @@ do j=1,M enddo ncnt=0 +nclast=0 do iter=0,maxiterations diff --git a/lib/jt65_decode.f90 b/lib/jt65_decode.f90 index bd198dab9..7e451bad3 100644 --- a/lib/jt65_decode.f90 +++ b/lib/jt65_decode.f90 @@ -102,7 +102,7 @@ contains if(nsubmode.ge.100) then ! This is QRA64 mode mode64=2**(nsubmode-100) - call qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & + call qra64a(dd,npts,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & emedelay,mycall,hiscall,hisgrid,sync,nsnr,dtx,nfreq,decoded,nft) if (associated(this%callback)) then ndrift=0 diff --git a/lib/osd128_90.f90 b/lib/osd128_90.f90 index d26aa4fea..75082bf59 100644 --- a/lib/osd128_90.f90 +++ b/lib/osd128_90.f90 @@ -1,88 +1,93 @@ subroutine osd128_90(llr,apmask,ndeep,message77,cw,nhardmin,dmin) -! -! An ordered-statistics decoder for the (128,90) code. -! -integer, parameter:: N=128, K=90, M=N-K -integer*1 apmask(N),apmaskr(N) -integer*1 gen(K,N) -integer*1 genmrb(K,N),g2(N,K) -integer*1 temp(K),m0(K),me(K),mi(K),misub(K),e2sub(N-K),e2(N-K),ui(N-K) -integer*1 r2pat(N-K) -integer indices(N),nxor(N) -integer*1 cw(N),ce(N),c0(N),hdec(N) -integer*1 decoded(K) -integer*1 message77(77) -integer indx(N) -real llr(N),rx(N),absrx(N) -include "ldpc_128_90_generator.f90" +! Ordered-statistics decoder for the (128,90) code. -logical first,reset -data first/.true./ -save first,gen + integer, parameter:: N=128, K=90, M=N-K + integer*1 apmask(N),apmaskr(N) + integer*1 gen(K,N) + integer*1 genmrb(K,N),g2(N,K) + integer*1 temp(K),m0(K),me(K),mi(K),misub(K),e2sub(N-K),e2(N-K),ui(N-K) + integer*1 r2pat(N-K) + integer indices(N),nxor(N) + integer*1 cw(N),ce(N),c0(N),hdec(N) + integer*1 decoded(K) + integer*1 message77(77) + integer indx(N) + real llr(N),rx(N),absrx(N) -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 - irow=(j-1)*4+jj - if( btest(istr,4-jj) ) gen(irow,K+i)=1 - enddo - enddo - enddo - do irow=1,K - gen(irow,irow)=1 - enddo -first=.false. -endif + include "ldpc_128_90_generator.f90" -rx=llr -apmaskr=apmask + logical first,reset + 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 + irow=(j-1)*4+jj + if( btest(istr,4-jj) ) gen(irow,K+i)=1 + enddo + enddo + enddo + do irow=1,K + gen(irow,irow)=1 + enddo + first=.false. + endif + + rx=llr + apmaskr=apmask + d1=0. + ntheta=0 + npre1=0 + npre2=0 + nt=0 ! Hard decisions on the received word. -hdec=0 -where(rx .ge. 0) hdec=1 + hdec=0 + where(rx .ge. 0) hdec=1 ! Use magnitude of received symbols as a measure of reliability. -absrx=abs(rx) -call indexx(absrx,N,indx) + absrx=abs(rx) + call indexx(absrx,N,indx) -! Re-order the columns of the generator matrix in order of decreasing reliability. -do i=1,N - genmrb(1:K,i)=gen(1:K,indx(N+1-i)) - indices(i)=indx(N+1-i) -enddo +! Re-order columns of generator matrix in order of decreasing reliability. + do i=1,N + genmrb(1:K,i)=gen(1:K,indx(N+1-i)) + indices(i)=indx(N+1-i) + enddo ! Do gaussian elimination to create a generator matrix with the most reliable ! received bits in positions 1:K in order of decreasing reliability (more or less). -do id=1,K ! diagonal element indices - do icol=id,K+20 ! The 20 is ad hoc - beware - iflag=0 - if( genmrb(id,icol) .eq. 1 ) then - iflag=1 - if( icol .ne. id ) then ! reorder column - temp(1:K)=genmrb(1:K,id) - genmrb(1:K,id)=genmrb(1:K,icol) - genmrb(1:K,icol)=temp(1:K) - itmp=indices(id) - indices(id)=indices(icol) - indices(icol)=itmp - endif - do ii=1,K - if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then - genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N)) + do id=1,K ! diagonal element indices + do icol=id,K+20 ! The 20 is ad hoc - beware + iflag=0 + if( genmrb(id,icol) .eq. 1 ) then + iflag=1 + if( icol .ne. id ) then ! reorder column + temp(1:K)=genmrb(1:K,id) + genmrb(1:K,id)=genmrb(1:K,icol) + genmrb(1:K,icol)=temp(1:K) + itmp=indices(id) + indices(id)=indices(icol) + indices(icol)=itmp + endif + do ii=1,K + if( ii .ne. id .and. genmrb(ii,id) .eq. 1 ) then + genmrb(ii,1:N)=ieor(genmrb(ii,1:N),genmrb(id,1:N)) + endif + enddo + exit endif - enddo - exit - endif + enddo enddo -enddo -g2=transpose(genmrb) + g2=transpose(genmrb) ! The hard decisions for the K MRB bits define the order 0 message, m0. ! Encode m0 using the modified generator matrix to find the "order 0" codeword. @@ -90,180 +95,180 @@ g2=transpose(genmrb) ! codewords. Return the member of the list that has the smallest Euclidean ! distance to the received word. -hdec=hdec(indices) ! hard decisions from received symbols -m0=hdec(1:K) ! zero'th order message -absrx=absrx(indices) -rx=rx(indices) -apmaskr=apmaskr(indices) + hdec=hdec(indices) ! hard decisions from received symbols + m0=hdec(1:K) ! zero'th order message + absrx=absrx(indices) + rx=rx(indices) + apmaskr=apmaskr(indices) -call mrbencode90(m0,c0,g2,N,K) -nxor=ieor(c0,hdec) -nhardmin=sum(nxor) -dmin=sum(nxor*absrx) + call mrbencode90(m0,c0,g2,N,K) + nxor=ieor(c0,hdec) + nhardmin=sum(nxor) + dmin=sum(nxor*absrx) -cw=c0 -ntotal=0 -nrejected=0 + cw=c0 + ntotal=0 + nrejected=0 -if(ndeep.eq.0) goto 998 ! norder=0 -if(ndeep.gt.5) ndeep=5 -if( ndeep.eq. 1) then - nord=1 - npre1=0 - npre2=0 - nt=12 - ntheta=3 -elseif(ndeep.eq.2) then - nord=1 - npre1=1 - npre2=0 - nt=18 - ntheta=4 -elseif(ndeep.eq.3) then - nord=1 - npre1=1 - npre2=0 - nt=12 - ntheta=4 -elseif(ndeep.eq.4) then - nord=1 - npre1=1 - npre2=1 - nt=12 - ntheta=4 - ntau=15 -elseif(ndeep.eq.5) then - nord=1 - npre1=1 - npre2=1 - nt=12 - ntheta=4 - ntau=5 -endif + if(ndeep.eq.0) goto 998 ! norder=0 + if(ndeep.gt.5) ndeep=5 + if( ndeep.eq. 1) then + nord=1 + npre1=0 + npre2=0 + nt=12 + ntheta=3 + elseif(ndeep.eq.2) then + nord=1 + npre1=1 + npre2=0 + nt=18 + ntheta=4 + elseif(ndeep.eq.3) then + nord=1 + npre1=1 + npre2=0 + nt=12 + ntheta=4 + elseif(ndeep.eq.4) then + nord=1 + npre1=1 + npre2=1 + nt=12 + ntheta=4 + ntau=15 + elseif(ndeep.eq.5) then + nord=1 + npre1=1 + npre2=1 + nt=12 + ntheta=4 + ntau=5 + endif -do iorder=1,nord - misub(1:K-iorder)=0 - misub(K-iorder+1:K)=1 - iflag=K-iorder+1 - do while(iflag .ge.0) - if(iorder.eq.nord .and. npre1.eq.0) then - iend=iflag - else - iend=1 - endif - do n1=iflag,iend,-1 - mi=misub - mi(n1)=1 - if(any(iand(apmaskr(1:K),mi).eq.1)) cycle - ntotal=ntotal+1 - me=ieor(m0,mi) - if(n1.eq.iflag) then - call mrbencode90(me,ce,g2,N,K) - e2sub=ieor(ce(K+1:N),hdec(K+1:N)) - e2=e2sub - nd1Kpt=sum(e2sub(1:nt))+1 - d1=sum(ieor(me(1:K),hdec(1:K))*absrx(1:K)) - else - e2=ieor(e2sub,g2(K+1:N,n1)) - nd1Kpt=sum(e2(1:nt))+2 - endif - if(nd1Kpt .le. ntheta) then - call mrbencode90(me,ce,g2,N,K) - nxor=ieor(ce,hdec) - if(n1.eq.iflag) then - dd=d1+sum(e2sub*absrx(K+1:N)) - else - dd=d1+ieor(ce(n1),hdec(n1))*absrx(n1)+sum(e2*absrx(K+1:N)) - endif - if( dd .lt. dmin ) then - dmin=dd - cw=ce - nhardmin=sum(nxor) - nd1Kptbest=nd1Kpt - endif - else - nrejected=nrejected+1 - endif - enddo + do iorder=1,nord + misub(1:K-iorder)=0 + misub(K-iorder+1:K)=1 + iflag=K-iorder+1 + do while(iflag .ge.0) + if(iorder.eq.nord .and. npre1.eq.0) then + iend=iflag + else + iend=1 + endif + do n1=iflag,iend,-1 + mi=misub + mi(n1)=1 + if(any(iand(apmaskr(1:K),mi).eq.1)) cycle + ntotal=ntotal+1 + me=ieor(m0,mi) + if(n1.eq.iflag) then + call mrbencode90(me,ce,g2,N,K) + e2sub=ieor(ce(K+1:N),hdec(K+1:N)) + e2=e2sub + nd1Kpt=sum(e2sub(1:nt))+1 + d1=sum(ieor(me(1:K),hdec(1:K))*absrx(1:K)) + else + e2=ieor(e2sub,g2(K+1:N,n1)) + nd1Kpt=sum(e2(1:nt))+2 + endif + if(nd1Kpt .le. ntheta) then + call mrbencode90(me,ce,g2,N,K) + nxor=ieor(ce,hdec) + if(n1.eq.iflag) then + dd=d1+sum(e2sub*absrx(K+1:N)) + else + dd=d1+ieor(ce(n1),hdec(n1))*absrx(n1)+sum(e2*absrx(K+1:N)) + endif + if( dd .lt. dmin ) then + dmin=dd + cw=ce + nhardmin=sum(nxor) + nd1Kptbest=nd1Kpt + endif + else + nrejected=nrejected+1 + endif + enddo ! Get the next test error pattern, iflag will go negative ! when the last pattern with weight iorder has been generated. - call nextpat90(misub,k,iorder,iflag) - enddo -enddo + call nextpat90(misub,k,iorder,iflag) + enddo + enddo -if(npre2.eq.1) then - reset=.true. - ntotal=0 - do i1=K,1,-1 - do i2=i1-1,1,-1 - ntotal=ntotal+1 - mi(1:ntau)=ieor(g2(K+1:K+ntau,i1),g2(K+1:K+ntau,i2)) - call boxit90(reset,mi(1:ntau),ntau,ntotal,i1,i2) - enddo - enddo + if(npre2.eq.1) then + reset=.true. + ntotal=0 + do i1=K,1,-1 + do i2=i1-1,1,-1 + ntotal=ntotal+1 + mi(1:ntau)=ieor(g2(K+1:K+ntau,i1),g2(K+1:K+ntau,i2)) + call boxit90(reset,mi(1:ntau),ntau,ntotal,i1,i2) + enddo + enddo - ncount2=0 - ntotal2=0 - reset=.true. + ncount2=0 + ntotal2=0 + reset=.true. ! Now run through again and do the second pre-processing rule - misub(1:K-nord)=0 - misub(K-nord+1:K)=1 - iflag=K-nord+1 - do while(iflag .ge.0) - me=ieor(m0,misub) - call mrbencode90(me,ce,g2,N,K) - e2sub=ieor(ce(K+1:N),hdec(K+1:N)) - do i2=0,ntau - ntotal2=ntotal2+1 - ui=0 - if(i2.gt.0) ui(i2)=1 - r2pat=ieor(e2sub,ui) -778 continue - call fetchit90(reset,r2pat(1:ntau),ntau,in1,in2) - if(in1.gt.0.and.in2.gt.0) then - ncount2=ncount2+1 - mi=misub - mi(in1)=1 - mi(in2)=1 - if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:K),mi).eq.1)) cycle - me=ieor(m0,mi) - call mrbencode90(me,ce,g2,N,K) - nxor=ieor(ce,hdec) - dd=sum(nxor*absrx) - if( dd .lt. dmin ) then - dmin=dd - cw=ce - nhardmin=sum(nxor) - endif - goto 778 - endif - enddo - call nextpat90(misub,K,nord,iflag) - enddo -endif + misub(1:K-nord)=0 + misub(K-nord+1:K)=1 + iflag=K-nord+1 + do while(iflag .ge.0) + me=ieor(m0,misub) + call mrbencode90(me,ce,g2,N,K) + e2sub=ieor(ce(K+1:N),hdec(K+1:N)) + do i2=0,ntau + ntotal2=ntotal2+1 + ui=0 + if(i2.gt.0) ui(i2)=1 + r2pat=ieor(e2sub,ui) +778 continue + call fetchit90(reset,r2pat(1:ntau),ntau,in1,in2) + if(in1.gt.0.and.in2.gt.0) then + ncount2=ncount2+1 + mi=misub + mi(in1)=1 + mi(in2)=1 + if(sum(mi).lt.nord+npre1+npre2.or.any(iand(apmaskr(1:K),mi).eq.1)) cycle + me=ieor(m0,mi) + call mrbencode90(me,ce,g2,N,K) + nxor=ieor(ce,hdec) + dd=sum(nxor*absrx) + if( dd .lt. dmin ) then + dmin=dd + cw=ce + nhardmin=sum(nxor) + endif + goto 778 + endif + enddo + call nextpat90(misub,K,nord,iflag) + enddo + endif 998 continue ! Re-order the codeword to [message bits][parity bits] format. -cw(indices)=cw -hdec(indices)=hdec -decoded=cw(1:K) -call chkcrc13a(decoded,nbadcrc) -message77=decoded(1:77) -if(nbadcrc.eq.1) nhardmin=-nhardmin + cw(indices)=cw + hdec(indices)=hdec + decoded=cw(1:K) + call chkcrc13a(decoded,nbadcrc) + message77=decoded(1:77) + if(nbadcrc.eq.1) nhardmin=-nhardmin -return + return end subroutine osd128_90 subroutine mrbencode90(me,codeword,g2,N,K) -integer*1 me(K),codeword(N),g2(N,K) + integer*1 me(K),codeword(N),g2(N,K) ! fast encoding for low-weight test patterns codeword=0 do i=1,K - if( me(i) .eq. 1 ) then - codeword=ieor(codeword,g2(1:N,i)) - endif + if( me(i) .eq. 1 ) then + codeword=ieor(codeword,g2(1:N,i)) + endif enddo -return + return end subroutine mrbencode90 subroutine nextpat90(mi,k,iorder,iflag) @@ -274,8 +279,8 @@ subroutine nextpat90(mi,k,iorder,iflag) if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i enddo if( ind .lt. 0 ) then ! no more patterns of this order - iflag=ind - return + iflag=ind + return endif ms=0 ms(1:ind-1)=mi(1:ind-1) @@ -287,45 +292,45 @@ subroutine nextpat90(mi,k,iorder,iflag) endif mi=ms do i=1,k ! iflag will point to the lowest-index 1 in mi - if(mi(i).eq.1) then - iflag=i - exit - endif + if(mi(i).eq.1) then + iflag=i + exit + endif enddo return end subroutine nextpat90 subroutine boxit90(reset,e2,ntau,npindex,i1,i2) integer*1 e2(1:ntau) - integer indexes(5000,2),fp(0:525000),np(5000) + integer indexes(5000,2),fp(0:525000),np(5000) logical reset common/boxes/indexes,fp,np if(reset) then - patterns=-1 - fp=-1 - np=-1 - sc=-1 - indexes=-1 - reset=.false. + patterns=-1 + fp=-1 + np=-1 + sc=-1 + indexes=-1 + reset=.false. endif indexes(npindex,1)=i1 indexes(npindex,2)=i2 ipat=0 do i=1,ntau - if(e2(i).eq.1) then - ipat=ipat+ishft(1,ntau-i) - endif + if(e2(i).eq.1) then + ipat=ipat+ishft(1,ntau-i) + endif enddo ip=fp(ipat) ! see what's currently stored in fp(ipat) if(ip.eq.-1) then - fp(ipat)=npindex + fp(ipat)=npindex else do while (np(ip).ne.-1) - ip=np(ip) - enddo + ip=np(ip) + enddo np(ip)=npindex endif return @@ -340,15 +345,15 @@ subroutine fetchit90(reset,e2,ntau,i1,i2) save lastpat,inext if(reset) then - lastpat=-1 - reset=.false. + lastpat=-1 + reset=.false. endif ipat=0 do i=1,ntau - if(e2(i).eq.1) then - ipat=ipat+ishft(1,ntau-i) - endif + if(e2(i).eq.1) then + ipat=ipat+ishft(1,ntau-i) + endif enddo index=fp(ipat) @@ -368,4 +373,3 @@ subroutine fetchit90(reset,e2,ntau,i1,i2) lastpat=ipat return end subroutine fetchit90 - diff --git a/lib/qra64a.f90 b/lib/qra64a.f90 index 56d59e52d..9116c53a2 100644 --- a/lib/qra64a.f90 +++ b/lib/qra64a.f90 @@ -1,4 +1,4 @@ -subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & +subroutine qra64a(dd,npts,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & emedelay,mycall_12,hiscall_12,hisgrid_6,sync,nsnr,dtx,nfreq,decoded,nft) use packjt @@ -151,8 +151,5 @@ subroutine qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & endif call timer('qra64a ',1) -! write(71,3001) nutc,dtx,f0,sync,sync2,width,minsync,decoded -!3001 format(i4.4,f7.2,4f8.1,i3,2x,a22) - return end subroutine qra64a diff --git a/lib/qratest.f90 b/lib/qratest.f90 index 2b5de8c1c..8e46c8051 100644 --- a/lib/qratest.f90 +++ b/lib/qratest.f90 @@ -39,7 +39,7 @@ program qratest if(nfqso0.ne.-1) nfqso=nfqso0 if(ntol0.ne.-1) ntol=ntol0 - call qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & + call qra64a(dd,npts,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, & mycall,hiscall,hisgrid,sync,nsnr,dtx,nfreq,decoded,nft) c='a' if(mode64.eq.2) c='b'