w4kek
/
WSJT-X
mirror of https://github.com/saitohirga/WSJT-X.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Make two sync passes, one for each sync array. Label candidates with their type and decode accordingly.

This commit is contained in:
Steve Franke 2018-06-05 16:37:29 -05:00
parent 772b1bd5fa
commit 48b60eab71
16 changed files with 558 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
CMakeLists.txt
View File

@ -374,7 +374,7 @@ set (wsjt_FSRCS
lib/fsk4hf/bpdecode120.f90
lib/fsk4hf/bpdecode168.f90
lib/ft8/bpdecode174.f90
lib/fsk4hf/bpdecode174_91.f90
lib/ft8/bpdecode174_91.f90
lib/fsk4hf/bpdecode300.f90
lib/fsk4hf/bpdecode204.f90
lib/baddata.f90
@ -384,6 +384,7 @@ set (wsjt_FSRCS
lib/fsk4hf/chkcrc10.f90
lib/fsk4hf/chkcrc12.f90
lib/ft8/chkcrc12a.f90
lib/ft8/chkcrc14a.f90
lib/chkcall.f90
lib/chkhist.f90
lib/chkmsg.f90
@ -411,7 +412,7 @@ set (wsjt_FSRCS
lib/fsk4hf/encode120.f90
lib/fsk4hf/encode168.f90
lib/ft8/encode174.f90
lib/fsk4hf/encode174_91.f90
lib/ft8/encode174_91.f90
lib/fsk4hf/encode300.f90
lib/fsk4hf/encode204.f90
lib/entail.f90
@ -421,7 +422,7 @@ set (wsjt_FSRCS
lib/extractmessage144.f90
lib/fsk4hf/extractmessage168.f90
lib/ft8/extractmessage174.f90
lib/fsk4hf/extractmessage174_91.f90
lib/ft8/extractmessage174_91.f90
lib/fano232.f90
lib/fast9.f90
lib/fast_decode.f90
@ -452,7 +453,8 @@ set (wsjt_FSRCS
lib/freqcal.f90
lib/fsk4hf/fsk4hf.f90
lib/ft8/ft8apset.f90
lib/ft8/ft8b.f90
lib/ft8/ft8b_1.f90
lib/ft8/ft8b_2.f90
lib/ft8/ft8code.f90
lib/ft8/ft8_downsample.f90
lib/ft8/ft8sim.f90
@ -502,7 +504,7 @@ set (wsjt_FSRCS
lib/fsk4hf/ldpcsim120.f90
lib/fsk4hf/ldpcsim168.f90
lib/ft8/ldpcsim174.f90
lib/fsk4hf/ldpcsim174_91.f90
lib/ft8/ldpcsim174_91.f90
lib/fsk4hf/ldpcsim300.f90
lib/fsk4hf/ldpcsim204.f90
lib/ldpcsim40.f90
@ -532,7 +534,7 @@ set (wsjt_FSRCS
lib/fsk4hf/msksoftsym.f90
lib/fsk4hf/msksoftsymw.f90
lib/ft8/osd174.f90
lib/fsk4hf/osd174_91.f90
lib/ft8/osd174_91.f90
lib/fsk4hf/osd300.f90
lib/fsk4hf/osd204.f90
lib/pctile.f90
@ -1239,7 +1241,7 @@ target_link_libraries (ldpcsim120 wsjt_fort wsjt_cxx)
add_executable (ldpcsim174 lib/ft8/ldpcsim174.f90 wsjtx.rc)
target_link_libraries (ldpcsim174 wsjt_fort wsjt_cxx)
add_executable (ldpcsim174_91 lib/fsk4hf/ldpcsim174_91.f90 wsjtx.rc)
add_executable (ldpcsim174_91 lib/ft8/ldpcsim174_91.f90 wsjtx.rc)
target_link_libraries (ldpcsim174_91 wsjt_fort wsjt_cxx)
add_executable (ldpcsim144 lib/ldpcsim144.f90 wsjtx.rc)

BIN
lib/ft8/.sync8.f90.swp Normal file
View File

Binary file not shown.

0
lib/fsk4hf/bpdecode174_91.f90 → lib/ft8/bpdecode174_91.f90
View File

24
lib/ft8/chkcrc14a.f90 Normal file
View File

@ -0,0 +1,24 @@
subroutine chkcrc14a(decoded,nbadcrc)
use crc
integer*1 decoded(91)
integer*1, target:: i1Dec8BitBytes(12)
character*91 cbits
! Write decoded bits into cbits: 77-bit message plus 14-bit CRC
write(cbits,1000) decoded
1000 format(91i1)
read(cbits,1001) i1Dec8BitBytes
1001 format(12b8)
read(cbits,1002) ncrc14 !Received CRC14
1002 format(77x,b14)
i1Dec8BitBytes(10)=iand(i1Dec8BitBytes(10),128+64+32+16+8)
i1Dec8BitBytes(11:12)=0
icrc14=crc14(c_loc(i1Dec8BitBytes),12) !CRC14 computed from 77 msg bits
nbadcrc=1
if(ncrc14.eq.icrc14) nbadcrc=0
return
end subroutine chkcrc14a

0
lib/fsk4hf/encode174_91.f90 → lib/ft8/encode174_91.f90
View File

0
lib/fsk4hf/extractmessage174_91.f90 → lib/ft8/extractmessage174_91.f90
View File

10
lib/ft8/ft8b.f90 → lib/ft8/ft8b_1.f90
View File

@ -1,4 +1,4 @@
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
subroutine ft8b_1(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,hiscall12,bcontest, &
sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr)
@ -89,7 +89,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal
smax=0.0
do idt=i0-8,i0+8 !Search over +/- one quarter symbol
call sync8d(cd0,idt,ctwk,0,sync)
call sync8d(cd0,idt,ctwk,0,1,sync)
if(sync.gt.smax) then
smax=sync
ibest=idt
@ -108,7 +108,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
call sync8d(cd0,i0,ctwk,1,sync)
call sync8d(cd0,i0,ctwk,1,1,sync)
if( sync .gt. smax ) then
smax=sync
delfbest=delf
@ -120,7 +120,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
xdt=xdt2
f1=f1+delfbest !Improved estimate of DF
call sync8d(cd0,i0,ctwk,2,sync)
call sync8d(cd0,i0,ctwk,2,1,sync)
j=0
do k=1,NN
@ -437,7 +437,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
enddo
return
end subroutine ft8b
end subroutine ft8b_1
subroutine normalizebmet(bmet,n)
real bmet(n)

457
lib/ft8/ft8b_2.f90 Normal file
View File

@ -0,0 +1,457 @@
subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,hiscall12,bcontest, &
sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr)
use crc
use timer_module, only: timer
include 'ft8_params.f90'
parameter(NP2=2812)
character*37 msg37
character message*22,msgsent*22
character*12 mycall12,hiscall12
character*6 mycall6,mygrid6,hiscall6,c1,c2
character*87 cbits
logical bcontest
real a(5)
real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND)
real ps(0:7),psl(0:7)
real bmeta(3*ND),bmetb(3*ND),bmetap(3*ND)
real llr(3*ND),llra(3*ND),llr0(3*ND),llr1(3*ND),llrap(3*ND) !Soft symbols
real dd0(15*12000)
integer*1 decoded(91),decoded0(91),apmask(3*ND),cw(3*ND)
integer*1 msgbits(91)
integer apsym(91)
integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16)
integer itone(NN)
integer indxs1(8*ND)
integer icos7(0:6),ip(1)
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*1, target:: i1hiscall(12)
complex cd0(3200)
complex ctwk(32)
complex csymb(32)
logical first,newdat,lsubtract,lapon,lapcqonly,nagain
equivalence (s1,s1sort)
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 mrrr/0,1,1,1,1,1,1,0,1,1,0,0,1,1,1,1/
data m73/0,1,1,1,1,1,1,0,1,1,0,1,0,0,0,0/
data mde/1,1,1,1,1,1,1,1,0,1,1,0,0,1,0,0,0,0,0,1,1,1,0,1,0,0,0,1/
data mrr73/0,0,0,0,0,0,1,0,0,0,0,1,0,1,0,1/
data first/.true./
save nappasses,naptypes
if(first) then
mcq=2*mcq-1
mde=2*mde-1
mrrr=2*mrrr-1
m73=2*m73-1
mrr73=2*mrr73-1
nappasses(0)=2
nappasses(1)=2
nappasses(2)=2
nappasses(3)=4
nappasses(4)=4
nappasses(5)=3
! iaptype
!------------------------
! 1 CQ ??? ???
! 2 MyCall ??? ???
! 3 MyCall DxCall ???
! 4 MyCall DxCall RRR
! 5 MyCall DxCall 73
! 6 MyCall DxCall RR73
! 7 ??? DxCall ???
naptypes(0,1:4)=(/1,2,0,0/)
naptypes(1,1:4)=(/2,3,0,0/)
naptypes(2,1:4)=(/2,3,0,0/)
naptypes(3,1:4)=(/3,4,5,6/)
naptypes(4,1:4)=(/3,4,5,6/)
naptypes(5,1:4)=(/3,1,2,0/)
first=.false.
endif
max_iterations=30
nharderrors=-1
fs2=12000.0/NDOWN
dt2=1.0/fs2
twopi=8.0*atan(1.0)
delfbest=0.
ibest=0
call timer('ft8_down',0)
call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample
call timer('ft8_down',1)
i0=nint((xdt+0.5)*fs2) !Initial guess for start of signal
smax=0.0
do idt=i0-8,i0+8 !Search over +/- one quarter symbol
call sync8d(cd0,idt,ctwk,0,2,sync)
if(sync.gt.smax) then
smax=sync
ibest=idt
endif
enddo
xdt2=ibest*dt2 !Improved estimate for DT
! Now peak up in frequency
i0=nint(xdt2*fs2)
smax=0.0
do ifr=-5,5 !Search over +/- 2.5 Hz
delf=ifr*0.5
dphi=twopi*delf*dt2
phi=0.0
do i=1,32
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
call sync8d(cd0,i0,ctwk,1,2,sync)
if( sync .gt. smax ) then
smax=sync
delfbest=delf
endif
enddo
a=0.0
a(1)=-delfbest
call twkfreq1(cd0,NP2,fs2,a,cd0)
xdt=xdt2
f1=f1+delfbest !Improved estimate of DF
call sync8d(cd0,i0,ctwk,2,2,sync)
j=0
do k=1,NN
i1=ibest+(k-1)*32
csymb=cmplx(0.0,0.0)
if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31)
call four2a(csymb,32,1,-1,1)
s2(0:7,k)=abs(csymb(1:8))/1e3
enddo
! sync quality check
is1=0
is2=0
is3=0
do k=1,7
ip=maxloc(s2(:,k))
if(icos7(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s2(:,k+36))
if(icos7(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s2(:,k+72))
if(icos7(k-1).eq.(ip(1)-1)) is3=is3+1
enddo
! hard sync sum - max is 21
nsync=is1+is2+is3
if(nsync .le. 6) then ! bail out
nbadcrc=1
return
endif
j=0
do k=1,NN
if(k.le.7) cycle
if(k.ge.37 .and. k.le.43) cycle
if(k.gt.72) cycle
j=j+1
s1(0:7,j)=s2(0:7,k)
enddo
call indexx(s1sort,8*ND,indxs1)
xmeds1=s1sort(indxs1(nint(0.5*8*ND)))
s1=s1/xmeds1
do j=1,ND
i4=3*j-2
i2=3*j-1
i1=3*j
! Max amplitude
ps=s1(0:7,j)
r1=max(ps(1),ps(3),ps(5),ps(7))-max(ps(0),ps(2),ps(4),ps(6))
r2=max(ps(2),ps(3),ps(6),ps(7))-max(ps(0),ps(1),ps(4),ps(5))
r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3))
bmeta(i4)=r4
bmeta(i2)=r2
bmeta(i1)=r1
bmetap(i4)=r4
bmetap(i2)=r2
bmetap(i1)=r1
! Max log metric
psl=log(ps)
r1=max(psl(1),psl(3),psl(5),psl(7))-max(psl(0),psl(2),psl(4),psl(6))
r2=max(psl(2),psl(3),psl(6),psl(7))-max(psl(0),psl(1),psl(4),psl(5))
r4=max(psl(4),psl(5),psl(6),psl(7))-max(psl(0),psl(1),psl(2),psl(3))
bmetb(i4)=r4
bmetb(i2)=r2
bmetb(i1)=r1
! Metric for Cauchy noise
! r1=log(ps(1)**3+ps(3)**3+ps(5)**3+ps(7)**3)- &
! log(ps(0)**3+ps(2)**3+ps(4)**3+ps(6)**3)
! r2=log(ps(2)**3+ps(3)**3+ps(6)**3+ps(7)**3)- &
! log(ps(0)**3+ps(1)**3+ps(4)**3+ps(5)**3)
! r4=log(ps(4)**3+ps(5)**3+ps(6)**3+ps(7)**3)- &
! log(ps(0)**3+ps(1)**3+ps(2)**3+ps(3)**3)
! Metric for AWGN, no fading
! bscale=2.5
! b0=bessi0(bscale*ps(0))
! b1=bessi0(bscale*ps(1))
! b2=bessi0(bscale*ps(2))
! b3=bessi0(bscale*ps(3))
! b4=bessi0(bscale*ps(4))
! b5=bessi0(bscale*ps(5))
! b6=bessi0(bscale*ps(6))
! b7=bessi0(bscale*ps(7))
! r1=log(b1+b3+b5+b7)-log(b0+b2+b4+b6)
! r2=log(b2+b3+b6+b7)-log(b0+b1+b4+b5)
! r4=log(b4+b5+b6+b7)-log(b0+b1+b2+b3)
if(nQSOProgress .eq. 0 .or. nQSOProgress .eq. 5) then
! When bits 88:115 are set as ap bits, bit 115 lives in symbol 39 along
! with no-ap bits 116 and 117. Take care of metrics for bits 116 and 117.
if(j.eq.39) then ! take care of bits that live in symbol 39
if(apsym(28).lt.0) then
bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1))
bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2))
else
bmetap(i2)=max(ps(6),ps(7))-max(ps(4),ps(5))
bmetap(i1)=max(ps(5),ps(7))-max(ps(4),ps(6))
endif
endif
endif
! When bits 116:143 are set as ap bits, bit 115 lives in symbol 39 along
! with ap bits 116 and 117. Take care of metric for bit 115.
! if(j.eq.39) then ! take care of bit 115
! iii=2*(apsym(29)+1)/2 + (apsym(30)+1)/2 ! known values of bits 116 & 117
! if(iii.eq.0) bmetap(i4)=ps(4)-ps(0)
! if(iii.eq.1) bmetap(i4)=ps(5)-ps(1)
! if(iii.eq.2) bmetap(i4)=ps(6)-ps(2)
! if(iii.eq.3) bmetap(i4)=ps(7)-ps(3)
! endif
! bit 144 lives in symbol 48 and will be 1 if it is set as an ap bit.
! take care of metrics for bits 142 and 143
if(j.eq.48) then ! bit 144 is always 1
bmetap(i4)=max(ps(5),ps(7))-max(ps(1),ps(3))
bmetap(i2)=max(ps(3),ps(7))-max(ps(1),ps(5))
endif
! bit 154 lives in symbol 52 and will be 0 if it is set as an ap bit
! take care of metrics for bits 155 and 156
if(j.eq.52) then ! bit 154 will be 0 if it is set as an ap bit.
bmetap(i2)=max(ps(2),ps(3))-max(ps(0),ps(1))
bmetap(i1)=max(ps(1),ps(3))-max(ps(0),ps(2))
endif
enddo
call normalizebmet(bmeta,3*ND)
call normalizebmet(bmetb,3*ND)
call normalizebmet(bmetap,3*ND)
scalefac=2.83
llr0=scalefac*bmeta
llr1=scalefac*bmetb
llra=scalefac*bmetap ! llr's for use with ap
apmag=scalefac*(maxval(abs(bmetap))*1.01)
! pass #
!------------------------------
! 1 regular decoding
! 2 erase 24
! 3 erase 48
! 4 ap pass 1
! 5 ap pass 2
! 6 ap pass 3
! 7 ap pass 4, etc.
if(lapon) then
if(.not.lapcqonly) then
npasses=4+nappasses(nQSOProgress)
else
npasses=5
endif
else
npasses=4
endif
do ipass=1,npasses
llr=llr0
if(ipass.eq.2) llr=llr1
if(ipass.eq.3) llr(1:24)=0.
if(ipass.eq.4) llr(1:48)=0.
if(ipass.le.4) then
apmask=0
llrap=llr
iaptype=0
endif
if(ipass .gt. 4) then
if(.not.lapcqonly) then
iaptype=naptypes(nQSOProgress,ipass-4)
else
iaptype=1
endif
if(iaptype.ge.3 .and. (abs(f1-nfqso).gt.napwid .and. abs(f1-nftx).gt.napwid) ) cycle
if(iaptype.eq.1 .or. iaptype.eq.2 ) then ! AP,???,???
apmask=0
apmask(88:115)=1 ! first 28 bits are AP
apmask(144)=1 ! not free text
llrap=llr
if(iaptype.eq.1) llrap(88:115)=apmag*mcq
if(iaptype.eq.2) llrap(88:115)=apmag*apsym(1:28)
llrap(116:117)=llra(116:117)
llrap(142:143)=llra(142:143)
llrap(144)=-apmag
endif
if(iaptype.eq.3) then ! mycall, dxcall, ???
apmask=0
apmask(88:115)=1 ! mycall
apmask(116:143)=1 ! hiscall
apmask(144)=1 ! not free text
llrap=llr
llrap(88:143)=apmag*apsym(1:56)
llrap(144)=-apmag
endif
if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then
apmask=0
apmask(88:115)=1 ! mycall
apmask(116:143)=1 ! hiscall
apmask(144:159)=1 ! RRR or 73 or RR73
llrap=llr
llrap(88:143)=apmag*apsym(1:56)
if(iaptype.eq.4) llrap(144:159)=apmag*mrrr
if(iaptype.eq.5) llrap(144:159)=apmag*m73
if(iaptype.eq.6) llrap(144:159)=apmag*mrr73
endif
if(iaptype.eq.7) then ! ???, dxcall, ???
apmask=0
apmask(116:143)=1 ! hiscall
apmask(144)=1 ! not free text
llrap=llr
llrap(115)=llra(115)
llrap(116:143)=apmag*apsym(29:56)
llrap(144)=-apmag
endif
endif
cw=0
call timer('bpd174_91 ',0)
call bpdecode174_91(llrap,apmask,max_iterations,decoded,cw,nharderrors, &
niterations)
call timer('bpd174_91 ',1)
dmin=0.0
if(ndepth.eq.3 .and. nharderrors.lt.0) then
ndeep=3
if(abs(nfqso-f1).le.napwid .or. abs(nftx-f1).le.napwid) then
if((ipass.eq.3 .or. ipass.eq.4) .and. .not.nagain) then
ndeep=3
else
ndeep=4
endif
endif
if(nagain) ndeep=5
call timer('osd174_91 ',0)
call osd174_91(llrap,apmask,ndeep,decoded,cw,nharderrors,dmin)
call timer('osd174_91 ',1)
endif
nbadcrc=1
message=' '
xsnr=-99.0
if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword
if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. &
.not.(sync.lt.2.0 .and. nharderrors.gt.35) .and. &
.not.(ipass.gt.2 .and. nharderrors.gt.39) .and. &
.not.(ipass.eq.4 .and. nharderrors.gt.30) &
) then
call chkcrc14a(decoded,nbadcrc)
else
nharderrors=-1
cycle
endif
i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
iFreeText=decoded(57)
if(nbadcrc.eq.0) then
decoded0=decoded
if(i3bit.eq.1) decoded(57:)=0
call extractmessage174_91(decoded,message,ncrcflag)
decoded=decoded0
! This needs fixing for messages with i3bit=1:
call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
if(lsubtract) call subtractft8(dd0,itone,f1,xdt2)
xsig=0.0
xnoi=0.0
do i=1,79
xsig=xsig+s2(itone(i),i)**2
ios=mod(itone(i)+4,7)
xnoi=xnoi+s2(ios,i)**2
enddo
xsnr=0.001
if(xnoi.gt.0 .and. xnoi.lt.xsig) xsnr=xsig/xnoi-1.0
xsnr=10.0*log10(xsnr)-27.0
xsnr2=db(xsig/xbase - 1.0) - 32.0
if(.not.nagain) xsnr=xsnr2
if(xsnr .lt. -24.0) xsnr=-24.0
if(i3bit.eq.1) then
do i=1,12
i1hiscall(i)=ichar(hiscall12(i:i))
enddo
icrc10=crc10(c_loc(i1hiscall),12)
write(cbits,1001) decoded
1001 format(87i1)
read(cbits,1002) ncrc10,nrpt
1002 format(56x,b10,b6)
irpt=nrpt-30
i1=index(message,' ')
i2=index(message(i1+1:),' ') + i1
c1=message(1:i1)//' '
c2=message(i1+1:i2)//' '
if(ncrc10.eq.icrc10) msg37=c1//' RR73; '//c2//' <'// &
trim(hiscall12)//'> '
if(ncrc10.ne.icrc10) msg37=c1//' RR73; '//c2//' <...> '
! msg37=c1//' RR73; '//c2//' <...> '
write(msg37(35:37),1010) irpt
1010 format(i3.2)
if(msg37(35:35).ne.'-') msg37(35:35)='+'
iz=len(trim(msg37))
do iter=1,10 !Collapse multiple blanks
ib2=index(msg37(1:iz),' ')
if(ib2.lt.1) exit
msg37=msg37(1:ib2)//msg37(ib2+2:)
iz=iz-1
enddo
else
msg37=message//' '
endif
return
endif
enddo
return
end subroutine ft8b_2
!subroutine normalizebmet(bmet,n)
! real bmet(n)
!
! bmetav=sum(bmet)/real(n)
! bmet2av=sum(bmet*bmet)/real(n)
! var=bmet2av-bmetav*bmetav
! if( var .gt. 0.0 ) then
! bmetsig=sqrt(var)
! else
! bmetsig=sqrt(bmet2av)
! endif
! bmet=bmet/bmetsig
! return
!end subroutine normalizebmet

0
lib/fsk4hf/ldpc_174_91_c_colorder.f90 → lib/ft8/ldpc_174_91_c_colorder.f90
View File

0
lib/fsk4hf/ldpc_174_91_c_generator.f90 → lib/ft8/ldpc_174_91_c_generator.f90
View File

0
lib/fsk4hf/ldpc_174_91_c_parity.f90 → lib/ft8/ldpc_174_91_c_parity.f90
View File

0
lib/fsk4hf/ldpcsim174_91.f90 → lib/ft8/ldpcsim174_91.f90
View File

34
lib/fsk4hf/osd174_91.f90 → lib/ft8/osd174_91.f90
View File

@ -98,7 +98,7 @@ absrx=absrx(indices)
rx=rx(indices)
apmaskr=apmaskr(indices)
call mrbencode(m0,c0,g2,N,K)
call mrbencode91(m0,c0,g2,N,K)
nxor=ieor(c0,hdec)
nhardmin=sum(nxor)
dmin=sum(nxor*absrx)
@ -161,7 +161,7 @@ do iorder=1,nord
ntotal=ntotal+1
me=ieor(m0,mi)
if(n1.eq.iflag) then
call mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
e2sub=ieor(ce(K+1:N),hdec(K+1:N))
e2=e2sub
nd1Kpt=sum(e2sub(1:nt))+1
@ -171,7 +171,7 @@ do iorder=1,nord
nd1Kpt=sum(e2(1:nt))+2
endif
if(nd1Kpt .le. ntheta) then
call mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
nxor=ieor(ce,hdec)
if(n1.eq.iflag) then
dd=d1+sum(e2sub*absrx(K+1:N))
@ -190,7 +190,7 @@ do iorder=1,nord
enddo
! Get the next test error pattern, iflag will go negative
! when the last pattern with weight iorder has been generated.
call nextpat(misub,k,iorder,iflag)
call nextpat91(misub,k,iorder,iflag)
enddo
enddo
@ -201,7 +201,7 @@ if(npre2.eq.1) then
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 boxit(reset,mi(1:ntau),ntau,ntotal,i1,i2)
call boxit91(reset,mi(1:ntau),ntau,ntotal,i1,i2)
enddo
enddo
@ -214,7 +214,7 @@ if(npre2.eq.1) then
iflag=K-nord+1
do while(iflag .ge.0)
me=ieor(m0,misub)
call mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
e2sub=ieor(ce(K+1:N),hdec(K+1:N))
do i2=0,ntau
ntotal2=ntotal2+1
@ -222,7 +222,7 @@ if(npre2.eq.1) then
if(i2.gt.0) ui(i2)=1
r2pat=ieor(e2sub,ui)
778 continue
call fetchit(reset,r2pat(1:ntau),ntau,in1,in2)
call fetchit91(reset,r2pat(1:ntau),ntau,in1,in2)
if(in1.gt.0.and.in2.gt.0) then
ncount2=ncount2+1
mi=misub
@ -230,7 +230,7 @@ if(npre2.eq.1) then
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 mrbencode(me,ce,g2,N,K)
call mrbencode91(me,ce,g2,N,K)
nxor=ieor(ce,hdec)
dd=sum(nxor*absrx)
if( dd .lt. dmin ) then
@ -241,7 +241,7 @@ if(npre2.eq.1) then
goto 778
endif
enddo
call nextpat(misub,K,nord,iflag)
call nextpat91(misub,K,nord,iflag)
enddo
endif
@ -254,7 +254,7 @@ cw(colorder+1)=cw ! put the codeword back into received-word order
return
end subroutine osd174_91
subroutine mrbencode(me,codeword,g2,N,K)
subroutine mrbencode91(me,codeword,g2,N,K)
integer*1 me(K),codeword(N),g2(N,K)
! fast encoding for low-weight test patterns
codeword=0
@ -264,9 +264,9 @@ integer*1 me(K),codeword(N),g2(N,K)
endif
enddo
return
end subroutine mrbencode
end subroutine mrbencode91
subroutine nextpat(mi,k,iorder,iflag)
subroutine nextpat91(mi,k,iorder,iflag)
integer*1 mi(k),ms(k)
! generate the next test error pattern
ind=-1
@ -293,9 +293,9 @@ subroutine nextpat(mi,k,iorder,iflag)
endif
enddo
return
end subroutine nextpat
end subroutine nextpat91
subroutine boxit(reset,e2,ntau,npindex,i1,i2)
subroutine boxit91(reset,e2,ntau,npindex,i1,i2)
integer*1 e2(1:ntau)
integer indexes(5000,2),fp(0:525000),np(5000)
logical reset
@ -329,9 +329,9 @@ subroutine boxit(reset,e2,ntau,npindex,i1,i2)
np(ip)=npindex
endif
return
end subroutine boxit
end subroutine boxit91
subroutine fetchit(reset,e2,ntau,i1,i2)
subroutine fetchit91(reset,e2,ntau,i1,i2)
integer indexes(5000,2),fp(0:525000),np(5000)
integer lastpat
integer*1 e2(ntau)
@ -367,5 +367,5 @@ subroutine fetchit(reset,e2,ntau,i1,i2)
endif
lastpat=ipat
return
end subroutine fetchit
end subroutine fetchit91

41
lib/ft8/sync8.f90
View File

@ -10,14 +10,15 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
real x(NFFT1)
real sync2d(NH1,-JZ:JZ)
real red(NH1)
real candidate0(3,200)
real candidate(3,200)
real candidate0(4,200)
real candidate(4,200)
real dd(NMAX)
integer jpeak(NH1)
integer indx(NH1)
integer ii(1)
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
integer icos7_1(0:6),icos7_2(0:6),icos7(0:6)
data icos7_1/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
data icos7_2/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern
equivalence (x,cx)
! Compute symbol spectra, stepping by NSTEP steps.
@ -49,6 +50,11 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
nfos=NFFT1/NSPS ! # frequency bin oversampling factor
jstrt=0.5/tstep
candidate0=0.
k=0
do itype=1,2
if(itype.eq.1) icos7=icos7_1
if(itype.eq.2) icos7=icos7_2
do i=ia,ib
do j=-JZ,+JZ
ta=0.
@ -58,16 +64,16 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
t0b=0.
t0c=0.
do n=0,6
k=j+jstrt+nssy*n
if(k.ge.1.and.k.le.NHSYM) then
ta=ta + s(i+nfos*icos7(n),k)
t0a=t0a + sum(s(i:i+nfos*6:nfos,k))
m=j+jstrt+nssy*n
if(m.ge.1.and.m.le.NHSYM) then
ta=ta + s(i+nfos*icos7(n),m)
t0a=t0a + sum(s(i:i+nfos*6:nfos,m))
endif
tb=tb + s(i+nfos*icos7(n),k+nssy*36)
t0b=t0b + sum(s(i:i+nfos*6:nfos,k+nssy*36))
if(k+nssy*72.le.NHSYM) then
tc=tc + s(i+nfos*icos7(n),k+nssy*72)
t0c=t0c + sum(s(i:i+nfos*6:nfos,k+nssy*72))
tb=tb + s(i+nfos*icos7(n),m+nssy*36)
t0b=t0b + sum(s(i:i+nfos*6:nfos,m+nssy*36))
if(m+nssy*72.le.NHSYM) then
tc=tc + s(i+nfos*icos7(n),m+nssy*72)
t0c=t0c + sum(s(i:i+nfos*6:nfos,m+nssy*72))
endif
enddo
t=ta+tb+tc
@ -98,8 +104,6 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
base=red(ibase)
red=red/base
candidate0=0.
k=0
do i=1,200
n=ia + indx(iz+1-i) - 1
if(red(n).lt.syncmin) exit
@ -107,7 +111,9 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
candidate0(1,k)=n*df
candidate0(2,k)=(jpeak(n)-1)*tstep
candidate0(3,k)=red(n)
candidate0(4,k)=itype
enddo
enddo
ncand=k
! Put nfqso at top of list, and save only the best of near-dupe freqs.
@ -121,9 +127,6 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
if(candidate0(3,i).lt.candidate0(3,j)) candidate0(3,i)=0.
endif
enddo
! write(*,3001) i,candidate0(1,i-1),candidate0(1,i),candidate0(3,i-1), &
! candidate0(3,i)
!3001 format(i2,4f8.1)
endif
enddo
@ -143,6 +146,8 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
candidate(1,k)=abs(candidate0(1,j))
candidate(2,k)=candidate0(2,j)
candidate(3,k)=candidate0(3,j)
candidate(4,k)=candidate0(4,j)
!write(*,*) i,candidate(1:4,k)
k=k+1
endif
enddo

13
lib/ft8/sync8d.f90
View File

@ -1,4 +1,4 @@
subroutine sync8d(cd0,i0,ctwk,itwk,sync)
subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync)
! Compute sync power for a complex, downsampled FT8 signal.
@ -9,8 +9,9 @@ subroutine sync8d(cd0,i0,ctwk,itwk,sync)
complex ctwk(32)
complex z1,z2,z3
logical first
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/
integer icos7_1(0:6),icos7_2(0:6),icos7(0:6)
data icos7_1/2,5,6,0,4,1,3/
data icos7_2/3,1,4,0,6,5,2/
data first/.true./
save first,twopi,fs2,dt2,taus,baud,csync
@ -34,6 +35,12 @@ subroutine sync8d(cd0,i0,ctwk,itwk,sync)
first=.false.
endif
if(itype.eq.1) then
icos7=icos7_1
else
icos7=icos7_2
endif
sync=0
do i=0,6 !Sum over 7 Costas frequencies and
i1=i0+i*32 !three Costas arrays

18
lib/ft8_decode.f90
View File

@ -44,7 +44,7 @@ contains
procedure(ft8_decode_callback) :: callback
real s(NH1,NHSYM)
real sbase(NH1)
real candidate(3,200)
real candidate(4,200)
real dd(15*12000)
logical, intent(in) :: lft8apon,lapcqonly,nagain
logical newdat,lsubtract,ldupe,bcontest
@ -102,13 +102,21 @@ contains
sync=candidate(3,icand)
f1=candidate(1,icand)
xdt=candidate(2,icand)
iftype=candidate(4,icand)
xbase=10.0**(0.1*(sbase(nint(f1/3.125))-40.0))
nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ###
call timer('ft8b ',0)
call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, &
hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, &
nbadcrc,iappass,iera,msg37,xsnr)
if(iftype.eq.1) then
call ft8b_1(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, &
hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, &
nbadcrc,iappass,iera,msg37,xsnr)
else
call ft8b_2(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12,mygrid6, &
hiscall12,bcontest,sync,f1,xdt,xbase,apsym,nharderrors,dmin, &
nbadcrc,iappass,iera,msg37,xsnr)
endif
message=msg37(1:22) !###
nsnr=nint(xsnr)
xdt=xdt-0.5