Change ft4 to use (174,91) code and 512 Sa/symbol.

This commit is contained in:
Steve Franke 2019-01-26 23:03:54 -06:00
parent d9f4a27a3e
commit 613bfaf3ee
5 changed files with 113 additions and 113 deletions

View File

@ -2,6 +2,7 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
use packjt77
include 'ft4_params.f90'
parameter (NSS=NSPS/NDOWN)
character message*37
character c77*77
character*61 line
@ -10,29 +11,29 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
character*17 cdatetime0
character*6 mycall,hiscall,hhmmss
complex cd2(0:NMAX/16-1) !Complex waveform
complex cb(0:NMAX/16-1)
complex cd(0:76*20-1) !Complex waveform
complex ctwk(80),ctwk2(80)
complex csymb(20)
complex cd2(0:NMAX/NDOWN-1) !Complex waveform
complex cb(0:NMAX/NDOWN-1)
complex cd(0:NN*NSS-1) !Complex waveform
complex ctwk(4*NSS),ctwk2(4*NSS)
complex csymb(NSS)
complex cs(0:3,NN)
real s4(0:3,NN)
real bmeta(152),bmetb(152),bmetc(152)
real bmeta(2*NN),bmetb(2*NN),bmetc(2*NN)
real s(NH1,NHSYM)
real a(5)
real llr(128),llr2(128),llra(128),llrb(128),llrc(128)
real llr(2*ND),llr2(2*ND),llra(2*ND),llrb(2*ND),llrc(2*ND)
real s2(0:255)
real candidate(3,100)
real savg(NH1),sbase(NH1)
integer icos4(0:3)
integer*2 iwave(NMAX) !Generated full-length waveform
integer*1 message77(77),apmask(128),cw(128)
integer*1 hbits(152)
integer*1 message77(77),apmask(2*ND),cw(2*ND)
integer*1 hbits(2*NN)
integer graymap(0:3)
integer ip(1)
logical unpk77_success
logical one(0:511,0:7) ! 256 4-symbol sequences, 8 bits
logical one(0:255,0:7) ! 256 4-symbol sequences, 8 bits
logical first
data icos4/0,1,3,2/
data graymap/0,1,3,2/
@ -43,10 +44,9 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
fs=12000.0/NDOWN !Sample rate
dt=1/fs !Sample interval after downsample (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
baud=1.0/tt !Keying rate for "itone" symbols (baud)
txt=NZ*dt !Transmission length (s)
twopi=8.0*atan(1.0)
h=1.0 !h=0.8 seems to be optimum for AWGN sensitivity (not for fading)
h=1.0
if(first) then
one=.false.
@ -73,8 +73,8 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
call getcandidates4(iwave,375.0,3000.0,0.2,2200.0,100,savg,candidate,ncand,sbase)
ndecodes=0
do icand=1,ncand
f0=candidate(1,icand)-1.5*37.5
xsnr=10*log10(candidate(3,icand))
f0=candidate(1,icand)-35.0
xsnr=10*log10(candidate(3,icand))-15.0
if( f0.le.375.0 .or. f0.ge.(5000.0-375.0) ) cycle
call ft4_downsample(iwave,f0,cd2) ! downsample from 320 Sa/Symbol to 20 Sa/Symbol
sum2=sum(cd2*conjg(cd2))/(20.0*76)
@ -84,13 +84,13 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
ibest=-1
smax=-99.
dfbest=-1.
do idf=-90,+90,5
do idf=-30,+30,2
df=idf
a=0.
a(1)=df
ctwk=1.
call twkfreq1(ctwk,80,fs,a,ctwk2)
do istart=0,315
call twkfreq1(ctwk,4*NSS,fs,a,ctwk2)
do istart=0,374
call sync4d(cd2,istart,ctwk2,1,sync)
if(sync.gt.smax) then
smax=sync
@ -101,41 +101,43 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
enddo
f0=f0+dfbest
!f0=1443.75
call ft4_downsample(iwave,f0,cb) ! downsample from 320s/Symbol to 20s/Symbol
sum2=sum(abs(cb)**2)/(20.0*76)
sum2=sum(abs(cb)**2)/(real(NSS)*NN)
if(sum2.gt.0.0) cb=cb/sqrt(sum2)
!ibest=208
cd=cb(ibest:ibest+76*20-1)
cd=cb(ibest:ibest+NN*NSS-1)
do k=1,NN
i1=(k-1)*20
csymb=cd(i1:i1+19)
call four2a(csymb,20,1,-1,1)
cs(0:3,k)=csymb(1:4)/1e2
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))
!write(*,'(i4,4f8.1)') k, s4(0:3,k)
enddo
! sync quality check
is1=0
is2=0
is3=0
is4=0
do k=1,4
ip=maxloc(s4(:,k))
if(icos4(k-1).eq.(ip(1)-1)) is1=is1+1
ip=maxloc(s4(:,k+36))
ip=maxloc(s4(:,k+33))
if(icos4(k-1).eq.(ip(1)-1)) is2=is2+1
ip=maxloc(s4(:,k+72))
ip=maxloc(s4(:,k+66))
if(icos4(k-1).eq.(ip(1)-1)) is3=is3+1
ip=maxloc(s4(:,k+99))
if(icos4(k-1).eq.(ip(1)-1)) is4=is4+1
enddo
! hard sync sum - max is 12
nsync=is1+is2+is3
! hard sync sum - max is 16
nsync=is1+is2+is3+is4
do nseq=1,3
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,76,nsym
do ks=1,NN-nsym+1,nsym !87+16=103 symbols.
amax=-1.0
do i=0,nt-1
i1=i/64
@ -163,7 +165,7 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
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.152) cycle
if(ipt+ib.gt.2*NN) cycle
if(nsym.eq.1) then
bmeta(ipt+ib)=bm
elseif(nsym.eq.2) then
@ -175,27 +177,31 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
enddo
enddo
call normalizebmet(bmeta,152)
call normalizebmet(bmetb,152)
call normalizebmet(bmetc,152)
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( 73: 80).eq.(/0,0,0,1,1,0,1,1/))
ns3=count(hbits(145:152).eq.(/0,0,0,1,1,0,1,1/))
nsync_qual=ns1+ns2+ns3
ns2=count(hbits( 67: 74).eq.(/0,0,0,1,1,0,1,1/))
ns3=count(hbits(133:140).eq.(/0,0,0,1,1,0,1,1/))
ns4=count(hbits(199:206).eq.(/0,0,0,1,1,0,1,1/))
nsync_qual=ns1+ns2+ns3+ns4
sigma=0.7
llra(1:64)=bmeta(9:72)
llra(65:128)=bmeta(81:144)
llra=2*llra/sigma**2
llrb(1:64)=bmetb(9:72)
llrb(65:128)=bmetb(81:144)
llrb=2*llrb/sigma**2
llrc(1:64)=bmetc(9:72)
llrc(65:128)=bmetc(81:144)
llrc=2*llrc/sigma**2
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
do isd=1,3
if(isd.eq.1) llr=llra
@ -207,7 +213,7 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
llr2=llr
if(ibias.eq.1) llr2=llr+0.4
if(ibias.eq.2) llr2=llr-0.4
call bpdecode128_90(llr2,apmask,max_iterations,message77,cw,nharderror,niterations)
call bpdecode174_91(llr2,apmask,max_iterations,message77,cw,nharderror,niterations)
if(nharderror.ge.0) exit
enddo
if(sum(message77).eq.0) cycle
@ -221,12 +227,12 @@ subroutine ft4_decode(cdatetime0,nfqso,iwave,ndecodes,mycall,hiscall,nrx,line)
if(idupe.eq.1) exit
ndecodes=ndecodes+1
decodes(ndecodes)=message
nsnr=nint(xsnr)-15
nsnr=nint(xsnr)
freq=f0
write(line,1000) hhmmss,nsnr,ibest/750.0,nint(freq),message
1000 format(a6,i4,f5.2,i5,' + ',1x,a37)
open(24,file='all_ft2.txt',status='unknown',position='append')
open(24,file='all_ft4.txt',status='unknown',position='append')
write(24,1002) cdatetime0,nsnr,ibest/750.0,nint(freq),message, &
nharderror,nsync_qual,isd,niterations
if(hhmmss.eq.' ') write(*,1002) cdatetime0,nsnr, &
@ -267,17 +273,18 @@ subroutine ft4_downsample(iwave,f0,c)
include 'ft4_params.f90'
parameter (NFFT2=NMAX/16)
integer*2 iwave(NMAX)
complex c(0:NMAX/16-1)
complex c(0:NMAX/NDOWN-1)
complex c1(0:NFFT2-1)
complex cx(0:NMAX/2)
real x(NMAX)
equivalence (x,cx)
BW=6.0*75
!****** Tune this
bw=250.0
df=12000.0/NMAX
x=iwave
call four2a(x,NMAX,1,-1,0) !r2c FFT to freq domain
ibw=nint(BW/df)
ibw=nint(bw/df)
i0=nint(f0/df)
c1=0.
c1(0)=cx(i0)
@ -289,7 +296,7 @@ subroutine ft4_downsample(iwave,f0,c)
enddo
c1=c1/NFFT2
call four2a(c1,NFFT2,1,1,1) !c2c FFT back to time domain
c=c1(0:NMAX/16-1)
c=c1(0:NMAX/NDOWN-1)
return
end subroutine ft4_downsample

View File

@ -1,14 +1,14 @@
! FT4 37.5 baud - 26.67 ms symbol duration
! LDPC (128,90) code
! FT4
! LDPC (174,91) code
parameter (KK=90) !Information bits (77 + CRC13)
parameter (ND=64) !Data symbols
parameter (NS=12) !Sync symbols (12)
parameter (NN=NS+ND) !Total channel symbols (76)
parameter (NSPS=320) !Samples per symbol at 12000 S/s
parameter (NZ=NSPS*NN) !Samples in full 2.03 s message frame (24320)
parameter (NMAX=2.5*12000) !Samples in iwave (30,000)
parameter (NFFT1=1280, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (KK=91) !Information bits (77 + CRC14)
parameter (ND=87) !Data symbols
parameter (NS=16) !Sync symbols
parameter (NN=NS+ND) !Total channel symbols (103)
parameter (NSPS=512) !Samples per symbol at 12000 S/s
parameter (NZ=NSPS*NN) !Samples in full 4.395 s message frame (52736)
parameter (NMAX=5.0*12000) !Samples in iwave (60,000)
parameter (NFFT1=2048, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS/4) !Coarse time-sync step size
parameter (NHSYM=NMAX/NSTEP-3) !Number of symbol spectra (1/4-sym steps)
parameter (NDOWN=16) !Downsample factor

View File

@ -14,7 +14,7 @@ program ft4sim
complex c(0:NMAX-1)
real wave(NMAX)
real dphi(0:NMAX-1)
real pulse(960)
real pulse(3*NSPS)
integer itone(NN)
integer*1 msgbits(77)
integer*2 iwave(NMAX) !Generated full-length waveform
@ -86,8 +86,8 @@ program ft4sim
call sgran()
! The filtered frequency pulse
do i=1,960
tt=(i-480.5)/320.0
do i=1,3*NSPS
tt=(i-1.5*NSPS)/real(NSPS)
pulse(i)=gfsk_pulse(1.0,tt)
enddo
@ -95,8 +95,8 @@ program ft4sim
dphi_peak=twopi*hmod/real(NSPS)
dphi=0.0
do j=1,NN
ib=(j-1)*320
ie=ib+960-1
ib=(j-1)*NSPS
ie=ib+3*NSPS-1
dphi(ib:ie)=dphi(ib:ie)+dphi_peak*pulse*itone(j)
enddo
@ -108,9 +108,9 @@ program ft4sim
phi=mod(phi+dphi(j),twopi)
enddo
c0(0:319)=c0(0:319)*(1.0-cos(twopi*(/(i,i=0,319)/)/640.0) )/2.0
c0(77*320:77*320+319)=c0(77*320:77*320+319)*(1.0+cos(twopi*(/(i,i=0,319)/)/640.0 ))/2.0
c0(78*320:)=0.
c0(0:NSPS-1)=c0(0:NSPS-1)*(1.0-cos(twopi*(/(i,i=0,NSPS-1)/)/(2.0*NSPS)) )/2.0
c0((NN+1)*NSPS:(NN+2)*NSPS-1)=c0((NN+1)*NSPS:(NN+2)*NSPS-1)*(1.0+cos(twopi*(/(i,i=0,NSPS-1)/)/(2.0*NSPS) ))/2.0
c0((NN+2)*NSPS:)=0.
k=nint((xdt+0.25)/dt)
c0=cshift(c0,-k)

View File

@ -1,6 +1,6 @@
subroutine genft4(msg0,ichk,msgsent,i4tone)
! s12 + 64symbols = 76 channel symbols 2.027s message duration
!
! s16 + 87symbols + 2 ramp up/down = 105 channel symbols 4.48s message duration
! s4+58symb+s4+58symb+s4+58sym+s4
! Encode an FT4 message
! Input:
! - msg0 requested message to be transmitted
@ -8,25 +8,22 @@ subroutine genft4(msg0,ichk,msgsent,i4tone)
! - msgsent message as it will be decoded
! - i4tone array of audio tone values, {0,1,2,3}
use iso_c_binding, only: c_loc,c_size_t
! use iso_c_binding, only: c_loc,c_size_t
use packjt77
include 'ft4_params.f90'
character*37 msg0
character*37 message !Message to be generated
character*37 msgsent !Message as it will be received
character*77 c77
integer*4 i4tone(76),itmp(64)
integer*1 codeword(128)
integer*4 i4tone(NN),itmp(ND)
integer*1 codeword(2*ND)
integer*1 msgbits(77)
integer*1 s12(12)
integer icos4(4)
real*8 xi(864),xq(864),pi,twopi
data icos4/0,1,3,2/
logical unpk77_success
twopi=8.*atan(1.0)
pi=twopi/2.0
message=msg0
do i=1, 37
@ -47,7 +44,7 @@ subroutine genft4(msg0,ichk,msgsent,i4tone)
if(ichk.eq.1) go to 999
read(c77,"(77i1)") msgbits
call encode_128_90(msgbits,codeword)
call encode174_91(msgbits,codeword)
! Grayscale mapping:
! bits tone
@ -56,18 +53,19 @@ subroutine genft4(msg0,ichk,msgsent,i4tone)
! 11 2
! 10 3
!Create 144-bit channel vector:
do i=1,64
do i=1,ND
is=codeword(2*i)+2*codeword(2*i-1)
if(is.le.1) itmp(i)=is
if(is.eq.2) itmp(i)=3
if(is.eq.3) itmp(i)=2
enddo
i4tone(1:4)=icos4
i4tone(5:36)=itmp(1:32)
i4tone(37:40)=icos4
i4tone(41:72)=itmp(33:64)
i4tone(73:76)=icos4
i4tone(1:4)=icos4
i4tone(5:33)=itmp(1:29)
i4tone(34:37)=icos4
i4tone(38:66)=itmp(30:58)
i4tone(67:70)=icos4
i4tone(71:99)=itmp(59:87)
i4tone(100:103)=icos4
999 return
end subroutine genft4

View File

@ -1,37 +1,30 @@
subroutine sync4d(cd0,i0,ctwk,itwk,sync)
! Compute sync power for a complex, downsampled FT4 signal.
! 20 samples per symbol
include 'ft4_params.f90'
parameter(NP=NMAX/16)
parameter(NP=NMAX/NDOWN,NSS=NSPS/NDOWN)
complex cd0(0:NP-1)
complex csync(80)
complex csync2(80)
complex ctwk(80)
complex z1,z2,z3
complex csync(4*NSS)
complex csync2(4*NSS)
complex ctwk(4*NSS)
complex z1,z2,z3,z4
logical first
integer icos4(0:3)
data icos4/0,1,3,2/
data first/.true./
save first,twopi,fs2,dt2,taus,baud,csync
save first,twopi,csync
p(z1)=real(z1)**2 + aimag(z1)**2 !Statement function for power
! Set some constants and compute the csync array.
if( first ) then
twopi=8.0*atan(1.0)
fs2=12000.0/NDOWN !Sample rate after downsampling
dt2=1/fs2 !Corresponding sample interval
taus=20*dt2 !Symbol duration
baud=1.0/taus !Keying rate
k=1
phi=0.0
do i=0,3
! dphi=(twopi/2.0)*(2*icos4(i)-3)*baud*dt2
dphi=twopi*icos4(i)*baud*dt2
do j=1,20
csync(k)=cmplx(cos(phi),sin(phi)) !Waveform for 7x7 Costas array
dphi=twopi*icos4(i)/real(NSS)
do j=1,NSS
csync(k)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
k=k+1
enddo
@ -40,15 +33,17 @@ subroutine sync4d(cd0,i0,ctwk,itwk,sync)
endif
sync=0
i1=i0 !three Costas arrays
i2=i0+36*20-1
i3=i0+72*20-1
i1=i0 !four Costas arrays
i2=i0+33*NSS-1
i3=i0+66*NSS-1
i4=i0+99*NSS-1
csync2=csync
if(itwk.eq.1) csync2=ctwk*csync2 !Tweak the frequency
if(i1.ge.0 .and. i1+79.le.NP-1) z1=sum(cd0(i1:i1+79)*conjg(csync2))
if(i2.ge.0 .and. i2+79.le.NP-1) z2=sum(cd0(i2:i2+79)*conjg(csync2))
if(i3.ge.0 .and. i3+79.le.NP-1) z3=sum(cd0(i3:i3+79)*conjg(csync2))
sync = sync + p(z1) + p(z2) + p(z3)
if(i1.ge.0 .and. i1+4*NSS-1.le.NP-1) z1=sum(cd0(i1:i1+4*NSS-1)*conjg(csync2))
if(i2.ge.0 .and. i2+4*NSS-1.le.NP-1) z2=sum(cd0(i2:i2+4*NSS-1)*conjg(csync2))
if(i3.ge.0 .and. i3+4*NSS-1.le.NP-1) z3=sum(cd0(i3:i3+4*NSS-1)*conjg(csync2))
if(i4.ge.0 .and. i4+4*NSS-1.le.NP-1) z4=sum(cd0(i4:i4+4*NSS-1)*conjg(csync2))
sync = sync + p(z1) + p(z2) + p(z3) + p(z4)
return
end subroutine sync4d