w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2025-09-04 06:07:50 -04:00
Code Issues Packages Projects Releases Wiki Activity

More progress on sequence demodulator. Can now do nsymb=1,2, and/or 3.

Browse Source
This commit is contained in:
Steve Franke 2018-06-26 11:11:58 -05:00
parent 7684bd0e78
commit 03abada09b
1 changed files with 72 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
lib/ft8/ft8b_2.f90
View File

@ -13,18 +13,18 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
character*87 cbits character*87 cbits
logical bcontest logical bcontest
real a(5) real a(5)
real s8d(0:7,ND),s8(0:7,NN),s8dsort(8*ND) real s8(0:7,NN)
real s512(0:511) real s2(0:511),s2l(0:511)
real ps(0:512),psl(0:512)
real bmeta(3*ND),bmetb(3*ND),bmetc(3*ND),bmetap(3*ND) real bmeta(3*ND),bmetb(3*ND),bmetc(3*ND),bmetap(3*ND)
real bmetal(3*ND),bmetbl(3*ND),bmetcl(3*ND)
real llra(3*ND),llrb(3*ND),llrc(3*ND),llrd(3*ND) !Soft symbols real llra(3*ND),llrb(3*ND),llrc(3*ND),llrd(3*ND) !Soft symbols
real llral(3*ND),llrbl(3*ND),llrcl(3*ND) !Soft symbols
real dd0(15*12000) real dd0(15*12000)
integer*1 message77(77),apmask(3*ND),cw(3*ND) integer*1 message77(77),apmask(3*ND),cw(3*ND)
integer*1 msgbits(77) integer*1 msgbits(77)
integer apsym(77) integer apsym(77)
integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16) integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16)
integer itone(NN) integer itone(NN)
integer indxs8d(8*ND)
integer icos7(0:6),ip(1) integer icos7(0:6),ip(1)
integer nappasses(0:5) !Number of decoding passes to use for each QSO state integer nappasses(0:5) !Number of decoding passes to use for each QSO state
integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now integer naptypes(0:5,4) ! (nQSOProgress, decoding pass) maximum of 4 passes for now
@ -36,7 +36,6 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
complex csymb(32) complex csymb(32)
complex cs(0:7,NN) complex cs(0:7,NN)
logical first,newdat,lsubtract,lapon,lapcqonly,nagain logical first,newdat,lsubtract,lapon,lapcqonly,nagain
equivalence (s8d,s8dsort)
data icos7/3,1,4,0,6,5,2/ ! Flipped w.r.t. original FT8 sync array data icos7/3,1,4,0,6,5,2/ ! Flipped w.r.t. original FT8 sync array
data mcq/1,1,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,1,1,0,0,1/ data mcq/1,1,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,1,1,0,0,1/
data mrrr/0,1,1,1,1,1,1,0,1,1,0,0,1,1,1,1/ data mrrr/0,1,1,1,1,1,1,0,1,1,0,0,1,1,1,1/
@ -82,7 +81,6 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
do j=0,8 do j=0,8
if(iand(i,2**(8-j)).ne.0) bitisone(i,j)=.true. if(iand(i,2**(8-j)).ne.0) bitisone(i,j)=.true.
enddo enddo
write(*,*) i,bitisone(i,0:8)
enddo enddo
first=.false. first=.false.
endif endif
@ -141,10 +139,9 @@ write(*,*) i,bitisone(i,0:8)
csymb=cmplx(0.0,0.0) csymb=cmplx(0.0,0.0)
if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31) if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31)
call four2a(csymb,32,1,-1,1) call four2a(csymb,32,1,-1,1)
cs(0:7,k)=csymb(1:8) cs(0:7,k)=csymb(1:8)/1e3
s8(0:7,k)=abs(csymb(1:8))/1e3 s8(0:7,k)=abs(csymb(1:8))
enddo enddo
! sync quality check ! sync quality check
is1=0 is1=0
@ -166,85 +163,80 @@ write(*,*) i,bitisone(i,0:8)
return return
endif endif
j=0 do nsym=1,3
do k=1,NN nt=2**(3*nsym)
if(k.le.7) cycle do ihalf=1,2
if(k.ge.37 .and. k.le.43) cycle do k=1,29,nsym
if(k.gt.72) cycle if(ihalf.eq.1) ks=k+7
j=j+1 if(ihalf.eq.2) ks=k+43
s8d(0:7,j)=s8(0:7,k) amax=-1.0
enddo do i=0,nt-1
i1=i/64
call indexx(s8dsort,8*ND,indxs8d) i2=iand(i,63)/8
xmeds8d=s8dsort(indxs8d(nint(0.5*8*ND))) i3=iand(i,7)
s8d=s8d/xmeds8d if(nsym.eq.1) then
s2(i)=abs(cs(graymap(i3),ks))
do j=1,ND elseif(nsym.eq.2) then
i4=3*j-2 s2(i)=abs(cs(graymap(i2),ks)+cs(graymap(i3),ks+1))
i2=3*j-1 elseif(nsym.eq.3) then
i1=3*j s2(i)=abs(cs(graymap(i1),ks)+cs(graymap(i2),ks+1)+cs(graymap(i3),ks+2))
! Max amplitude else
ps(0:7)=s8d(0:7,j) print*,"Error - nsym must be 1, 2, or 3."
! For Gray bit-to-symbol mapping endif
r1=max(ps(1),ps(2),ps(5),ps(6))-max(ps(0),ps(3),ps(4),ps(7)) enddo
r2=max(ps(2),ps(3),ps(4),ps(5))-max(ps(0),ps(1),ps(6),ps(7)) i32=1+(k-1)*3+(ihalf-1)*87
r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3)) if(nsym.eq.1) then
bmeta(i4)=r4 do ib=0,2
bmeta(i2)=r2 bmeta(i32+ib)=maxval(s2(0:nt-1),bitisone(0:nt-1,6+ib)) - &
bmeta(i1)=r1 maxval(s2(0:nt-1),.not.bitisone(0:nt-1,6+ib))
! Max log metric s2l(0:nt-1)=log(s2(0:nt-1)+1e-32)
psl=log(ps+1e-32) bmetal(i32+ib)=maxval(s2l(0:nt-1),bitisone(0:nt-1,6+ib)) - &
! Gray bit-to-symbol mapping maxval(s2l(0:nt-1),.not.bitisone(0:nt-1,6+ib))
r1=max(psl(1),psl(2),psl(5),psl(6))-max(psl(0),psl(3),psl(4),ps(7)) enddo
r2=max(psl(2),psl(3),psl(4),psl(5))-max(psl(0),psl(1),psl(6),ps(7)) elseif(nsym.eq.2) then
r4=max(psl(4),psl(5),psl(6),psl(7))-max(psl(0),psl(1),psl(2),ps(3)) ibmax=5
bmetb(i4)=r4 if(k.eq.29) ibmax=2
bmetb(i2)=r2 do ib=0,ibmax
bmetb(i1)=r1 bmetb(i32+ib)=maxval(s2(0:nt-1),bitisone(0:nt-1,3+ib)) - &
enddo maxval(s2(0:nt-1),.not.bitisone(0:nt-1,3+ib))
s2l(0:nt-1)=log(s2(0:nt-1)+1e-32)
! Do 2-symbol detection bmetbl(i32+ib)=maxval(s2l(0:nt-1),bitisone(0:nt-1,3+ib)) - &
nsym=3 maxval(s2l(0:nt-1),.not.bitisone(0:nt-1,3+ib))
nt=2**(3*nsym) enddo
do ihalf=1,2 elseif(nsym.eq.3) then
do k=1,29,nsym ibmax=8
if(ihalf.eq.1) ks=k+7 if(k.eq.28) ibmax=5
if(ihalf.eq.2) ks=k+43 do ib=0,ibmax
amax=-1.0 bmetc(i32+ib)=maxval(s2(0:nt-1),bitisone(0:nt-1,ib)) - &
do i=0,nt-1 maxval(s2(0:nt-1),.not.bitisone(0:nt-1,ib))
i1=i/64 s2l(0:nt-1)=log(s2(0:nt-1)+1e-32)
i2=iand(i,63)/8 bmetcl(i32+ib)=maxval(s2l(0:nt-1),bitisone(0:nt-1,ib)) - &
i3=iand(i,7) maxval(s2l(0:nt-1),.not.bitisone(0:nt-1,ib))
s512(i)=abs(cs(graymap(i1),ks)+cs(graymap(i2),ks+1)+cs(graymap(i3),ks+2)) enddo
endif
enddo enddo
i32=1+(k-1)*3+(ihalf-1)*87
bmetc(i32)=maxval(s512,bitisone(0:nt-1,0))-maxval(s512,.not.bitisone(0:nt-1,0))
bmetc(i32+1)=maxval(s512,bitisone(0:nt-1,1))-maxval(s512,.not.bitisone(0:nt-1,1))
bmetc(i32+2)=maxval(s512,bitisone(0:nt-1,2))-maxval(s512,.not.bitisone(0:nt-1,2))
bmetc(i32+3)=maxval(s512,bitisone(0:nt-1,3))-maxval(s512,.not.bitisone(0:nt-1,3))
bmetc(i32+4)=maxval(s512,bitisone(0:nt-1,4))-maxval(s512,.not.bitisone(0:nt-1,4))
bmetc(i32+5)=maxval(s512,bitisone(0:nt-1,5))-maxval(s512,.not.bitisone(0:nt-1,5))
if(k.lt.28) then
bmetc(i32+6)=maxval(s512,bitisone(0:nt-1,6))-maxval(s512,.not.bitisone(0:nt-1,6))
bmetc(i32+7)=maxval(s512,bitisone(0:nt-1,7))-maxval(s512,.not.bitisone(0:nt-1,7))
bmetc(i32+8)=maxval(s512,bitisone(0:nt-1,8))-maxval(s512,.not.bitisone(0:nt-1,8))
endif
enddo enddo
enddo enddo
call normalizebmet(bmeta,3*ND) call normalizebmet(bmeta,3*ND)
call normalizebmet(bmetal,3*ND)
call normalizebmet(bmetb,3*ND) call normalizebmet(bmetb,3*ND)
call normalizebmet(bmetbl,3*ND)
call normalizebmet(bmetc,3*ND) call normalizebmet(bmetc,3*ND)
call normalizebmet(bmetcl,3*ND)
bmetap=bmeta bmetap=bmeta
do i=1,174 !do i=1,174
write(*,*) i,bmeta(i),bmetc(i) !write(*,*) i,bmeta(i),bmetc(i)
enddo !enddo
scalefac=2.83 scalefac=2.83
llra=scalefac*bmeta llra=scalefac*bmeta
llral=scalefac*bmetal
llrb=scalefac*bmetb llrb=scalefac*bmetb
llrbl=scalefac*bmetbl
llrc=scalefac*bmetc llrc=scalefac*bmetc
llrcl=scalefac*bmetcl
apmag=scalefac*(maxval(abs(bmetap))*1.01) apmag=scalefac*(maxval(abs(bmetap))*1.01)
! pass # ! pass #
@ -267,19 +259,20 @@ enddo
npasses=4 npasses=4
endif endif
do ipass=1,npasses ! do ipass=1,npasses
! do ipass=1,2 do ipass=1,3
llrd=llra llrd=llra
if(ipass.eq.2) llrd=llrb if(ipass.eq.2) llrd=llrb
! if(ipass.eq.3) llrd(1:24)=0.
if(ipass.eq.3) llrd=llrc if(ipass.eq.3) llrd=llrc
if(ipass.eq.4) llrd(1:48)=0. ! if(ipass.eq.3) llrd(1:24)=0.
if(ipass.eq.4) llrd(1:24)=0.
if(ipass.le.4) then if(ipass.le.4) then
apmask=0 apmask=0
iaptype=0 iaptype=0
endif endif
if(ipass .gt. 4) then if(ipass .gt. 4) then
llrd=llrb ! Needs to be checked
if(.not.lapcqonly) then if(.not.lapcqonly) then
iaptype=naptypes(nQSOProgress,ipass-4) iaptype=naptypes(nQSOProgress,ipass-4)
else else