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

Remove all vestiges of old (isync=1) FT8 mode. Many changes here!

This commit is contained in:
Joe Taylor 2018-11-05 11:59:48 -05:00
parent 6abde266eb
commit 0235cf69ff
15 changed files with 167 additions and 755 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CMakeLists.txt
View File

@ -448,9 +448,7 @@ set (wsjt_FSRCS
lib/fqso_first.f90
lib/freqcal.f90
lib/ft8/ft8apset.f90
lib/ft8/ft8apset_174_91.f90
lib/ft8/ft8b_1.f90
lib/ft8/ft8b_2.f90
lib/ft8/ft8b.f90
lib/ft8/ft8code.f90
lib/ft8/ft8_downsample.f90
lib/ft8/ft8sim.f90
@ -459,7 +457,6 @@ set (wsjt_FSRCS
lib/gen9.f90
lib/geniscat.f90
lib/ft8/genft8.f90
lib/ft8/genft8_174_91.f90
lib/genmsk_128_90.f90
lib/genmsk40.f90
lib/genqra64.f90

5
lib/ft8/foxgen.f90
View File

@ -39,10 +39,7 @@ subroutine foxgen()
do n=1,nslots
msg=cmsg(n)(1:37)
call genft8_174_91(msg,i3,n3,msgsent,msgbits,itone)
! print*,'Foxgen:',n,msg,msgsent,i3,n3
! write(*,'(77i1)') msgbits
call genft8(msg,i3,n3,msgsent,msgbits,itone)
! Make copies of itone() and msgbits() for ft8sim
itone2=itone
msgbits2=msgbits

58
lib/ft8/ft8apset.f90
View File

@ -1,22 +1,44 @@
subroutine ft8apset(mycall12,hiscall12,apsym)
parameter(NAPM=4,KK=87)
character*12 mycall12,hiscall12
character*37 msg,msgsent
character*6 mycall,hiscall
character*6 hisgrid6
character*4 hisgrid
integer apsym(75)
use packjt77
character*77 c77
character*37 msg
character*12 mycall12,hiscall12,hiscall
integer apsym(58)
integer*1 msgbits(77)
integer itone(79)
mycall=mycall12(1:6)
hiscall=hiscall12(1:6)
if(len(trim(hiscall)).eq.0) hiscall="K9ABC"
msg=mycall//' '//hiscall//' RRR'
i3=0
n3=0
isync=1
call genft8(msg,i3,n3,isync,msgsent,msgbits,itone)
apsym=2*msgbits(1:75)-1
logical nohiscall
if(len(trim(mycall12)).eq.0) then
apsym=0
apsym(1)=99
apsym(30)=99
return
endif
nohiscall=.false.
hiscall=hiscall12
if(len(trim(hiscall)).eq.0) then
hiscall="K9ABC"
nohiscall=.true.
endif
! Encode a dummy standard message: i3=1, 28 1 28 1 1 15
!
msg=trim(mycall12)//' '//trim(hiscall)//' RRR'
call pack77(msg,i3,n3,c77)
if(i3.ne.1) then
apsym=0
apsym(1)=99
apsym(30)=99
return
endif
read(c77,'(58i1)',err=1) apsym(1:58)
if(nohiscall) apsym(30)=99
return
1 apsym=0
apsym(1)=99
apsym(30)=99
return
end subroutine ft8apset

43
lib/ft8/ft8apset_174_91.f90
View File

@ -1,43 +0,0 @@
subroutine ft8apset_174_91(mycall12,hiscall12,apsym)
use packjt77
character*77 c77
character*37 msg
character*12 mycall12,hiscall12,hiscall
integer apsym(58)
integer*1 msgbits(77)
logical nohiscall
if(len(trim(mycall12)).eq.0) then
apsym=0
apsym(1)=99
apsym(30)=99
return
endif
nohiscall=.false.
hiscall=hiscall12
if(len(trim(hiscall)).eq.0) then
hiscall="K9ABC"
nohiscall=.true.
endif
! Encode a dummy standard message: i3=1, 28 1 28 1 1 15
!
msg=trim(mycall12)//' '//trim(hiscall)//' RRR'
call pack77(msg,i3,n3,c77)
if(i3.ne.1) then
apsym=0
apsym(1)=99
apsym(30)=99
return
endif
read(c77,'(58i1)',err=1) apsym(1:58)
if(nohiscall) apsym(30)=99
return
1 apsym=0
apsym(1)=99
apsym(30)=99
return
end subroutine ft8apset_174_91

61
lib/ft8/ft8b_2.f90 → lib/ft8/ft8b.f90
View File

@ -1,4 +1,4 @@
subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,lsubtract,nagain,ncontest,iaptype,mycall12,hiscall12, &
sync0,f1,xdt,xbase,apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg37,xsnr)
@ -116,7 +116,7 @@ subroutine ft8b_2(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,2,sync)
call sync8d(cd0,idt,ctwk,0,sync)
if(sync.gt.smax) then
smax=sync
ibest=idt
@ -135,7 +135,7 @@ subroutine ft8b_2(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,2,sync)
call sync8d(cd0,i0,ctwk,1,sync)
if( sync .gt. smax ) then
smax=sync
delfbest=delf
@ -146,7 +146,7 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
call twkfreq1(cd0,NP2,fs2,a,cd0)
xdt=xdt2
f1=f1+delfbest !Improved estimate of DF
call sync8d(cd0,i0,ctwk,0,2,sync)
call sync8d(cd0,i0,ctwk,0,sync)
do k=1,NN
i1=ibest+(k-1)*32
@ -445,22 +445,43 @@ subroutine ft8b_2(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
return
enddo
return
end subroutine ft8b_2
end subroutine ft8b
! This currently resides in ft8b_1.f90
!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
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
function bessi0(x)
! From Numerical Recipes
real bessi0,x
double precision p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9,y
save p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9
data p1,p2,p3,p4,p5,p6,p7/1.0d0,3.5156229d0,3.0899424d0,1.2067492d0, &
0.2659732d0,0.360768d-1,0.45813d-2/
data q1,q2,q3,q4,q5,q6,q7,q8,q9/0.39894228d0,0.1328592d-1, &
0.225319d-2,-0.157565d-2,0.916281d-2,-0.2057706d-1, &
0.2635537d-1,-0.1647633d-1,0.392377d-2/
if (abs(x).lt.3.75) then
y=(x/3.75)**2
bessi0=p1+y*(p2+y*(p3+y*(p4+y*(p5+y*(p6+y*p7)))))
else
ax=abs(x)
y=3.75/ax
bessi0=(exp(ax)/sqrt(ax))*(q1+y*(q2+y*(q3+y*(q4 &
+y*(q5+y*(q6+y*(q7+y*(q8+y*q9))))))))
endif
return
end function bessi0

484
lib/ft8/ft8b_1.f90
View File

@ -1,484 +0,0 @@
subroutine ft8b_1(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
napwid,lsubtract,nagain,iaptype,mycall12,hiscall12, &
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,msgsent37
character message*22,msgsent*22
character*12 mycall12,hiscall12
character*6 mycall6,hiscall6,c1,c2
character*87 cbits
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(KK),decoded0(KK),apmask(3*ND),cw(3*ND)
integer*1 msgbits(KK)
integer apsym(75)
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(0:3199)
complex ctwk(32)
complex csymb(32)
logical first,newdat,lsubtract,lapon,lapcqonly,nagain
equivalence (s1,s1sort)
data icos7/2,5,6,0,4,1,3/
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,1,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,1,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,1,sync)
j=0
do k=1,NN
i1=ibest+(k-1)*32
csymb=cmplx(0.0,0.0)
if( i1.ge.0 .and. i1+31 .le. NP2-1 ) 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+1e-32)
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 ',0)
call bpdecode174(llrap,apmask,max_iterations,decoded,cw,nharderrors, &
niterations)
call timer('bpd174 ',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 ',0)
call osd174(llrap,apmask,ndeep,decoded,cw,nharderrors,dmin)
call timer('osd174 ',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 chkcrc12a(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(decoded,message,ncrcflag)
decoded=decoded0
! This needs fixing for messages with i3bit=1:
i3=0 !TEMPORARY
n3=0
isync=1
msg37=' '
msg37(1:22)=message
call genft8(msg37,i3,n3,isync,msgsent37,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_1
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
function bessi0(x)
! From Numerical Recipes
real bessi0,x
double precision p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9,y
save p1,p2,p3,p4,p5,p6,p7,q1,q2,q3,q4,q5,q6,q7,q8,q9
data p1,p2,p3,p4,p5,p6,p7/1.0d0,3.5156229d0,3.0899424d0,1.2067492d0, &
0.2659732d0,0.360768d-1,0.45813d-2/
data q1,q2,q3,q4,q5,q6,q7,q8,q9/0.39894228d0,0.1328592d-1, &
0.225319d-2,-0.157565d-2,0.916281d-2,-0.2057706d-1, &
0.2635537d-1,-0.1647633d-1,0.392377d-2/
if (abs(x).lt.3.75) then
y=(x/3.75)**2
bessi0=p1+y*(p2+y*(p3+y*(p4+y*(p5+y*(p6+y*p7)))))
else
ax=abs(x)
y=3.75/ax
bessi0=(exp(ax)/sqrt(ax))*(q1+y*(q2+y*(q3+y*(q4 &
+y*(q5+y*(q6+y*(q7+y*(q8+y*q9))))))))
endif
return
end function bessi0

2
lib/ft8/ft8code.f90
View File

@ -47,7 +47,7 @@ program ft8code
! Generate msgsent, msgbits, and itone
i3=-1
n3=-1
call genft8_174_91(msg,i3,n3,msgsent,msgbits,itone)
call genft8(msg,i3,n3,msgsent,msgbits,itone)
msgtype=""
if(i3.eq.0) then
if(n3.eq.0) msgtype="Free text"

2
lib/ft8/ft8sim.f90
View File

@ -66,7 +66,7 @@ program ft8sim
i3=-1
n3=-1
call pack77(msg37,i3,n3,c77)
call genft8_174_91(msg37,i3,n3,msgsent37,msgbits,itone)
call genft8(msg37,i3,n3,msgsent37,msgbits,itone)
write(*,*)
write(*,'(a23,a37,3x,a7,i1,a1,i1)') 'New Style FT8 Message: ',msgsent37,'i3.n3: ',i3,'.',n3

61
lib/ft8/genft8.f90
View File

@ -1,46 +1,31 @@
subroutine genft8(msg37,i3,n3,isync,msgsent37,msgbits77,itone)
subroutine genft8(msg,i3,n3,msgsent,msgbits,itone)
! Encode an FT8 message, producing array itone().
use crc
use packjt
use packjt77
include 'ft8_params.f90'
character*22 msg,msgsent
character*37 msg37,msgsent37
character*87 cbits
logical checksumok
integer*4 i4Msg6BitWords(12) !72-bit message as 6-bit words
integer*1 msgbits(KK),codeword(3*ND)
integer*1 msgbits77(77)
integer*1, target:: i1Msg8BitBytes(11)
integer itone(NN)
character msg*37,msgsent*37
character*77 c77
integer*1 msgbits(77),codeword(174)
integer itone(79)
integer icos7(0:6)
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
integer graymap(0:7)
logical unpk77_success
data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern
data graymap/0,1,3,2,5,6,4,7/
if(isync.eq.2 ) goto 900
msg=msg37(1:22)
call packmsg(msg,i4Msg6BitWords,istdtype) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
msgsent37(1:22)=msgsent
msgsent37(23:37)=' '
i3=-1
n3=-1
call pack77(msg,i3,n3,c77)
call unpack77(c77,msgsent,unpk77_success)
read(c77,'(77i1)',err=1) msgbits
go to 2
1 write(81,*) msg,c77 ; flush(81)
write(cbits,1000) i4Msg6BitWords,32*i3
1000 format(12b6.6,b8.8)
read(cbits,1001) i1Msg8BitBytes(1:10)
1001 format(10b8)
i1Msg8BitBytes(10)=iand(i1Msg8BitBytes(10),128+64+32)
i1Msg8BitBytes(11)=0
icrc12=crc12(c_loc(i1Msg8BitBytes),11)
entry get_tones_from_77bits(msgbits,itone)
write(cbits,1003) i4Msg6BitWords,i3,icrc12
1003 format(12b6.6,b3.3,b12.12)
read(cbits,1004) msgbits
1004 format(87i1)
2 call encode174_91(msgbits,codeword) !Encode the test message
call encode174(msgbits,codeword) !Encode the test message
msgbits77=-1
msgbits77(1:75)=msgbits(1:75)
! Message structure: S7 D29 S7 D29 S7
itone(1:7)=icos7
itone(36+1:36+7)=icos7
@ -50,13 +35,9 @@ subroutine genft8(msg37,i3,n3,isync,msgsent37,msgbits77,itone)
i=3*j -2
k=k+1
if(j.eq.30) k=k+7
itone(k)=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
indx=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
itone(k)=graymap(indx)
enddo
return
900 continue
call genft8_174_91(msg37,i3,n3,msgsent37,msgbits77,itone)
return
end subroutine genft8

43
lib/ft8/genft8_174_91.f90
View File

@ -1,43 +0,0 @@
subroutine genft8_174_91(msg,i3,n3,msgsent,msgbits,itone)
! Encode an FT8 message, producing array itone().
use packjt77
include 'ft8_params.f90'
character msg*37,msgsent*37
character*77 c77
integer*1 msgbits(77),codeword(174)
integer itone(79)
integer icos7(0:6)
integer graymap(0:7)
logical unpk77_success
data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern
data graymap/0,1,3,2,5,6,4,7/
i3=-1
n3=-1
call pack77(msg,i3,n3,c77)
call unpack77(c77,msgsent,unpk77_success)
read(c77,'(77i1)',err=1) msgbits
go to 2
1 write(81,*) msg,c77 ; flush(81)
entry get_tones_from_77bits(msgbits,itone)
2 call encode174_91(msgbits,codeword) !Encode the test message
! Message structure: S7 D29 S7 D29 S7
itone(1:7)=icos7
itone(36+1:36+7)=icos7
itone(NN-6:NN)=icos7
k=7
do j=1,ND
i=3*j -2
k=k+1
if(j.eq.30) k=k+7
indx=codeword(i)*4 + codeword(i+1)*2 + codeword(i+2)
itone(k)=graymap(indx)
enddo
return
end subroutine genft8_174_91

79
lib/ft8/sync8.f90
View File

@ -1,4 +1,5 @@
subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sbase)
subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate, &
ncand,sbase)
include 'ft8_params.f90'
! Search over +/- 2.5s relative to 0.5s TX start time.
@ -11,15 +12,14 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb
real x(NFFT1)
real sync2d(NH1,-JZ:JZ)
real red(NH1)
real candidate0(4,maxcand)
real candidate(4,maxcand)
real candidate0(3,maxcand)
real candidate(3,maxcand)
real dd(NMAX)
integer jpeak(NH1)
integer indx(NH1)
integer ii(1)
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
integer icos7(0:6)
data icos7/3,1,4,0,6,5,2/ !Costas 7x7 tone pattern
equivalence (x,cx)
! Compute symbol spectra, stepping by NSTEP steps.
@ -49,13 +49,8 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb
candidate0=0.
k=0
is1=1
if(ldecode77) is1=2
do isync=is1,2
if(isync.eq.1) icos7=icos7_1
if(isync.eq.2) icos7=icos7_2
do i=ia,ib
do j=-JZ,+JZ
do i=ia,ib
do j=-JZ,+JZ
ta=0.
tb=0.
tc=0.
@ -79,42 +74,37 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb
t0=t0a+t0b+t0c
t0=(t0-t)/6.0
sync_abc=t/t0
t=tb+tc
t0=t0b+t0c
t0=(t0-t)/6.0
sync_bc=t/t0
sync2d(i,j)=max(sync_abc,sync_bc)
enddo
enddo
enddo
enddo
red=0.
do i=ia,ib
ii=maxloc(sync2d(i,-JZ:JZ)) - 1 - JZ
j0=ii(1)
jpeak(i)=j0
red(i)=sync2d(i,j0)
! write(52,3052) i*df,red(i),db(red(i))
!3052 format(3f12.3)
enddo
iz=ib-ia+1
call indexx(red(ia:ib),iz,indx)
ibase=indx(nint(0.40*iz)) - 1 + ia
if(ibase.lt.1) ibase=1
if(ibase.gt.nh1) ibase=nh1
base=red(ibase)
red=red/base
red=0.
do i=ia,ib
ii=maxloc(sync2d(i,-JZ:JZ)) - 1 - JZ
j0=ii(1)
jpeak(i)=j0
red(i)=sync2d(i,j0)
enddo
iz=ib-ia+1
call indexx(red(ia:ib),iz,indx)
ibase=indx(nint(0.40*iz)) - 1 + ia
if(ibase.lt.1) ibase=1
if(ibase.gt.nh1) ibase=nh1
base=red(ibase)
red=red/base
do i=1,min(maxcand,iz)
n=ia + indx(iz+1-i) - 1
if(red(n).lt.syncmin.or.isnan(red(n)).or.k.eq.maxcand) exit
k=k+1
candidate0(1,k)=n*df
candidate0(2,k)=(jpeak(n)-1)*tstep
candidate0(3,k)=red(n)
candidate0(4,k)=isync
enddo
enddo ! isync loop
do i=1,min(maxcand,iz)
n=ia + indx(iz+1-i) - 1
if(red(n).lt.syncmin.or.isnan(red(n)).or.k.eq.maxcand) exit
k=k+1
candidate0(1,k)=n*df
candidate0(2,k)=(jpeak(n)-1)*tstep
candidate0(3,k)=red(n)
enddo
ncand=k
! Put nfqso at top of list, and save only the best of near-dupe freqs.
@ -144,10 +134,7 @@ subroutine sync8(dd,nfa,nfb,syncmin,nfqso,ldecode77,maxcand,s,candidate,ncand,sb
j=indx(i)
! if( candidate0(3,j) .ge. syncmin .and. candidate0(2,j).ge.-1.5 ) then
if( candidate0(3,j) .ge. syncmin ) then
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)
candidate(1:3,k)=abs(candidate0(1:3,j))
k=k+1
endif
enddo

30
lib/ft8/sync8d.f90
View File

@ -1,20 +1,18 @@
subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync)
subroutine sync8d(cd0,i0,ctwk,itwk,sync)
! Compute sync power for a complex, downsampled FT8 signal.
! itype specifies which Costas array to use
parameter(NP2=2812,NDOWN=60)
complex cd0(0:3199)
complex csync_1(0:6,32),csync_2(0:6,32)
complex csync(0:6,32)
complex csync2(32)
complex ctwk(32)
complex z1,z2,z3
logical first
integer icos7_1(0:6),icos7_2(0:6)
data icos7_1/2,5,6,0,4,1,3/
data icos7_2/3,1,4,0,6,5,2/
integer icos7(0:6)
data icos7/3,1,4,0,6,5,2/
data first/.true./
save first,twopi,fs2,dt2,taus,baud,csync_1,csync_2
save first,twopi,fs2,dt2,taus,baud,csync
p(z1)=real(z1)**2 + aimag(z1)**2 !Statement function for power
@ -26,15 +24,11 @@ subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync)
taus=32*dt2 !Symbol duration
baud=1.0/taus !Keying rate
do i=0,6
phi1=0.0
phi2=0.0
dphi1=twopi*icos7_1(i)*baud*dt2
dphi2=twopi*icos7_2(i)*baud*dt2
phi=0.0
dphi=twopi*icos7(i)*baud*dt2
do j=1,32
csync_1(i,j)=cmplx(cos(phi1),sin(phi1)) !Waveform for 7x7 Costas array
csync_2(i,j)=cmplx(cos(phi2),sin(phi2)) !Waveform for 7x7 Costas array
phi1=mod(phi1+dphi1,twopi)
phi2=mod(phi2+dphi2,twopi)
csync(i,j)=cmplx(cos(phi),sin(phi)) !Waveform for 7x7 Costas array
phi=mod(phi+dphi,twopi)
enddo
enddo
first=.false.
@ -45,11 +39,7 @@ subroutine sync8d(cd0,i0,ctwk,itwk,itype,sync)
i1=i0+i*32 !three Costas arrays
i2=i1+36*32
i3=i1+72*32
if(itype.eq.1) then
csync2=csync_1(i,1:32)
else
csync2=csync_2(i,1:32)
endif
csync2=csync(i,1:32)
if(itwk.eq.1) csync2=ctwk*csync2 !Tweak the frequency
z1=0.
z2=0.

31
lib/ft8_decode.f90
View File

@ -45,7 +45,7 @@ contains
parameter (MAXCAND=300)
real s(NH1,NHSYM)
real sbase(NH1)
real candidate(4,MAXCAND)
real candidate(3,MAXCAND)
real dd(15*12000)
logical, intent(in) :: lft8apon,lapcqonly,ldecode77,nagain
logical newdat,lsubtract,ldupe
@ -69,8 +69,7 @@ contains
write(datetime,1001) nutc !### TEMPORARY ###
1001 format("000000_",i6.6)
call ft8apset(mycall12,hiscall12,apsym1)
call ft8apset_174_91(mycall12,hiscall12,apsym2)
call ft8apset(mycall12,hiscall12,apsym2)
dd=iwave
ndecodes=0
allmessages=' '
@ -104,32 +103,24 @@ contains
endif
call timer('sync8 ',0)
maxc=MAXCAND
call sync8(dd,ifa,ifb,syncmin,nfqso,ldecode77,maxc,s,candidate,ncand,sbase)
call sync8(dd,ifa,ifb,syncmin,nfqso,ldecode77,maxc,s,candidate, &
ncand,sbase)
call timer('sync8 ',1)
do icand=1,ncand
sync=candidate(3,icand)
f1=candidate(1,icand)
xdt=candidate(2,icand)
isync=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)
if(isync.eq.1) then
call ft8b_1(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
lapcqonly,napwid,lsubtract,nagain,iaptype,mycall12, &
hiscall12,sync,f1,xdt,xbase,apsym1,nharderrors,dmin, &
nbadcrc,iappass,iera,msg37,xsnr)
else
call ft8b_2(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
lapcqonly,napwid,lsubtract,nagain,ncontest,iaptype,mycall12, &
hiscall12,sync,f1,xdt,xbase,apsym2,nharderrors,dmin, &
nbadcrc,iappass,iera,msg37,xsnr)
endif
! message=msg37(1:22) !###
call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
lapcqonly,napwid,lsubtract,nagain,ncontest,iaptype,mycall12, &
hiscall12,sync,f1,xdt,xbase,apsym2,nharderrors,dmin, &
nbadcrc,iappass,iera,msg37,xsnr)
call timer('ft8b ',1)
nsnr=nint(xsnr)
xdt=xdt-0.5
hd=nharderrors+dmin
call timer('ft8b ',1)
if(nbadcrc.eq.0) then
ldupe=.false.
do id=1,ndecodes
@ -142,8 +133,8 @@ contains
endif
! write(81,1004) nutc,ncand,icand,ipass,iaptype,iappass, &
! nharderrors,dmin,hd,min(sync,999.0),nint(xsnr), &
! xdt,nint(f1),msg37,isync
!1004 format(i6.6,2i4,3i2,i3,3f6.1,i4,f6.2,i5,2x,a37,i4)
! xdt,nint(f1),msg37
!1004 format(i6.6,2i4,3i2,i3,3f6.1,i4,f6.2,i5,2x,a37)
! flush(81)
if(.not.ldupe .and. associated(this%callback)) then
qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0]

15
mainwindow.cpp
View File

@ -81,8 +81,8 @@ extern "C" {
fortran_charlen_t, fortran_charlen_t, fortran_charlen_t, fortran_charlen_t,
fortran_charlen_t);
void genft8_(char* msg, int* i3, int* n3, int* isync, char* msgsent,
char ft8msgbits[], int itone[], fortran_charlen_t, fortran_charlen_t);
void genft8_(char* msg, int* i3, int* n3, char* msgsent, char ft8msgbits[],
int itone[], fortran_charlen_t, fortran_charlen_t);
void gen4_(char* msg, int* ichk, char* msgsent, int itone[],
int* itext, fortran_charlen_t, fortran_charlen_t);
@ -3560,11 +3560,11 @@ void MainWindow::guiUpdate()
if(SpecOp::FOX==m_config.special_op_id() and ui->tabWidget->currentIndex()==2) {
foxTxSequencer();
} else {
m_isync=2;
m_i3=0;
int i3=0;
int n3=0;
char ft8msgbits[77];
genft8_(message, &m_i3, &m_n3, &m_isync, msgsent,
const_cast<char *> (ft8msgbits), const_cast<int *> (itone), 37, 37);
genft8_(message, &i3, &n3, msgsent, const_cast<char *> (ft8msgbits),
const_cast<int *> (itone), 37, 37);
if(SpecOp::FOX == m_config.special_op_id()) {
//Fox must generate the full Tx waveform, not just an itone[] array.
QString fm = QString::fromStdString(message).trimmed();
@ -3591,8 +3591,7 @@ void MainWindow::guiUpdate()
}
}
}
if(m_isync==1) msgsent[22]=0;
if(m_isync==2) msgsent[37]=0;
msgsent[37]=0;
}
}

3
mainwindow.h
View File

@ -430,9 +430,6 @@ private:
qint32 m_nTx73;
qint32 m_UTCdisk;
qint32 m_wait;
qint32 m_i3;
qint32 m_n3;
qint32 m_isync;
qint32 m_isort;
qint32 m_max_dB;
qint32 m_nDXped=0;