WSJT-X/lib/fst4/get_fst4_bitmetrics.f90

158 lines
4.3 KiB
Fortran
Raw Normal View History

subroutine get_fst4_bitmetrics(cd,nss,hmod,nmax,nhicoh,bitmetrics,s4,nsync_qual,badsync)
2020-06-16 13:28:56 -04:00
use timer_module, only: timer
include 'fst4_params.f90'
2020-06-16 13:28:56 -04:00
complex cd(0:NN*nss-1)
complex cs(0:3,NN)
complex csymb(nss)
complex, allocatable, save :: c1(:,:) ! ideal waveforms, 20 samples per symbol, 4 tones
complex cp(0:3) ! accumulated phase shift over symbol types 0:3
complex csum,cterm
integer isyncword1(0:7),isyncword2(0:7)
2020-06-16 13:28:56 -04:00
integer graymap(0:3)
integer ip(1)
integer hmod
integer hbits(2*NN)
2020-06-16 13:28:56 -04:00
logical one(0:65535,0:15) ! 65536 8-symbol sequences, 16 bits
logical first
logical badsync
real bitmetrics(2*NN,4)
real s2(0:65535)
real s4(0:3,NN)
data isyncword1/0,1,3,2,1,0,2,3/
data isyncword2/2,3,1,0,3,2,0,1/
2020-06-16 13:28:56 -04:00
data graymap/0,1,3,2/
data first/.true./,nss0/-1/
save first,one,cp,nss0
2020-06-16 13:28:56 -04:00
if(nss.ne.nss0 .and. allocated(c1)) deallocate(c1)
if(first .or. nss.ne.nss0) then
2020-06-16 13:28:56 -04:00
allocate(c1(nss,0:3))
one=.false.
do i=0,65535
do j=0,15
if(iand(i,2**j).ne.0) one(i,j)=.true.
enddo
enddo
twopi=8.0*atan(1.0)
dphi=twopi*hmod/nss
do itone=0,3
dp=(itone-1.5)*dphi
phi=0.0
do j=1,nss
c1(j,itone)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dp,twopi)
enddo
cp(itone)=cmplx(cos(phi),sin(phi))
enddo
first=.false.
endif
do k=1,NN
i1=(k-1)*NSS
csymb=cd(i1:i1+NSS-1)
do itone=0,3
cs(itone,k)=sum(csymb*conjg(c1(:,itone)))
enddo
s4(0:3,k)=abs(cs(0:3,k))**2
2020-06-16 13:28:56 -04:00
enddo
! Sync quality check
is1=0
is2=0
is3=0
is4=0
is5=0
2020-06-16 13:28:56 -04:00
badsync=.false.
ibmax=0
do k=1,8
ip=maxloc(s4(:,k))
if(isyncword1(k-1).eq.(ip(1)-1)) is1=is1+1
2020-06-27 09:53:11 -04:00
ip=maxloc(s4(:,k+38))
if(isyncword2(k-1).eq.(ip(1)-1)) is2=is2+1
2020-06-27 09:53:11 -04:00
ip=maxloc(s4(:,k+76))
if(isyncword1(k-1).eq.(ip(1)-1)) is3=is3+1
2020-06-27 09:53:11 -04:00
ip=maxloc(s4(:,k+114))
if(isyncword2(k-1).eq.(ip(1)-1)) is4=is4+1
2020-06-27 09:53:11 -04:00
ip=maxloc(s4(:,k+152))
if(isyncword1(k-1).eq.(ip(1)-1)) is5=is5+1
2020-06-16 13:28:56 -04:00
enddo
2020-06-27 09:53:11 -04:00
nsync=is1+is2+is3+is4+is5 !Number of correct hard sync symbols, 0-40
2020-06-16 13:28:56 -04:00
badsync=.false.
if(nsync .lt. 16) then
badsync=.true.
return
endif
2020-06-16 13:28:56 -04:00
call timer('seqcorrs',0)
2020-06-16 13:28:56 -04:00
bitmetrics=0.0
do nseq=1,nmax !Try coherent sequences of 1,2,3,4 or 1,2,4,8 symbols
2020-06-16 13:28:56 -04:00
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nhicoh.eq.0) then
if(nseq.eq.3) nsym=3
if(nseq.eq.4) nsym=4
else
if(nseq.eq.3) nsym=4
if(nseq.eq.4) nsym=8
endif
2020-06-16 13:28:56 -04:00
nt=4**nsym
do ks=1,NN-nsym+1,nsym
s2=0
do i=0,nt-1
csum=0
! cterm=1 ! hmod.ne.1
term=1
2020-06-16 13:28:56 -04:00
do j=0,nsym-1
ntone=mod(i/4**(nsym-1-j),4)
csum=csum+cs(graymap(ntone),ks+j)*term
term=-term
! csum=csum+cs(graymap(ntone),ks+j)*cterm ! hmod.ne.1
! cterm=cterm*conjg(cp(graymap(ntone))) ! hmod.ne.1
2020-06-16 13:28:56 -04:00
enddo
s2(i)=abs(csum)
2020-06-16 13:28:56 -04:00
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
2020-07-02 15:48:11 -04:00
if(nsym.eq.3) ibmax=5
2020-06-16 13:28:56 -04:00
if(nsym.eq.4) ibmax=7
if(nsym.eq.8) ibmax=15
do ib=0,ibmax
bm=maxval(s2(0:nt-1),one(0:nt-1,ibmax-ib)) - &
maxval(s2(0:nt-1),.not.one(0:nt-1,ibmax-ib))
if(ipt+ib.gt.2*NN) cycle
bitmetrics(ipt+ib,nseq)=bm
enddo
enddo
enddo
call timer('seqcorrs',1)
2020-06-16 13:28:56 -04:00
hbits=0
where(bitmetrics(:,1).ge.0) hbits=1
ns1=count(hbits( 1: 16).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/))
ns2=count(hbits( 77: 92).eq.(/1,1,1,0,0,1,0,0,1,0,1,1,0,0,0,1/))
ns3=count(hbits(153:168).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/))
ns4=count(hbits(229:244).eq.(/1,1,1,0,0,1,0,0,1,0,1,1,0,0,0,1/))
ns5=count(hbits(305:320).eq.(/0,0,0,1,1,0,1,1,0,1,0,0,1,1,1,0/))
nsync_qual=ns1+ns2+ns3+ns4+ns5
if(nsync_qual.lt. 46) then
badsync=.true.
return
endif
2020-06-16 13:28:56 -04:00
call normalizebmet(bitmetrics(:,1),2*NN)
call normalizebmet(bitmetrics(:,2),2*NN)
call normalizebmet(bitmetrics(:,3),2*NN)
call normalizebmet(bitmetrics(:,4),2*NN)
scalefac=2.83
bitmetrics=scalefac*bitmetrics
2020-06-16 13:28:56 -04:00
return
end subroutine get_fst4_bitmetrics