FT4: Subtraction is basically working.

This commit is contained in:
Steve Franke 2019-04-18 14:16:39 -05:00
parent be72461142
commit e8d17a9898
11 changed files with 472 additions and 453 deletions

View File

@ -1,11 +1,11 @@
subroutine ft4_downsample(iwave,newdata,f0,c)
subroutine ft4_downsample(dd,newdata,f0,c)
! Input: i*2 data in iwave() at sample rate 12000 Hz
! Input: real data in dd() at sample rate 12000 Hz
! Output: Complex data in c(), sampled at 1200 Hz
include 'ft4_params.f90'
parameter (NFFT2=NMAX/16)
integer*2 iwave(NMAX)
real dd(NMAX)
complex c(0:NMAX/NDOWN-1)
complex c1(0:NFFT2-1)
complex cx(0:NMAX/2)
@ -33,7 +33,7 @@ subroutine ft4_downsample(iwave,newdata,f0,c)
endif
if(newdata) then
x=iwave
x=dd
call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain
endif
i0=nint(f0/df)

View File

@ -9,7 +9,7 @@ parameter (NN2=NS+ND+2) !Total channel symbols (105)
parameter (NSPS=512) !Samples per symbol at 12000 S/s
parameter (NZ=NSPS*NN) !Sync and Data samples (52736)
parameter (NZ2=NSPS*NN2) !Total samples in shaped waveform (53760)
parameter (NMAX=5*12000) !Samples in iwave (60,000)
parameter (NMAX=18*3456) !Samples in iwave
parameter (NFFT1=2048, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS) !Coarse time-sync step size
parameter (NHSYM=(NMAX-NFFT1)/NSTEP) !Number of symbol spectra (1/4-sym steps)

View File

@ -63,7 +63,7 @@ program ft4sim
n3=-1
call pack77(msg37,i3,n3,c77)
read(c77,'(77i1)') msgbits
call genft4(msg37,0,msgsent37,itone)
call genft4(msg37,0,msgsent37,msgbits,itone)
write(*,*)
write(*,'(a9,a37,3x,a7,i1,a1,i1)') 'Message: ',msgsent37,'i3.n3: ',i3,'.',n3
write(*,1000) f0,xdt,txt,snrdb

View File

@ -15,6 +15,7 @@ program ft4sim_mult
real wave(NZZ)
real tmp(NZZ)
integer itone(NN)
integer*1 msgbits(77)
integer*2 iwave(NZZ) !Generated full-length waveform
integer icos4(4)
data icos4/0,1,3,2/
@ -62,7 +63,7 @@ program ft4sim_mult
i3=-1
n3=-1
call pack77(msg37,i3,n3,c77)
call genft4(msg37,0,msgsent37,itone)
call genft4(msg37,0,msgsent37,msgbits,itone)
nwave0=(NN+2)*NSPS
icmplx=0
call gen_ft4wave(itone,NN,NSPS,12000.0,f0,cwave0,wave0,icmplx,nwave0)

View File

@ -1,4 +1,4 @@
subroutine genft4(msg0,ichk,msgsent,i4tone)
subroutine genft4(msg0,ichk,msgsent,msgbits,i4tone)
! Encode an FT4 message
! Input:
@ -52,8 +52,16 @@ subroutine genft4(msg0,ichk,msgsent,i4tone)
call unpack77(c77,0,msgsent,unpk77_success) !Unpack to get msgsent
if(ichk.eq.1) go to 999
read(c77,"(77i1)") msgbits
msgbits=mod(msgbits+rvec,2)
read(c77,'(77i1)',err=1) msgbits
if(unpk77_success) go to 2
1 msgbits=0
itone=0
msgsent='*** bad message *** '
go to 999
entry get_ft4_tones_from_77bits(msgbits,i4tone)
2 msgbits=mod(msgbits+rvec,2)
call encode174_91(msgbits,codeword)
! Grayscale mapping:

View File

@ -1,4 +1,4 @@
subroutine getcandidates4(id,fa,fb,syncmin,nfqso,maxcand,savg,candidate, &
subroutine getcandidates4(dd,fa,fb,syncmin,nfqso,maxcand,savg,candidate, &
ncand,sbase)
include 'ft4_params.f90'
@ -9,7 +9,7 @@ subroutine getcandidates4(id,fa,fb,syncmin,nfqso,maxcand,savg,candidate, &
real window(NFFT1)
complex cx(0:NH1)
real candidate(3,maxcand)
integer*2 id(NMAX)
real dd(NMAX)
integer indx(NH1)
integer ipk(1)
equivalence (x,cx)
@ -33,7 +33,7 @@ subroutine getcandidates4(id,fa,fb,syncmin,nfqso,maxcand,savg,candidate, &
ia=(j-1)*NSTEP + 1
ib=ia+NFFT1-1
if(ib.gt.NMAX) exit
x=fac*id(ia:ib)*window
x=fac*dd(ia:ib)*window
call four2a(x,NFFT1,1,-1,0) !r2c FFT
do i=1,NH1
s(i,j)=real(cx(i))**2 + aimag(cx(i))**2

View File

@ -9,22 +9,23 @@ subroutine subtractft4(dd,itone,f0,dt)
use timer_module, only: timer
parameter (NMAX=6*12000,NFRAME=(103+2)*79)
parameter (NMAX=18*3456,NFRAME=(103+2)*512)
parameter (NFFT=NMAX,NFILT=1400)
! parameter (NFFT=NMAX,NFILT=400)
real*4 dd(NMAX), window(-NFILT/2:NFILT/2), xjunk
complex cref,camp,cfilt,cw
integer itone(79)
integer itone(103)
logical first
data first/.true./
common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX),xjunk(NFRAME)
save first
nstart=dt*12000+1
nsym=79
nsps=1920
nstart=dt*12000+1-512
nsym=103
nsps=512
fs=12000.0
icmplx=1
bt=1.0 ! Temporary compromise?
bt=1.0
call gen_ft4wave(itone,nsym,nsps,fs,f0,cref,xjunk,icmplx,NFRAME)
camp=0.
do i=1,nframe

View File

@ -1,128 +1,130 @@
module ft4_decode
type :: ft4_decoder
procedure(ft4_decode_callback), pointer :: callback
contains
procedure :: decode
end type ft4_decoder
abstract interface
subroutine ft4_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual)
import ft4_decoder
implicit none
class(ft4_decoder), intent(inout) :: this
real, intent(in) :: sync
integer, intent(in) :: snr
real, intent(in) :: dt
real, intent(in) :: freq
character(len=37), intent(in) :: decoded
integer, intent(in) :: nap
real, intent(in) :: qual
end subroutine ft4_decode_callback
end interface
type :: ft4_decoder
procedure(ft4_decode_callback), pointer :: callback
contains
procedure :: decode
end type ft4_decoder
abstract interface
subroutine ft4_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual)
import ft4_decoder
implicit none
class(ft4_decoder), intent(inout) :: this
real, intent(in) :: sync
integer, intent(in) :: snr
real, intent(in) :: dt
real, intent(in) :: freq
character(len=37), intent(in) :: decoded
integer, intent(in) :: nap
real, intent(in) :: qual
end subroutine ft4_decode_callback
end interface
contains
subroutine decode(this,callback,iwave,nQSOProgress,nfqso, &
nutc,nfa,nfb,ndepth,ncontest,mycall,hiscall)
use timer_module, only: timer
use packjt77
include 'ft4/ft4_params.f90'
class(ft4_decoder), intent(inout) :: this
procedure(ft4_decode_callback) :: callback
parameter (NSS=NSPS/NDOWN)
parameter (NZZ=18*3456)
character message*37,msgsent*37,msg0*37
character c77*77
character*37 decodes(100)
character*512 data_dir,fname
character*17 cdatetime0
character*12 mycall,hiscall
character*12 mycall0,hiscall0
character*6 hhmmss
character*4 cqstr,cqstr0
subroutine decode(this,callback,iwave,nQSOProgress,nfqso, &
nutc,nfa,nfb,ndepth,ncontest,mycall,hiscall)
use timer_module, only: timer
use packjt77
include 'ft4/ft4_params.f90'
class(ft4_decoder), intent(inout) :: this
procedure(ft4_decode_callback) :: callback
parameter (NSS=NSPS/NDOWN)
parameter (NZZ=18*3456)
character message*37,msgsent*37,msg0*37
character c77*77
character*37 decodes(100)
character*512 data_dir,fname
character*17 cdatetime0
character*12 mycall,hiscall
character*12 mycall0,hiscall0
character*6 hhmmss
character*4 cqstr,cqstr0
complex cd2(0:NZZ/NDOWN-1) !Complex waveform
complex cb(0:NZZ/NDOWN-1+NN*NSS)
complex cd(0:NN*NSS-1) !Complex waveform
complex ctwk(2*NSS),ctwk2(2*NSS,-16:16)
complex csymb(NSS)
complex cs(0:3,NN)
real s4(0:3,NN)
complex cd2(0:NZZ/NDOWN-1) !Complex waveform
complex cb(0:NZZ/NDOWN-1+NN*NSS)
complex cd(0:NN*NSS-1) !Complex waveform
complex ctwk(2*NSS),ctwk2(2*NSS,-16:16)
complex csymb(NSS)
complex cs(0:3,NN)
real s4(0:3,NN)
real bmeta(2*NN),bmetb(2*NN),bmetc(2*NN)
real a(5)
real llr(2*ND),llra(2*ND),llrb(2*ND),llrc(2*ND),llrd(2*ND)
real s2(0:255)
real candidate(3,100)
real savg(NH1),sbase(NH1)
real bmeta(2*NN),bmetb(2*NN),bmetc(2*NN)
real a(5)
real dd(NZZ)
real llr(2*ND),llra(2*ND),llrb(2*ND),llrc(2*ND),llrd(2*ND)
real s2(0:255)
real candidate(3,100)
real savg(NH1),sbase(NH1)
integer apbits(2*ND)
integer apmy_ru(28),aphis_fd(28)
integer icos4a(0:3),icos4b(0:3),icos4c(0:3),icos4d(0:3)
integer*2 iwave(NZZ) !Raw received data
integer*1 message77(77),rvec(77),apmask(2*ND),cw(2*ND)
integer*1 hbits(2*NN)
integer graymap(0:3)
integer ip(1)
integer nappasses(0:5) ! # of decoding passes for QSO States 0-5
integer naptypes(0:5,4) ! nQSOProgress, decoding pass
integer mcq(29)
integer mrrr(19),m73(19),mrr73(19)
integer apbits(2*ND)
integer apmy_ru(28),aphis_fd(28)
integer icos4a(0:3),icos4b(0:3),icos4c(0:3),icos4d(0:3)
integer*2 iwave(NZZ) !Raw received data
integer*1 message77(77),rvec(77),apmask(2*ND),cw(2*ND)
integer*1 hbits(2*NN)
integer graymap(0:3)
integer i4tone(103)
integer ip(1)
integer nappasses(0:5) ! # of decoding passes for QSO States 0-5
integer naptypes(0:5,4) ! nQSOProgress, decoding pass
integer mcq(29)
integer mrrr(19),m73(19),mrr73(19)
logical nohiscall,unpk77_success
logical one(0:255,0:7) ! 256 4-symbol sequences, 8 bits
logical first, dobigfft
logical nohiscall,unpk77_success
logical one(0:255,0:7) ! 256 4-symbol sequences, 8 bits
logical first, dobigfft
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data graymap/0,1,3,2/
data msg0/' '/
data first/.true./
data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/
data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/
data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/
data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/
data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, &
1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, &
0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/
save fs,dt,tt,txt,twopi,h,one,first,apbits,nappasses,naptypes, &
mycall0,hiscall0,msg0,cqstr0,ctwk2
data icos4a/0,1,3,2/
data icos4b/1,0,2,3/
data icos4c/2,3,1,0/
data icos4d/3,2,0,1/
data graymap/0,1,3,2/
data msg0/' '/
data first/.true./
data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/
data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/
data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/
data mrr73/0,1,1,1,1,1,1,0,0,1,1,1,0,1,0,1,0,0,1/
data rvec/0,1,0,0,1,0,1,0,0,1,0,1,1,1,1,0,1,0,0,0,1,0,0,1,1,0,1,1,0, &
1,0,0,1,0,1,1,0,0,0,0,1,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1, &
0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/
save fs,dt,tt,txt,twopi,h,one,first,apbits,nappasses,naptypes, &
mycall0,hiscall0,msg0,cqstr0,ctwk2
this%callback => callback
hhmmss=cdatetime0(8:13)
if(first) then
fs=12000.0/NDOWN !Sample rate after downsampling
dt=1/fs !Sample interval after downsample (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
txt=NZ*dt !Transmission length (s) without ramp up/down
twopi=8.0*atan(1.0)
h=1.0
one=.false.
do i=0,255
do j=0,7
if(iand(i,2**j).ne.0) one(i,j)=.true.
this%callback => callback
hhmmss=cdatetime0(8:13)
if(first) then
fs=12000.0/NDOWN !Sample rate after downsampling
dt=1/fs !Sample interval after downsample (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
txt=NZ*dt !Transmission length (s) without ramp up/down
twopi=8.0*atan(1.0)
h=1.0
one=.false.
do i=0,255
do j=0,7
if(iand(i,2**j).ne.0) one(i,j)=.true.
enddo
enddo
enddo
do idf=-16,16
a=0.
a(1)=real(idf)
ctwk=1.
call twkfreq1(ctwk,2*NSS,fs/2.0,a,ctwk2(:,idf))
enddo
do idf=-16,16
a=0.
a(1)=real(idf)
ctwk=1.
call twkfreq1(ctwk,2*NSS,fs/2.0,a,ctwk2(:,idf))
enddo
mrrr=2*mod(mrrr+rvec(59:77),2)-1
m73=2*mod(m73+rvec(59:77),2)-1
mrr73=2*mod(mrr73+rvec(59:77),2)-1
nappasses(0)=2
nappasses(1)=2
nappasses(2)=2
nappasses(3)=2
nappasses(4)=2
nappasses(5)=3
mrrr=2*mod(mrrr+rvec(59:77),2)-1
m73=2*mod(m73+rvec(59:77),2)-1
mrr73=2*mod(mrr73+rvec(59:77),2)-1
nappasses(0)=2
nappasses(1)=2
nappasses(2)=2
nappasses(3)=2
nappasses(4)=2
nappasses(5)=3
! iaptype
!------------------------
@ -133,257 +135,257 @@ contains
! 5 MyCall DxCall 73 (77 ap bits)
! 6 MyCall DxCall RR73 (77 ap bits)
!********
naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ)
naptypes(1,1:4)=(/2,3,0,0/) ! Tx1
naptypes(2,1:4)=(/2,3,0,0/) ! Tx2
naptypes(3,1:4)=(/3,6,0,0/) ! Tx3
naptypes(4,1:4)=(/3,6,0,0/) ! Tx4
naptypes(5,1:4)=(/3,1,2,0/) ! Tx5
naptypes(0,1:4)=(/1,2,0,0/) ! Tx6 selected (CQ)
naptypes(1,1:4)=(/2,3,0,0/) ! Tx1
naptypes(2,1:4)=(/2,3,0,0/) ! Tx2
naptypes(3,1:4)=(/3,6,0,0/) ! Tx3
naptypes(4,1:4)=(/3,6,0,0/) ! Tx4
naptypes(5,1:4)=(/3,1,2,0/) ! Tx5
mycall0=''
hiscall0=''
cqstr0=''
first=.false.
endif
if(cqstr.ne.cqstr0) then
i0=index(cqstr,' ')
if(i0.le.1) then
message='CQ A1AA AA01'
else
message='CQ '//cqstr(1:i0-1)//' A1AA AA01'
mycall0=''
hiscall0=''
cqstr0=''
first=.false.
endif
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,1,msgsent,unpk77_success)
read(c77,'(29i1)') mcq
mcq=2*mod(mcq+rvec(1:29),2)-1
cqstr0=cqstr
endif
l1=index(mycall,char(0))
if(l1.ne.0) mycall(l1:)=" "
l1=index(hiscall,char(0))
if(l1.ne.0) hiscall(l1:)=" "
if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0) then
apbits=0
apbits(1)=99
apbits(30)=99
apmy_ru=0
aphis_fd=0
if(len(trim(mycall)) .lt. 3) go to 10
nohiscall=.false.
hiscall0=hiscall
if(len(trim(hiscall0)).lt.3) then
hiscall0=mycall ! use mycall for dummy hiscall - mycall won't be hashed.
nohiscall=.true.
endif
message=trim(mycall)//' '//trim(hiscall0)//' RR73'
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,1,msgsent,unpk77_success)
if(i3.ne.1 .or. (message.ne.msgsent) .or. .not.unpk77_success) go to 10
read(c77,'(77i1)') message77
apmy_ru=2*mod(message77(1:28)+rvec(2:29),2)-1
aphis_fd=2*mod(message77(30:57)+rvec(29:56),2)-1
message77=mod(message77+rvec,2)
call encode174_91(message77,cw)
apbits=2*cw-1
if(nohiscall) apbits(30)=99
10 continue
mycall0=mycall
hiscall0=hiscall
endif
candidate=0.0
ncand=0
syncmin=1.2
maxcand=100
fa=nfa
fb=nfb
call timer('getcand4',0)
call getcandidates4(iwave,fa,fb,syncmin,nfqso,maxcand,savg,candidate, &
ncand,sbase)
call timer('getcand4',1)
ndecodes=0
dobigfft=.true.
do icand=1,ncand
f0=candidate(1,icand)
snr=candidate(3,icand)-1.0
call timer('ft4_down',0)
call ft4_downsample(iwave,dobigfft,f0,cd2) !Downsample to 32 Sam/Sym
call timer('ft4_down',1)
if(dobigfft) dobigfft=.false.
sum2=sum(cd2*conjg(cd2))/(real(NZZ)/real(NDOWN))
if(sum2.gt.0.0) cd2=cd2/sqrt(sum2)
! Sample rate is now 12000/16 = 750 samples/second
do isync=1,2
if(isync.eq.1) then
idfmin=-12
idfmax=12
idfstp=3
ibmin=0
ibmax=800
ibstp=4
if(cqstr.ne.cqstr0) then
i0=index(cqstr,' ')
if(i0.le.1) then
message='CQ A1AA AA01'
else
idfmin=idfbest-4
idfmax=idfbest+4
idfstp=1
ibmin=max(0,ibest-5)
ibmax=min(ibest+5,NZZ/NDOWN-1)
ibstp=1
message='CQ '//cqstr(1:i0-1)//' A1AA AA01'
endif
ibest=-1
smax=-99.
idfbest=0
call timer('sync4d ',0)
do idf=idfmin,idfmax,idfstp
do istart=ibmin,ibmax,ibstp
call sync4d(cd2,istart,ctwk2(:,idf),1,sync) !Find sync power
if(sync.gt.smax) then
smax=sync
ibest=istart
idfbest=idf
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,1,msgsent,unpk77_success)
read(c77,'(29i1)') mcq
mcq=2*mod(mcq+rvec(1:29),2)-1
cqstr0=cqstr
endif
l1=index(mycall,char(0))
if(l1.ne.0) mycall(l1:)=" "
l1=index(hiscall,char(0))
if(l1.ne.0) hiscall(l1:)=" "
if(mycall.ne.mycall0 .or. hiscall.ne.hiscall0) then
apbits=0
apbits(1)=99
apbits(30)=99
apmy_ru=0
aphis_fd=0
if(len(trim(mycall)) .lt. 3) go to 10
nohiscall=.false.
hiscall0=hiscall
if(len(trim(hiscall0)).lt.3) then
hiscall0=mycall ! use mycall for dummy hiscall - mycall won't be hashed.
nohiscall=.true.
endif
message=trim(mycall)//' '//trim(hiscall0)//' RR73'
i3=-1
n3=-1
call pack77(message,i3,n3,c77)
call unpack77(c77,1,msgsent,unpk77_success)
if(i3.ne.1 .or. (message.ne.msgsent) .or. .not.unpk77_success) go to 10
read(c77,'(77i1)') message77
apmy_ru=2*mod(message77(1:28)+rvec(2:29),2)-1
aphis_fd=2*mod(message77(30:57)+rvec(29:56),2)-1
message77=mod(message77+rvec,2)
call encode174_91(message77,cw)
apbits=2*cw-1
if(nohiscall) apbits(30)=99
10 continue
mycall0=mycall
hiscall0=hiscall
endif
syncmin=1.2
maxcand=100
ndecodes=0
decodes=' '
fa=nfa
fb=nfb
dd=iwave
do isp = 1,2
candidate=0.0
ncand=0
call timer('getcand4',0)
call getcandidates4(dd,fa,fb,syncmin,nfqso,maxcand,savg,candidate, &
ncand,sbase)
call timer('getcand4',1)
dobigfft=.true.
do icand=1,ncand
f0=candidate(1,icand)
snr=candidate(3,icand)-1.0
call timer('ft4_down',0)
call ft4_downsample(dd,dobigfft,f0,cd2) !Downsample to 32 Sam/Sym
call timer('ft4_down',1)
if(dobigfft) dobigfft=.false.
sum2=sum(cd2*conjg(cd2))/(real(NZZ)/real(NDOWN))
if(sum2.gt.0.0) cd2=cd2/sqrt(sum2)
! Sample rate is now 12000/16 = 750 samples/second
do isync=1,2
if(isync.eq.1) then
idfmin=-12
idfmax=12
idfstp=3
ibmin=0
ibmax=800
ibstp=4
else
idfmin=idfbest-4
idfmax=idfbest+4
idfstp=1
ibmin=max(0,ibest-5)
ibmax=min(ibest+5,NZZ/NDOWN-1)
ibstp=1
endif
ibest=-1
smax=-99.
idfbest=0
call timer('sync4d ',0)
do idf=idfmin,idfmax,idfstp
do istart=ibmin,ibmax,ibstp
call sync4d(cd2,istart,ctwk2(:,idf),1,sync) !Find sync power
if(sync.gt.smax) then
smax=sync
ibest=istart
idfbest=idf
endif
enddo
enddo
call timer('sync4d ',1)
enddo
enddo
call timer('sync4d ',1)
enddo
f0=f0+real(idfbest)
if( f0.le.10.0 .or. f0.ge.4990.0 ) cycle
! write(*,3002) smax,ibest/750.0,f0
!3002 format('b',3f8.2)
call timer('ft4down ',0)
call ft4_downsample(iwave,dobigfft,f0,cb) !Final downsample, corrected f0
call timer('ft4down ',1)
sum2=sum(abs(cb)**2)/(real(NSS)*NN)
if(sum2.gt.0.0) cb=cb/sqrt(sum2)
cd=cb(ibest:ibest+NN*NSS-1)
call timer('four2a ',0)
do k=1,NN
i1=(k-1)*NSS
csymb=cd(i1:i1+NSS-1)
call four2a(csymb,NSS,1,-1,1)
cs(0:3,k)=csymb(1:4)
s4(0:3,k)=abs(csymb(1:4))
enddo
call timer('four2a ',1)
f0=f0+real(idfbest)
if( f0.le.10.0 .or. f0.ge.4990.0 ) cycle
call timer('ft4down ',0)
call ft4_downsample(dd,dobigfft,f0,cb) !Final downsample, corrected f0
call timer('ft4down ',1)
sum2=sum(abs(cb)**2)/(real(NSS)*NN)
if(sum2.gt.0.0) cb=cb/sqrt(sum2)
cd=cb(ibest:ibest+NN*NSS-1)
call timer('four2a ',0)
do k=1,NN
i1=(k-1)*NSS
csymb=cd(i1:i1+NSS-1)
call four2a(csymb,NSS,1,-1,1)
cs(0:3,k)=csymb(1:4)
s4(0:3,k)=abs(csymb(1:4))
enddo
call timer('four2a ',1)
! Sync quality check
is1=0
is2=0
is3=0
is4=0
do k=1,4
ip=maxloc(s4(:,k))
if(icos4a(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s4(:,k+33))
if(icos4b(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s4(:,k+66))
if(icos4c(k-1).eq.(ip(1)-1)) is3=is3+1
ip=maxloc(s4(:,k+99))
if(icos4d(k-1).eq.(ip(1)-1)) is4=is4+1
enddo
nsync=is1+is2+is3+is4 !Number of correct hard sync symbols, 0-16
if(smax .lt. 0.7 .or. nsync .lt. 8) cycle
do nseq=1,3 !Try coherent sequences of 1, 2, and 4 symbols
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nseq.eq.3) nsym=4
nt=2**(2*nsym)
do ks=1,NN-nsym+1,nsym !87+16=103 symbols.
amax=-1.0
do i=0,nt-1
i1=i/64
i2=iand(i,63)/16
i3=iand(i,15)/4
i4=iand(i,3)
if(nsym.eq.1) then
s2(i)=abs(cs(graymap(i4),ks))
elseif(nsym.eq.2) then
s2(i)=abs(cs(graymap(i3),ks)+cs(graymap(i4),ks+1))
elseif(nsym.eq.4) then
s2(i)=abs(cs(graymap(i1),ks ) + &
cs(graymap(i2),ks+1) + &
cs(graymap(i3),ks+2) + &
cs(graymap(i4),ks+3) &
)
else
print*,"Error - nsym must be 1, 2, or 4."
endif
is1=0
is2=0
is3=0
is4=0
do k=1,4
ip=maxloc(s4(:,k))
if(icos4a(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s4(:,k+33))
if(icos4b(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s4(:,k+66))
if(icos4c(k-1).eq.(ip(1)-1)) is3=is3+1
ip=maxloc(s4(:,k+99))
if(icos4d(k-1).eq.(ip(1)-1)) is4=is4+1
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
if(nsym.eq.4) ibmax=7
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
if(nsym.eq.1) then
bmeta(ipt+ib)=bm
elseif(nsym.eq.2) then
bmetb(ipt+ib)=bm
elseif(nsym.eq.4) then
bmetc(ipt+ib)=bm
endif
nsync=is1+is2+is3+is4 !Number of correct hard sync symbols, 0-16
if(smax .lt. 0.7 .or. nsync .lt. 8) cycle
do nseq=1,3 !Try coherent sequences of 1, 2, and 4 symbols
if(nseq.eq.1) nsym=1
if(nseq.eq.2) nsym=2
if(nseq.eq.3) nsym=4
nt=2**(2*nsym)
do ks=1,NN-nsym+1,nsym !87+16=103 symbols.
amax=-1.0
do i=0,nt-1
i1=i/64
i2=iand(i,63)/16
i3=iand(i,15)/4
i4=iand(i,3)
if(nsym.eq.1) then
s2(i)=abs(cs(graymap(i4),ks))
elseif(nsym.eq.2) then
s2(i)=abs(cs(graymap(i3),ks)+cs(graymap(i4),ks+1))
elseif(nsym.eq.4) then
s2(i)=abs(cs(graymap(i1),ks ) + &
cs(graymap(i2),ks+1) + &
cs(graymap(i3),ks+2) + &
cs(graymap(i4),ks+3) &
)
else
print*,"Error - nsym must be 1, 2, or 4."
endif
enddo
ipt=1+(ks-1)*2
if(nsym.eq.1) ibmax=1
if(nsym.eq.2) ibmax=3
if(nsym.eq.4) ibmax=7
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
if(nsym.eq.1) then
bmeta(ipt+ib)=bm
elseif(nsym.eq.2) then
bmetb(ipt+ib)=bm
elseif(nsym.eq.4) then
bmetc(ipt+ib)=bm
endif
enddo
enddo
enddo
enddo
enddo
bmetb(205:206)=bmeta(205:206)
bmetc(201:204)=bmetb(201:204)
bmetc(205:206)=bmeta(205:206)
bmetb(205:206)=bmeta(205:206)
bmetc(201:204)=bmetb(201:204)
bmetc(205:206)=bmeta(205:206)
call normalizebmet(bmeta,2*NN)
call normalizebmet(bmetb,2*NN)
call normalizebmet(bmetc,2*NN)
call normalizebmet(bmeta,2*NN)
call normalizebmet(bmetb,2*NN)
call normalizebmet(bmetc,2*NN)
hbits=0
where(bmeta.ge.0) hbits=1
ns1=count(hbits( 1: 8).eq.(/0,0,0,1,1,0,1,1/))
ns2=count(hbits( 67: 74).eq.(/0,1,0,0,1,1,1,0/))
ns3=count(hbits(133:140).eq.(/1,1,1,0,0,1,0,0/))
ns4=count(hbits(199:206).eq.(/1,0,1,1,0,0,0,1/))
nsync_qual=ns1+ns2+ns3+ns4
if(nsync_qual.lt. 20) cycle
hbits=0
where(bmeta.ge.0) hbits=1
ns1=count(hbits( 1: 8).eq.(/0,0,0,1,1,0,1,1/))
ns2=count(hbits( 67: 74).eq.(/0,1,0,0,1,1,1,0/))
ns3=count(hbits(133:140).eq.(/1,1,1,0,0,1,0,0/))
ns4=count(hbits(199:206).eq.(/1,0,1,1,0,0,0,1/))
nsync_qual=ns1+ns2+ns3+ns4
if(nsync_qual.lt. 20) cycle
scalefac=2.83
llra( 1: 58)=bmeta( 9: 66)
llra( 59:116)=bmeta( 75:132)
llra(117:174)=bmeta(141:198)
llra=scalefac*llra
llrb( 1: 58)=bmetb( 9: 66)
llrb( 59:116)=bmetb( 75:132)
llrb(117:174)=bmetb(141:198)
llrb=scalefac*llrb
llrc( 1: 58)=bmetc( 9: 66)
llrc( 59:116)=bmetc( 75:132)
llrc(117:174)=bmetc(141:198)
llrc=scalefac*llrc
scalefac=2.83
llra( 1: 58)=bmeta( 9: 66)
llra( 59:116)=bmeta( 75:132)
llra(117:174)=bmeta(141:198)
llra=scalefac*llra
llrb( 1: 58)=bmetb( 9: 66)
llrb( 59:116)=bmetb( 75:132)
llrb(117:174)=bmetb(141:198)
llrb=scalefac*llrb
llrc( 1: 58)=bmetc( 9: 66)
llrc( 59:116)=bmetc( 75:132)
llrc(117:174)=bmetc(141:198)
llrc=scalefac*llrc
apmag=maxval(abs(llra))*1.1
npasses=3+nappasses(nQSOProgress)
if(ncontest.ge.5) npasses=3 ! Don't support Fox and Hound
do ipass=1,npasses
if(ipass.eq.1) llr=llra
if(ipass.eq.2) llr=llrb
if(ipass.eq.3) llr=llrc
if(ipass.le.3) then
apmask=0
iaptype=0
endif
apmag=maxval(abs(llra))*1.1
npasses=3+nappasses(nQSOProgress)
if(ncontest.ge.5) npasses=3 ! Don't support Fox and Hound
do ipass=1,npasses
if(ipass.eq.1) llr=llra
if(ipass.eq.2) llr=llrb
if(ipass.eq.3) llr=llrc
if(ipass.le.3) then
apmask=0
iaptype=0
endif
if(ipass .gt. 3) then
llrd=llrc
iaptype=naptypes(nQSOProgress,ipass-3)
if(ipass .gt. 3) then
llrd=llrc
iaptype=naptypes(nQSOProgress,ipass-3)
! ncontest=0 : NONE
! 1 : NA_VHF
@ -394,94 +396,99 @@ contains
! 6 : HOUND
!
! Conditions that cause us to bail out of AP decoding
napwid=50
if(ncontest.le.4 .and. iaptype.ge.3 .and. (abs(f0-nfqso).gt.napwid) ) cycle
if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall
if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall
napwid=50
if(ncontest.le.4 .and. iaptype.ge.3 .and. (abs(f0-nfqso).gt.napwid) ) cycle
if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall
if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall
if(iaptype.eq.1) then ! CQ or CQ TEST or CQ FD or CQ RU or CQ SCC
apmask=0
apmask(1:29)=1
llrd(1:29)=apmag*mcq(1:29)
endif
if(iaptype.eq.1) then ! CQ or CQ TEST or CQ FD or CQ RU or CQ SCC
apmask=0
apmask(1:29)=1
llrd(1:29)=apmag*mcq(1:29)
endif
if(iaptype.eq.2) then ! MyCall,???,???
apmask=0
if(ncontest.eq.0.or.ncontest.eq.1) then
apmask(1:29)=1
llrd(1:29)=apmag*apbits(1:29)
else if(ncontest.eq.2) then
apmask(1:28)=1
llrd(1:28)=apmag*apbits(1:28)
else if(ncontest.eq.3) then
apmask(1:28)=1
llrd(1:28)=apmag*apbits(1:28)
else if(ncontest.eq.4) then
apmask(2:29)=1
llrd(2:29)=apmag*apmy_ru(1:28)
if(iaptype.eq.2) then ! MyCall,???,???
apmask=0
if(ncontest.eq.0.or.ncontest.eq.1) then
apmask(1:29)=1
llrd(1:29)=apmag*apbits(1:29)
else if(ncontest.eq.2) then
apmask(1:28)=1
llrd(1:28)=apmag*apbits(1:28)
else if(ncontest.eq.3) then
apmask(1:28)=1
llrd(1:28)=apmag*apbits(1:28)
else if(ncontest.eq.4) then
apmask(2:29)=1
llrd(2:29)=apmag*apmy_ru(1:28)
endif
endif
if(iaptype.eq.3) then ! MyCall,DxCall,???
apmask=0
if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2) then
apmask(1:58)=1
llrd(1:58)=apmag*apbits(1:58)
else if(ncontest.eq.3) then ! Field Day
apmask(1:56)=1
llrd(1:28)=apmag*apbits(1:28)
llrd(29:56)=apmag*aphis_fd(1:28)
else if(ncontest.eq.4) then ! RTTY RU
apmask(2:57)=1
llrd(2:29)=apmag*apmy_ru(1:28)
llrd(30:57)=apmag*apbits(30:57)
endif
endif
if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then
apmask=0
if(ncontest.le.4) then
apmask(1:91)=1 ! mycall, hiscall, RRR|73|RR73
if(iaptype.eq.6) llrd(1:91)=apmag*apbits(1:91)
endif
endif
llr=llrd
endif
endif
if(iaptype.eq.3) then ! MyCall,DxCall,???
apmask=0
if(ncontest.eq.0.or.ncontest.eq.1.or.ncontest.eq.2) then
apmask(1:58)=1
llrd(1:58)=apmag*apbits(1:58)
else if(ncontest.eq.3) then ! Field Day
apmask(1:56)=1
llrd(1:28)=apmag*apbits(1:28)
llrd(29:56)=apmag*aphis_fd(1:28)
else if(ncontest.eq.4) then ! RTTY RU
apmask(2:57)=1
llrd(2:29)=apmag*apmy_ru(1:28)
llrd(30:57)=apmag*apbits(30:57)
max_iterations=40
message77=0
call timer('bpdec174',0)
call bpdecode174_91(llr,apmask,max_iterations,message77, &
cw,nharderror,niterations)
call timer('bpdec174',1)
if(sum(message77).eq.0) cycle
if( nharderror.ge.0 ) then
message77=mod(message77+rvec,2) ! remove rvec scrambling
write(c77,'(77i1)') message77(1:77)
call unpack77(c77,1,message,unpk77_success)
if(unpk77_success) then
call get_ft4_tones_from_77bits(message77,i4tone)
dt=real(ibest)/750.0
call subtractft4(dd,i4tone,f0,dt)
endif
idupe=0
do i=1,ndecodes
if(decodes(i).eq.message) idupe=1
enddo
if(ibest.le.10 .and. message.eq.msg0) idupe=1 !Already decoded
if(idupe.eq.1) exit
ndecodes=ndecodes+1
decodes(ndecodes)=message
if(snr.gt.0.0) then
xsnr=10*log10(snr)-14.0
else
xsnr=-20.0
endif
nsnr=nint(max(-20.0,xsnr))
xdt=ibest/750.0 - 0.5
call this%callback(sync,nsnr,xdt,f0,message,iaptype,qual)
if(ibest.ge.ibmax-15) msg0=message !Possible dupe candidate
exit
endif
endif
if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype.eq.6) then
apmask=0
if(ncontest.le.4) then
apmask(1:91)=1 ! mycall, hiscall, RRR|73|RR73
if(iaptype.eq.6) llrd(1:91)=apmag*apbits(1:91)
endif
endif
llr=llrd
endif
max_iterations=40
message77=0
call timer('bpdec174',0)
call bpdecode174_91(llr,apmask,max_iterations,message77, &
cw,nharderror,niterations)
call timer('bpdec174',1)
if(sum(message77).eq.0) cycle
if( nharderror.ge.0 ) then
message77=mod(message77+rvec,2) ! remove rvec scrambling
write(c77,'(77i1)') message77(1:77)
call unpack77(c77,1,message,unpk77_success)
idupe=0
do i=1,ndecodes
if(decodes(i).eq.message) idupe=1
enddo
if(ibest.le.10 .and. message.eq.msg0) idupe=1 !Already decoded
if(idupe.eq.1) exit
ndecodes=ndecodes+1
decodes(ndecodes)=message
if(snr.gt.0.0) then
xsnr=10*log10(snr)-14.0
else
xsnr=-20.0
endif
nsnr=nint(max(-20.0,xsnr))
xdt=ibest/750.0 - 0.5
call this%callback(sync,nsnr,xdt,f0,message,iaptype,qual)
if(ibest.ge.ibmax-15) msg0=message !Possible dupe candidate
exit
endif
enddo !Sequence estimation
enddo !Candidate list
return
end subroutine decode
enddo !Sequence estimation
enddo !Candidate list
enddo !Subtraction loop
return
end subroutine decode
end module ft4_decode

View File

@ -396,7 +396,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
cycle
endif
nbadcrc=0 ! If we get this far: valid codeword, valid (i3,n3), nonquirky message.
call get_tones_from_77bits(message77,itone)
call get_ft8_tones_from_77bits(message77,itone)
if(lsubtract) call subtractft8(dd0,itone,f1,xdt)
xsig=0.0
xnoi=0.0

View File

@ -25,7 +25,7 @@ subroutine genft8(msg,i3,n3,msgsent,msgbits,itone)
msgsent='*** bad message *** '
go to 900
entry get_tones_from_77bits(msgbits,itone)
entry get_ft8_tones_from_77bits(msgbits,itone)
2 call encode174_91(msgbits,codeword) !Encode the test message

View File

@ -99,7 +99,7 @@ extern "C" {
void genft8_(char* msg, int* i3, int* n3, char* msgsent, char ft8msgbits[],
int itone[], fortran_charlen_t, fortran_charlen_t);
void genft4_(char* msg, int* ichk, char* msgsent, int itone[],
void genft4_(char* msg, int* ichk, char* msgsent, char ft4msgbits[], int itone[],
fortran_charlen_t, fortran_charlen_t);
void gen_ft8wave_(int itone[], int* nsym, int* nsps, float* bt, float* fsample, float* f0,
@ -3739,7 +3739,9 @@ void MainWindow::guiUpdate()
}
if(m_modeTx=="FT4") {
int ichk=0;
genft4_(message, &ichk, msgsent, const_cast<int *>(itone), 37, 37);
char ft4msgbits[77];
genft4_(message, &ichk, msgsent, const_cast<char *> (ft4msgbits),
const_cast<int *>(itone), 37, 37);
int nsym=103;
int nsps=4*512;
float fsample=48000.0;