chris/js8call
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Removing leftover ft8 files. Cleaning up sync code.

Browse Source
This commit is contained in:
Jordan Sherer 2019-12-12 20:35:16 -05:00
parent 7dc0298b18
commit 77405cc968
26 changed files with 141 additions and 1546 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
CMakeLists.txt
View File

@ -289,7 +289,6 @@ set (wsjt_FSRCS
lib/jt4_decode.f90
lib/jt65_decode.f90
lib/jt65_mod.f90
lib/ft8_decode.f90
lib/jt9_decode.f90
lib/options.f90
lib/packjt.f90
@ -298,6 +297,8 @@ set (wsjt_FSRCS
lib/timer_impl.f90
lib/timer_module.f90
lib/wavhdr.f90
lib/js8a_module.f90
lib/js8a_decode.f90
lib/js8b_module.f90
lib/js8b_decode.f90
lib/js8c_module.f90
@ -320,8 +321,6 @@ set (wsjt_FSRCS
lib/averms.f90
lib/azdist.f90
lib/badmsg.f90
lib/ft8/baseline.f90
# lib/js8/baselinejs8.f90
lib/bpdecode40.f90
lib/bpdecode144.f90
lib/ft8/bpdecode174.f90
@ -386,17 +385,8 @@ set (wsjt_FSRCS
lib/fqso_first.f90
lib/freqcal.f90
lib/ft8/ft8apset.f90
lib/ft8/ft8b.f90
# lib/js8/js8params.f90
# lib/js8/js8b.f90
lib/ft8/ft8code.f90
lib/ft8/ft8_downsample.f90
# lib/js8/js8_downsample.f90
lib/ft8/ft8sim.f90
lib/ft8/genft8.f90
lib/js8/genjs8.f90
lib/ft8/genft8refsig.f90
# lib/js8/genjs8refsig.f90
lib/geodist.f90
lib/getlags.f90
lib/getmet4.f90
@ -417,8 +407,7 @@ set (wsjt_FSRCS
lib/jplsubs.f
lib/jt9fano.f90
lib/jtmsg.f90
lib/ldpcsim144.f90
lib/ft8/ldpcsim174.f90
lib/js8/ldpcsim174js8a.f90
lib/js8/ldpcsim174js8b.f90
lib/js8/ldpcsim174js8c.f90
lib/js8/ldpcsim174js8e.f90
@ -460,8 +449,6 @@ set (wsjt_FSRCS
lib/spec9f.f90
lib/stdmsg.f90
lib/subtract65.f90
lib/ft8/subtractft8.f90
# lib/js8/subtractjs8.f90
lib/sun.f90
lib/symspec.f90
lib/symspec2.f90
@ -469,10 +456,6 @@ set (wsjt_FSRCS
lib/sync4.f90
lib/sync64.f90
lib/sync65.f90
lib/ft8/sync8.f90
# lib/js8/syncjs8.f90
lib/ft8/sync8d.f90
# lib/js8/syncjs8d.f90
lib/sync9.f90
lib/sync9f.f90
lib/sync9w.f90
@ -997,8 +980,8 @@ endif (WIN32)
add_library (wsjt_qtmm STATIC ${wsjt_qtmm_CXXSRCS} ${wsjt_qtmm_GENUISRCS})
target_link_libraries (wsjt_qtmm Qt5::Multimedia)
add_executable (ldpcsim174 lib/ft8/ldpcsim174.f90 wsjtx.rc)
target_link_libraries (ldpcsim174 wsjt_fort wsjt_cxx)
add_executable (ldpcsim174js8a lib/js8/ldpcsim174js8a.f90 wsjtx.rc)
target_link_libraries (ldpcsim174js8a wsjt_fort wsjt_cxx)
add_executable (ldpcsim174js8b lib/js8/ldpcsim174js8b.f90 wsjtx.rc)
target_link_libraries (ldpcsim174js8b wsjt_fort wsjt_cxx)

27
lib/decoder.f90
View File

@ -3,7 +3,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
!$ use omp_lib
use prog_args
use timer_module, only: timer
use ft8_decode
use js8a_decode
use js8b_decode
use js8c_decode
use js8e_decode
@ -12,9 +12,9 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
include 'jt9com.f90'
include 'timer_common.inc'
type, extends(ft8_decoder) :: counting_ft8_decoder
type, extends(js8a_decoder) :: counting_js8a_decoder
integer :: decoded
end type counting_ft8_decoder
end type counting_js8a_decoder
type, extends(js8b_decoder) :: counting_js8b_decoder
integer :: decoded
@ -41,7 +41,7 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
character(len=12) :: mycall, hiscall
character(len=6) :: mygrid, hisgrid
save
type(counting_ft8_decoder) :: my_js8a
type(counting_js8a_decoder) :: my_js8a
type(counting_js8b_decoder) :: my_js8b
type(counting_js8c_decoder) :: my_js8c
type(counting_js8e_decoder) :: my_js8e
@ -69,10 +69,6 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
10 nfail=0
if(params%nmode.eq.8) then
c2fox=' '
g2fox=' '
nsnrfox=-99
nfreqfox=-99
n30z=0
nwrap=0
nfox=0
@ -235,10 +231,6 @@ contains
ichar(w(4:4)).ge.ichar('0') .and. ichar(w(4:4)).le.ichar('9'))
if(first) then
c2fox=' '
g2fox=' '
nsnrfox=-99
nfreqfox=-99
n30z=0
nwrap=0
nfox=0
@ -291,11 +283,6 @@ contains
n30z=n30
n30=n30+nwrap
nfox=nfox+1
c2fox(nfox)=c2
g2fox(nfox)=g2
nsnrfox(nfox)=snr
nfreqfox(nfox)=nint(freq)
n30fox(nfox)=n30
endif
endif
@ -305,10 +292,10 @@ contains
end subroutine js8_decoded
subroutine js8a_decoded (this,sync,snr,dt,freq,decoded,nap,qual)
use ft8_decode
use js8a_decode
implicit none
class(ft8_decoder), intent(inout) :: this
class(js8a_decoder), intent(inout) :: this
real, intent(in) :: sync
integer, intent(in) :: snr
real, intent(in) :: dt
@ -323,7 +310,7 @@ contains
call js8_decoded(sync, snr, dt, freq, decoded, nap, qual, submode)
select type(this)
type is (counting_ft8_decoder)
type is (counting_js8a_decoder)
this%decoded = this%decoded + 1
end select

51
lib/ft8/baseline.f90
View File

@ -1,51 +0,0 @@
subroutine baseline(s,nfa,nfb,sbase)
! Fit baseline to spectrum (for FT8)
! Input: s(npts) Linear scale in power
! Output: sbase(npts) Baseline
implicit real*8 (a-h,o-z)
include 'ft8_params.f90'
real*4 s(NSPS)
real*4 sbase(NSPS)
real*4 base
real*8 x(1000),y(1000),a(5)
data nseg/10/,npct/10/
df=12000.0/(NSPS*2.0d0) !3.125 Hz
ia=max(1,nint(nfa/df))
ib=nint(nfb/df)
do i=ia,ib
s(i)=10.0*log10(s(i)) !Convert to dB scale
enddo
nterms=5
nlen=(ib-ia+1)/nseg !Length of test segment
i0=(ib-ia+1)/2 !Midpoint
k=0
do n=1,nseg !Loop over all segments
ja=ia + (n-1)*nlen
jb=ja+nlen-1
call pctile(s(ja),nlen,npct,base) !Find lowest npct of points
do i=ja,jb
if(s(i).le.base) then
if (k.lt.1000) k=k+1 !Save all "lower envelope" points
x(k)=i-i0
y(k)=s(i)
endif
enddo
enddo
kz=k
a=0.
call polyfit(x,y,y,kz,nterms,0,a,chisqr) !Fit a low-order polynomial
do i=ia,ib
t=i-i0
sbase(i)=a(1)+t*(a(2)+t*(a(3)+t*(a(4)+t*(a(5))))) + 0.65
! write(51,3051) i*df,s(i),sbase(i)
!3051 format(3f12.3)
enddo
return
end subroutine baseline

54
lib/ft8/ft8_downsample.f90
View File

@ -1,54 +0,0 @@
subroutine ft8_downsample(dd,newdat,f0,c1)
! Downconvert to complex data sampled at 200 Hz ==> 32 samples/symbol
include 'ft8_params.f90'
parameter (NDFFT1=NSPS*NDD, NDFFT2=NDFFT1/NDOWN) ! Downconverted FFT Size - 192000/60 = 3200
logical newdat,first
complex c1(0:NDFFT2-1)
complex cx(0:NDFFT1/2)
real dd(NMAX),x(NDFFT1),taper(0:NDD)
equivalence (x,cx)
data first/.true./
save cx,first,taper
if(first) then
pi=4.0*atan(1.0)
do i=0,NDD
taper(i)=0.5*(1.0+cos(i*pi/NDD))
enddo
first=.false.
endif
if(newdat) then
! Data in dd have changed, recompute the long FFT
x(1:NMAX)=dd
x(NMAX+1:NDFFT1)=0. !Zero-pad the x array
call four2a(cx,NDFFT1,1,-1,0) !r2c FFT to freq domain
newdat=.false.
endif
df=12000.0/NDFFT1
baud=12000.0/NSPS
i0=nint(f0/df)
ft=f0+8.5*baud
it=min(nint(ft/df),NDFFT1/2)
fb=f0-1.5*baud
ib=max(1,nint(fb/df))
k=0
c1=0.
do i=ib,it
c1(k)=cx(i)
k=k+1
enddo
c1(0:NDD)=c1(0:NDD)*taper(NDD:0:-1)
c1(k-1-NDD:k-1)=c1(k-1-NDD:k-1)*taper
c1=cshift(c1,i0-ib)
call four2a(c1,NDFFT2,1,1,1) !c2c FFT back to time domain
fac=1.0/sqrt(float(NDFFT1)*NDFFT2)
c1=fac*c1
return
end subroutine ft8_downsample

27
lib/ft8/ft8_params.f90
View File

@ -1,27 +0,0 @@
! LDPC (174,87) code
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136) ! 200 Hz
! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120) ! 160 Hz
! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=24, NDD=100) ! 80 Hz
parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100) ! 50 Hz
! parameter (NSPS=3840, NTXDUR=30, NDOWNSPS=32, NDD=100) ! 25 Hz
parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time.
parameter (AZ=12000.0/(1.0*NSPS)*0.64d0)
parameter (KK=87) !Information bits (75 + CRC12)
parameter (ND=58) !Data symbols
parameter (NS=21) !Sync symbols (3 @ Costas 7x7)
parameter (NN=NS+ND) !Total channel symbols (79)
parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680)
parameter (NMAX=NTXDUR*12000) !Samples in iwave (180,000)
parameter (NFFT1=2*NSPS, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS/4) !Rough time-sync step size
parameter (NHSYM=NMAX/NSTEP-3) !Number of symbol spectra (1/4-sym steps)
parameter (NDOWN=NSPS/NDOWNSPS) !Downsample factor to 32 samples per symbol

1
lib/ft8/ft8_params.f90 Symbolic link
View File

@ -0,0 +1 @@
../js8/js8_params.f90

452
lib/ft8/ft8b.f90
View File

@ -1,452 +0,0 @@
subroutine ft8b(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,origmsg*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(NMAX)
integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND)
integer*1 msgbits(KK)
integer apsym(KK)
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(NDOWNSPS)
complex csymb(NDOWNSPS)
logical first,newdat,lsubtract,lapon,lapcqonly,nagain
equivalence (s1,s1sort)
data icos7/4,2,5,6,1,3,0/
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,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,NDOWNSPS
ctwk(i)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
enddo
call sync8d(cd0,i0,ctwk,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,sync)
j=0
do k=1,NN
i1=ibest+(k-1)*NDOWNSPS
csymb=cmplx(0.0,0.0)
!if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31)
if( i1.ge.0 .and. i1+(NDOWNSPS-1) .le. NP2-1 ) csymb=cd0(i1:i1+(NDOWNSPS-1))
call four2a(csymb,NDOWNSPS,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
call timer('badnsync', 0)
nbadcrc=1
call timer('badnsync', 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)
if(nbadcrc.eq.0) then
decoded0=decoded
call extractmessage174(decoded,origmsg,ncrcflag)
decoded=decoded0
message(1:12)=origmsg(1:12)
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,NN
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=min(xsnr, xsnr2)
if(xsnr .lt. -24.0) xsnr=-24.0
msg37=origmsg//' '
msg37(22:22) = char(48 + i3bit)
return
endif
enddo
return
end subroutine ft8b
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

103
lib/ft8/ft8code.f90
View File

@ -1,103 +0,0 @@
program ft8code
! Provides examples of message packing, LDPC(144,87) encoding, bit and
! symbol ordering, and other details of the FT8 protocol.
use packjt
use crc
include 'ft8_params.f90' !Set various constants
include 'ft8_testmsg.f90'
parameter (NWAVE=NN*NSPS)
character*40 msg,msgchk
character*37 msg37
character*6 c1,c2
character*9 comment
character*22 msgsent,message
character*6 mygrid6
character bad*1,msgtype*10
character*87 cbits
logical bcontest
integer itone(NN)
integer dgen(12)
integer*1 msgbits(KK),decoded(KK),decoded0(KK)
data mygrid6/'EM48 '/
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.1 .and. nargs.ne.3) then
print*
print*,'Program ft8code: Provides examples of message packing, ', &
'LDPC(174,87) encoding,'
print*,'bit and symbol ordering, and other details of the FT8 protocol.'
print*
print*,'Usage: ft8code [-c grid] "message" # Results for specified message'
print*,' ft8code -t # Examples of all message types'
go to 999
endif
bcontest=.false.
call getarg(1,msg) !Message to be transmitted
if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-t') then
testmsg(NTEST+1)='KA1ABC RR73; WB9XYZ <KH1/KH7Z> -11'
nmsg=NTEST+1
else if(len(trim(msg)).eq.2 .and. msg(1:2).eq.'-c') then
bcontest=.true.
call getarg(2,mygrid6)
call getarg(3,msg)
msgchk=msg
nmsg=1
else
msgchk=msg
call fmtmsg(msgchk,iz) !To upper case; collapse multiple blanks
nmsg=1
endif
write(*,1010)
1010 format(" Message Decoded Err? Type"/76("-"))
do imsg=1,nmsg
if(nmsg.gt.1) msg=testmsg(imsg)
call fmtmsg(msg,iz) !To upper case, collapse multiple blanks
msgchk=msg
! Generate msgsent, msgbits, and itone
call packmsg(msg(1:22),dgen,itype,bcontest)
msgtype=""
if(itype.eq.1) msgtype="Std Msg"
if(itype.eq.2) msgtype="Type 1 pfx"
if(itype.eq.3) msgtype="Type 1 sfx"
if(itype.eq.4) msgtype="Type 2 pfx"
if(itype.eq.5) msgtype="Type 2 sfx"
if(itype.eq.6) msgtype="Free text"
i3bit=0
call genft8(msg(1:22),mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
decoded=msgbits
i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
iFreeText=decoded(57)
decoded0=decoded
if(i3bit.eq.1) decoded(57:)=0
call extractmessage174(decoded,message,ncrcflag)
decoded=decoded0
bad=" "
comment=' '
if(itype.ne.6 .and. message.ne.msgchk) bad="*"
if(itype.eq.6 .and. message(1:13).ne.msgchk(1:13)) bad="*"
if(itype.eq.6 .and. len(trim(msgchk)).gt.13) comment='truncated'
write(*,1020) imsg,msgchk,message,bad,i3bit,itype,msgtype,comment
1020 format(i2,'.',1x,a22,1x,a22,1x,a1,2i2,1x,a10,1x,a9)
enddo
if(nmsg.eq.1) then
write(*,1030) msgbits(1:56)
1030 format(/'Call1: ',28i1,' Call2: ',28i1)
write(*,1032) msgbits(57:72),msgbits(73:75),msgbits(76:87)
1032 format('Grid: ',16i1,' 3Bit: ',3i1,' CRC12: ',12i1)
write(*,1034) itone
1034 format(/'Channel symbols:'/79i1)
endif
999 end program ft8code

63
lib/ft8/ft8d.f90
View File

@ -1,63 +0,0 @@
program ft8d
! Decode FT8 data read from *.wav files.
include 'ft8_params.f90'
character*12 arg
character infile*80,datetime*13,message*22
real s(NH1,NHSYM)
real candidate(3,100)
integer ihdr(11)
integer*2 iwave(NMAX) !Generated full-length waveform
real dd(NMAX)
nargs=iargc()
if(nargs.lt.3) then
print*,'Usage: ft8d MaxIt Norder file1 [file2 ...]'
print*,'Example ft8d 40 2 *.wav'
go to 999
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) norder
nfiles=nargs-2
twopi=8.0*atan(1.0)
fs=12000.0 !Sample rate
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of "itone" symbols (s)
ts=2*NSPS*dt !Duration of OQPSK symbols (s)
baud=1.0/tt !Keying rate (baud)
txt=NZ*dt !Transmission length (s)
nfa=100.0
nfb=3000.0
nfqso=1500.0
do ifile=1,nfiles
call getarg(ifile+2,infile)
open(10,file=infile,status='old',access='stream')
read(10,end=999) ihdr,iwave
close(10)
j2=index(infile,'.wav')
read(infile(j2-6:j2-1),*) nutc
datetime=infile(j2-13:j2-1)
call sync8(iwave,nfa,nfb,nfqso,s,candidate,ncand)
syncmin=2.0
dd=iwave
do icand=1,ncand
sync=candidate(3,icand)
if( sync.lt.syncmin) cycle
f1=candidate(1,icand)
xdt=candidate(2,icand)
nsnr=min(99,nint(10.0*log10(sync)-25.5))
call ft8b(dd,nfqso,f1,xdt,nharderrors,dmin,nbadcrc,message,xsnr)
nsnr=xsnr
xdt=xdt-0.6
write(*,1110) datetime,0,nsnr,xdt,f1,message,nharderrors,dmin
1110 format(a13,2i4,f6.2,f7.1,' ~ ',a22,i6,f7.1)
enddo
enddo ! ifile loop
999 end program ft8d

172
lib/ft8/ft8sim.f90
View File

@ -1,172 +0,0 @@
program ft8sim
! Generate simulated data for a 15-second HF/6m mode using 8-FSK.
! Output is saved to a *.wav file.
use wavhdr
include 'ft8_params.f90' !Set various constants
parameter (NWAVE=NN*NSPS)
type(hdr) h !Header for .wav file
character arg*12,fname*17
character msg40*40,msg*22,msgsent*22,msg0*22
character*6 mygrid6
logical bcontest
complex c0(0:NMAX-1)
complex c(0:NMAX-1)
real wave(NMAX)
integer itone(NN)
integer*1 msgbits(KK)
integer*2 iwave(NMAX) !Generated full-length waveform
data mygrid6/'EM48 '/
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.8) then
print*,'Usage: ft8sim "message" nsig|f0 DT fdop del width nfiles snr'
print*,'Examples: ft8sim "K1ABC W9XYZ EN37" 1500.0 0.0 0.1 1.0 0 10 -18'
print*,' ft8sim "K1ABC W9XYZ EN37" 10 0.0 0.1 1.0 25 10 -18'
print*,' ft8sim "K1ABC W9XYZ EN37" 25 0.0 0.1 1.0 25 10 -18'
print*,' ft8sim "K1ABC RR73; W9XYZ <KH1/KH7Z> -11" 300 0 0 0 25 1 -10'
print*,'Make nfiles negative to invoke 72-bit contest mode.'
go to 999
endif
call getarg(1,msg40) !Message to be transmitted
call getarg(2,arg)
read(arg,*) f0 !Frequency (only used for single-signal)
call getarg(3,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(4,arg)
read(arg,*) fspread !Watterson frequency spread (Hz)
call getarg(5,arg)
read(arg,*) delay !Watterson delay (ms)
call getarg(6,arg)
read(arg,*) width !Filter transition width (Hz)
call getarg(7,arg)
read(arg,*) nfiles !Number of files
call getarg(8,arg)
read(arg,*) snrdb !SNR_2500
nsig=1
if(f0.lt.100.0) then
nsig=f0
f0=1500
endif
bcontest=nfiles.lt.0
nfiles=abs(nfiles)
twopi=8.0*atan(1.0)
fs=12000.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
tt=NSPS*dt !Duration of symbols (s)
baud=1.0/tt !Keying rate (baud)
bw=8*baud !Occupied bandwidth (Hz)
txt=NZ*dt !Transmission length (s)
bandwidth_ratio=2500.0/(fs/2.0)
sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
if(snrdb.gt.90.0) sig=1.0
txt=NN*NSPS/12000.0
! Source-encode, then get itone()
if(index(msg40,';').le.0) then
i3bit=0
msg=msg40(1:22)
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
write(*,1000) f0,xdt,txt,snrdb,bw,msgsent
1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, &
' BW:',f4.1,2x,a22)
else
call foxgen_wrap(msg40,msgbits,itone)
write(*,1001) f0,xdt,txt,snrdb,bw,msg40
1001 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1, &
' BW:',f4.1,2x,a40)
endif
write(*,1030) msgbits(1:56)
1030 format(/'Call1: ',28i1,' Call2: ',28i1)
write(*,1032) msgbits(57:72),msgbits(73:75),msgbits(76:87)
1032 format('Grid: ',16i1,' 3Bit: ',3i1,' CRC12: ',12i1)
write(*,1034) itone
1034 format(/'Channel symbols:'/79i1/)
msg0=msg
do ifile=1,nfiles
c=0.
do isig=1,nsig
c0=0.
if(nsig.eq.2) then
if(index(msg,'R-').gt.0) f0=500
i1=index(msg,' ')
msg(i1+4:i1+4)=char(ichar('A')+isig-1)
if(isig.eq.2) then
f0=f0+100
endif
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
endif
if(nsig.eq.25) then
f0=(isig+2)*100.0
else if(nsig.eq.50) then
msg=msg0
f0=1000.0 + (isig-1)*60.0
i1=index(msg,' ')
i2=index(msg(i1+1:),' ') + i1
msg(i1+2:i1+2)=char(ichar('0')+mod(isig-1,10))
msg(i1+3:i1+3)=char(ichar('A')+mod(isig-1,26))
msg(i1+4:i1+4)=char(ichar('A')+mod(isig-1,26))
msg(i1+5:i1+5)=char(ichar('A')+mod(isig-1,26))
write(msg(i2+3:i2+4),'(i2.2)') isig-1
if(ifile.ge.2 .and. isig.eq.ifile-1) then
write(msg(i2+1:i2+4),1002) -isig
1002 format('R',i3.2)
f0=600.0 + mod(isig-1,5)*60.0
endif
call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
endif
k=-1 + nint((xdt+0.5+0.01*gran())/dt)
! k=-1 + nint((xdt+0.5)/dt)
ia=k+1
phi=0.0
do j=1,NN !Generate complex waveform
dphi=twopi*(f0+itone(j)*baud)*dt
do i=1,NSPS
k=k+1
phi=mod(phi+dphi,twopi)
if(k.ge.0 .and. k.lt.NMAX) c0(k)=cmplx(cos(phi),sin(phi))
enddo
enddo
if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c0,NMAX,fs,delay,fspread)
c=c+sig*c0
enddo
ib=k
wave=real(c)
peak=maxval(abs(wave(ia:ib)))
rms=sqrt(dot_product(wave(ia:ib),wave(ia:ib))/NWAVE)
nslots=1
if(width.gt.0.0) call filt8(f0,nslots,width,wave)
if(snrdb.lt.90) then
do i=1,NMAX !Add gaussian noise at specified SNR
xnoise=gran()
! wave(i)=wave(i) + xnoise
! if(i.ge.ia .and. i.le.ib) write(30,3001) i,wave(i)/peak
!3001 format(i8,f12.6)
wave(i)=wave(i) + xnoise
enddo
endif
fac=32767.0
rms=100.0
if(snrdb.ge.90.0) iwave(1:NMAX)=nint(fac*wave)
if(snrdb.lt.90.0) iwave(1:NMAX)=nint(rms*wave)
h=default_header(12000,NMAX)
write(fname,1102) ifile
1102 format('000000_',i6.6,'.wav')
open(10,file=fname,status='unknown',access='stream')
write(10) h,iwave !Save to *.wav file
close(10)
write(*,1110) ifile,xdt,f0,snrdb,fname
1110 format(i4,f7.2,f8.2,f7.1,2x,a17)
enddo
999 end program ft8sim

24
lib/ft8/genft8refsig.f90
View File

@ -1,24 +0,0 @@
subroutine genft8refsig(itone,cref,f0)
include 'ft8_params.f90'
complex cref(NN*NSPS)
integer itone(NN)
real*8 twopi,phi,dphi,dt,xnsps
data twopi/0.d0/
save twopi
if( twopi .lt. 0.1 ) twopi=8.d0*atan(1.d0)
xnsps=NSPS*1.0d0
dt=1.d0/12000.d0
phi=0.d0
k=1
do i=1,NN
dphi=twopi*(f0*dt+itone(i)/xnsps)
do is=1,NSPS
cref(k)=cmplx(cos(phi),sin(phi))
phi=mod(phi+dphi,twopi)
k=k+1
enddo
enddo
return
end subroutine genft8refsig

63
lib/ft8/subtractft8.f90
View File

@ -1,63 +0,0 @@
subroutine subtractft8(dd,itone,f0,dt)
! Subtract an ft8 signal
!
! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t))
! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) )
! Complex amp : cfilt(t) = LPF[ dd(t)*CONJG(cref(t)) ]
! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt}
use timer_module, only: timer
include 'ft8_params.f90'
parameter (NFRAME=NSPS*NN)
parameter (NFFT=NMAX, NFILT=1400)
real*4 dd(NMAX), window(-NFILT/2:NFILT/2)
complex cref,camp,cfilt,cw
integer itone(NN)
logical first
data first/.true./
common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX)
save first
nstart=dt*12000+1
call genft8refsig(itone,cref,f0)
camp=0.
do i=1,nframe
id=nstart-1+i
if(id.ge.1.and.id.le.NMAX) camp(i)=dd(id)*conjg(cref(i))
enddo
if(first) then
! Create and normalize the filter
pi=4.0*atan(1.0)
fac=1.0/float(nfft)
sum=0.0
do j=-NFILT/2,NFILT/2
window(j)=cos(pi*j/NFILT)**2
sum=sum+window(j)
enddo
cw=0.
cw(1:NFILT+1)=window/sum
cw=cshift(cw,NFILT/2+1)
call four2a(cw,nfft,1,-1,1)
cw=cw*fac
first=.false.
endif
cfilt=0.0
cfilt(1:nframe)=camp(1:nframe)
call four2a(cfilt,nfft,1,-1,1)
cfilt(1:nfft)=cfilt(1:nfft)*cw(1:nfft)
call four2a(cfilt,nfft,1,1,1)
! Subtract the reconstructed signal
do i=1,nframe
j=nstart+i-1
if(j.ge.1 .and. j.le.NMAX) dd(j)=dd(j)-2*REAL(cfilt(i)*cref(i))
enddo
return
end subroutine subtractft8

144
lib/ft8/sync8.f90
View File

@ -1,144 +0,0 @@
subroutine sync8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
include 'ft8_params.f90'
complex cx(0:NH1)
real s(NH1,NHSYM)
real savg(NH1)
real sbase(NH1)
real x(NFFT1)
real sync2d(NH1,-JZ:JZ)
real red(NH1)
real candidate0(3,200)
real candidate(3,200)
real dd(NMAX)
integer jpeak(NH1)
integer indx(NH1)
integer ii(1)
integer icos7(0:6)
data icos7/4,2,5,6,1,3,0/ !Costas 7x7 tone pattern
equivalence (x,cx)
! Compute symbol spectra, stepping by NSTEP steps.
savg=0.
tstep=NSTEP/12000.0
df=12000.0/NFFT1 !3.125 Hz
fac=1.0/300.0
do j=1,NHSYM
ia=(j-1)*NSTEP + 1
ib=ia+NSPS-1
x(1:NSPS)=fac*dd(ia:ib)
x(NSPS+1:)=0.
call four2a(x,NFFT1,1,-1,0) !r2c FFT
do i=1,NH1
s(i,j)=real(cx(i))**2 + aimag(cx(i))**2
enddo
savg=savg + s(1:NH1,j) !Average spectrum
enddo
call baseline(savg,nfa,nfb,sbase)
ia=max(1,nint(nfa/df))
ib=nint(nfb/df)
nssy=NSPS/NSTEP ! # steps per symbol
nfos=NFFT1/NSPS ! # frequency bin oversampling factor
jstrt=0.5/tstep
candidate0=0.
k=0
do i=ia,ib
do j=-JZ,+JZ
ta=0.
tb=0.
tc=0.
t0a=0.
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))
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))
endif
enddo
t=ta+tb+tc
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
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
do i=1,min(200,iz)
n=ia + indx(iz+1-i) - 1
if(red(n).lt.syncmin.or.isnan(red(n)).or.k.eq.200) 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.
do i=1,ncand
if(abs(candidate0(1,i)-nfqso).lt.10.0) candidate0(1,i)=-candidate0(1,i)
if(i.ge.2) then
do j=1,i-1
fdiff=abs(candidate0(1,i))-abs(candidate0(1,j))
if(abs(fdiff).lt.AZ) then ! note: this dedupe difference is dependent on symbol spacing
if(candidate0(3,i).ge.candidate0(3,j)) candidate0(3,j)=0.
if(candidate0(3,i).lt.candidate0(3,j)) candidate0(3,i)=0.
endif
enddo
endif
enddo
fac=20.0/maxval(s)
s=fac*s
! Sort by sync
! call indexx(candidate0(3,1:ncand),ncand,indx)
! Sort by frequency
call indexx(candidate0(1,1:ncand),ncand,indx)
k=1
! do i=ncand,1,-1
do i=1,ncand
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)
k=k+1
endif
enddo
ncand=k-1
return
end subroutine sync8

56
lib/ft8/sync8d.f90
View File

@ -1,56 +0,0 @@
subroutine sync8d(cd0,i0,ctwk,itwk,sync)
! Compute sync power for a complex, downsampled FT8 signal.
include 'ft8_params.f90'
parameter(NP2=2812)
complex cd0(3125)
complex csync(0:6,NDOWNSPS)
complex csync2(NDOWNSPS)
complex ctwk(NDOWNSPS)
complex z1,z2,z3
logical first
integer icos7(0:6)
data icos7/4,2,5,6,1,3,0/
data first/.true./
save first,twopi,fs2,dt2,taus,baud,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=NDOWNSPS*dt2 !Symbol duration
baud=1.0/taus !Keying rate
do i=0,6
phi=0.0
dphi=twopi*icos7(i)*baud*dt2
do j=1,NDOWNSPS
csync(i,j)=cmplx(cos(phi),sin(phi)) !Waveform for 7x7 Costas array
phi=mod(phi+dphi,twopi)
enddo
enddo
first=.false.
endif
sync=0
do i=0,6 !Sum over 7 Costas frequencies and
i1=i0+i*NDOWNSPS !three Costas arrays
i2=i1+36*NDOWNSPS
i3=i1+72*NDOWNSPS
csync2=csync(i,1:NDOWNSPS)
if(itwk.eq.1) csync2=ctwk*csync2 !Tweak the frequency
z1=0.
z2=0.
z3=0.
if(i1.ge.1 .and. i1+(NDOWNSPS-1).le.NP2) z1=sum(cd0(i1:i1+(NDOWNSPS-1))*conjg(csync2))
if(i2.ge.1 .and. i2+(NDOWNSPS-1).le.NP2) z2=sum(cd0(i2:i2+(NDOWNSPS-1))*conjg(csync2))
if(i3.ge.1 .and. i3+(NDOWNSPS-1).le.NP2) z3=sum(cd0(i3:i3+(NDOWNSPS-1))*conjg(csync2))
sync = sync + p(z1) + p(z2) + p(z3)
enddo
return
end subroutine sync8d

BIN
lib/ft8_decode.mod Normal file
View File

Binary file not shown.

3
lib/js8/js8_params.f90
View File

@ -1,2 +1 @@
parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas)
parameter (NWRITELOG=0) !Write log file?
parameter (NWRITELOG=1) !Write log file?

19
lib/js8/js8a_params.f90 Normal file
View File

@ -0,0 +1,19 @@
parameter (NCOSTAS=1) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas)
parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=62) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz
parameter (ASTART=0.5) !Start delay in seconds
parameter (ASYNCMIN=1.5) !Minimum Sync
parameter (KK=87) !Information bits (75 + CRC12)
parameter (ND=58) !Data symbols
parameter (NS=21) !Sync symbols (3 @ Costas 7x7)
parameter (NN=NS+ND) !Total channel symbols (79)
parameter (NZ=NSPS*NN) !Samples in full 15 s waveform (151,680)
parameter (NMAX=NTXDUR*12000) !Samples in iwave (180,000)
parameter (NFFT1=2*NSPS, NH1=NFFT1/2) !Length of FFTs for symbol spectra
parameter (NSTEP=NSPS/4) !Rough time-sync step size
parameter (NHSYM=NMAX/NSTEP-3) !Number of symbol spectra (1/4-sym steps)
parameter (NDOWN=NSPS/NDOWNSPS) !Downsample factor to 32 samples per symbol
parameter (NQSYMBOL=NDOWNSPS/4) !Downsample factor of a quarter symbol

21
lib/js8/js8b_params.f90
View File

@ -1,23 +1,6 @@
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ?
parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas)
! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=16, NDD=150, JZ=116) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=16, NDD=160, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s
! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=116) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s
! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s
! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s
parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=144) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
! parameter (NSPS=4000, NTXDUR=30, NDOWNSPS=20, NDD=90, JZ=62) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s
parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=144) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz
parameter (ASTART=0.2) !Start delay in seconds

21
lib/js8/js8c_params.f90
View File

@ -1,23 +1,6 @@
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ?
parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas)
! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=16, NDD=150, JZ=116) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=16, NDD=160, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=16, NDD=136, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s
parameter (NSPS=600, NTXDUR=6, NDOWNSPS=12, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s
! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s
! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s
! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
! parameter (NSPS=4000, NTXDUR=30, NDOWNSPS=20, NDD=90, JZ=62) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s
parameter (NSPS=600, NTXDUR=6, NDOWNSPS=12, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz
parameter (ASTART=0.1) !Start delay in seconds

39
lib/js8/js8dec.f90
View File

@ -494,3 +494,42 @@ subroutine js8dec(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
return
end subroutine js8dec
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

22
lib/js8/js8e_params.f90
View File

@ -1,24 +1,6 @@
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ?
parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas)
! parameter (NSPS=384, NTXDUR=4, NDOWNSPS=12, NDD=125, JZ=250) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s
! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s
! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s
! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s
! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
parameter (NSPS=3840, NTXDUR=28, NDOWNSPS=32, NDD=90, JZ=32) ! 25 Hz 3.125 baud 8 wpm -28.0dB (1.0Eb/N0) 25.28s
! parameter (NSPS=4000, NTXDUR=28, NDOWNSPS=40, NDD=90, JZ=32) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s
parameter (NSPS=3840, NTXDUR=28, NDOWNSPS=32, NDD=90, JZ=32) ! 25 Hz 3.125 baud 8 wpm -28.0dB (1.0Eb/N0) 25.28s
parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz
parameter (ASTART=0.5) !Start delay in seconds

22
lib/js8/js8i_params.f90
View File

@ -1,24 +1,6 @@
!parameter (NSPS=480) !Samples per symbol at 12000 S/s
!parameter (NTXDUR=5) !TX Duration in Seconds
!parameter (NDOWNSPS=16) !Downsampled samples per symbol
!parameter (AZ=6.0) !Near dupe sync spacing
!parameter (NDD=136) !Downconverted FFT Bins - 100 Bins
!parameter (JZ=62) !Sync Search Space over +/- 2.5s relative to 0.5s TX start time. 2.48 = 62/4/(12000/1920) ?
parameter (NCOSTAS=2) !Which JS8 Costas Arrays to use (1=original, 2=three symmetrical costas)
parameter (NSPS=384, NTXDUR=4, NDOWNSPS=12, NDD=125, JZ=250) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=384, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 250 Hz 31.25 baud 48 wpm -18.0dB (1.0Eb/N0) 2.52s
! parameter (NSPS=480, NTXDUR=5, NDOWNSPS=12, NDD=125, JZ=116) ! 200 Hz 25 baud 48 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=480, NTXDUR=6, NDOWNSPS=20, NDD=150, JZ=116) ! 200 Hz 25 baud 40 wpm -19.0dB (1.0Eb/N0) 3.16s
! parameter (NSPS=500, NTXDUR=6, NDOWNSPS=20, NDD=144, JZ=116) ! 192 Hz 24 baud 40 wpm -19.4dB (1.0Eb/N0) 3.29s
! parameter (NSPS=600, NTXDUR=6, NDOWNSPS=24, NDD=120, JZ=172) ! 160 Hz 20 baud 40 wpm -20.0dB (1.0Eb/N0) 3.95s
! parameter (NSPS=768, NTXDUR=8, NDOWNSPS=24, NDD=125, JZ=116) ! 125 Hz 15.625 baud 32 wpm -21.0dB (1.0Eb/N0) 5.05s
! parameter (NSPS=800, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 120 Hz 15 baud 32 wpm -21.2dB (1.0Eb/N0) 5.26s
! parameter (NSPS=960, NTXDUR=8, NDOWNSPS=24, NDD=100, JZ=116) ! 100 Hz 12.50 baud 32 wpm -22.0dB (1.0Eb/N0) 5.92s
! parameter (NSPS=1200, NTXDUR=10, NDOWNSPS=20, NDD=100, JZ=116) ! 80 Hz 10 baud 24 wpm -23.0dB (1.0Eb/N0) 7.90s
! parameter (NSPS=1920, NTXDUR=15, NDOWNSPS=32, NDD=100, JZ=116) ! 50 Hz 6.250 baud 16 wpm -25.0dB (1.0Eb/N0) 12.64s
! parameter (NSPS=3840, NTXDUR=30, NDOWNSPS=32, NDD=94, JZ=116) ! 24 Hz 3.125 baud 8 wpm -28.0dB (1.0Eb/N0) 25.28s
! parameter (NSPS=4000, NTXDUR=28, NDOWNSPS=20, NDD=90, JZ=32) ! 24 Hz 3 baud 8 wpm -28.2dB (1.0Eb/N0) 26.33s
parameter (NSPS=384, NTXDUR=4, NDOWNSPS=12, NDD=125, JZ=250) ! 250 Hz 31.25 baud 60 wpm -18.0dB (1.0Eb/N0) 2.52s
parameter (AZ=12000.0/(1.0*NSPS)*0.8d0) !Dedupe overlap in Hz
parameter (ASTART=0.1) !Start delay in seconds

7
lib/ft8/ldpcsim174.f90 → lib/js8/ldpcsim174js8a.f90
View File

@ -1,9 +1,10 @@
program ldpcsim174
program ldpcsim174js8
! End to end test of the (174,75)/crc12 encoder and decoder.
use crc
use packjt
include 'ft8_params.f90'
include 'js8_params.f90'
include 'js8a_params.f90'
character*22 msg,msgsent,msgreceived
character*8 arg
@ -234,4 +235,4 @@ do i=1,87
enddo
close(25)
end program ldpcsim174
end program ldpcsim174js8

10
lib/js8/syncjs8.f90
View File

@ -144,7 +144,6 @@ subroutine syncjs8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
enddo
ncand=k
! Save only the best of near-dupe freqs.
do i=1,ncand
if(i.ge.2) then
@ -158,23 +157,18 @@ subroutine syncjs8(dd,nfa,nfb,syncmin,nfqso,s,candidate,ncand,sbase)
endif
enddo
! Put nfqso at top of list
do i=1,ncand
if(abs(candidate0(1,i)-nfqso).lt.10.0) candidate0(1,i)=-candidate0(1,i)
enddo
fac=20.0/maxval(s)
s=fac*s
! Sort by sync
! call indexx(candidate0(3,1:ncand),ncand,indx)
! Sort by frequency
call indexx(candidate0(1,1:ncand),ncand,indx)
k=1
! do i=ncand,1,-1
do i=1,ncand
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)

71
lib/ft8_decode.f90 → lib/js8a_decode.f90
View File

@ -1,25 +1,16 @@
module ft8_decode
module js8a_decode
parameter (MAXFOX=1000)
character*12 c2fox(MAXFOX)
character*4 g2fox(MAXFOX)
integer nsnrfox(MAXFOX)
integer nfreqfox(MAXFOX)
integer n30fox(MAXFOX)
integer n30z
integer nfox
type :: ft8_decoder
procedure(ft8_decode_callback), pointer :: callback
type :: js8a_decoder
procedure(js8a_decode_callback), pointer :: callback
contains
procedure :: decode
end type ft8_decoder
end type js8a_decoder
abstract interface
subroutine ft8_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual)
import ft8_decoder
subroutine js8a_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual)
import js8a_decoder
implicit none
class(ft8_decoder), intent(inout) :: this
class(js8a_decoder), intent(inout) :: this
real, intent(in) :: sync
integer, intent(in) :: snr
real, intent(in) :: dt
@ -27,7 +18,7 @@ module ft8_decode
character(len=37), intent(in) :: decoded
integer, intent(in) :: nap
real, intent(in) :: qual
end subroutine ft8_decode_callback
end subroutine js8a_decode_callback
end interface
contains
@ -37,11 +28,11 @@ contains
mycall12,mygrid6,hiscall12,hisgrid6)
! use wavhdr
use timer_module, only: timer
include 'ft8/ft8_params.f90'
! type(hdr) h
use js8a_module
class(ft8_decoder), intent(inout) :: this
procedure(ft8_decode_callback) :: callback
class(js8a_decoder), intent(inout) :: this
procedure(js8a_decode_callback) :: callback
real s(NH1,NHSYM)
real sbase(NH1)
real candidate(3,200)
@ -83,7 +74,7 @@ contains
if(ndepth.ge.2) npass=3
do ipass=1,npass
newdat=.true. ! Is this a problem? I hijacked newdat.
syncmin=1.5
syncmin=ASYNCMIN
if(ipass.eq.1) then
lsubtract=.true.
if(ndepth.eq.1) lsubtract=.false.
@ -96,9 +87,14 @@ contains
lsubtract=.false.
endif
call timer('sync8 ',0)
call sync8(dd,ifa,ifb,syncmin,nfqso,s,candidate,ncand,sbase)
call timer('sync8 ',1)
call timer('syncjs8 ',0)
call syncjs8(dd,ifa,ifb,syncmin,nfqso,s,candidate,ncand,sbase)
call timer('syncjs8 ',1)
if(NWRITELOG.eq.1) then
write(*,*) '<DecodeDebug>', ncand, "candidates"
flush(6)
endif
do icand=1,ncand
sync=candidate(3,icand)
@ -106,16 +102,28 @@ contains
xdt=candidate(2,icand)
xbase=10.0**(0.1*(sbase(nint(f1/(12000.0/NFFT1)))-40.0)) ! 3.125Hz
nsnr0=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ###
call timer('ft8b ',0)
call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon, &
if(NWRITELOG.eq.1) then
write(*,*) '<DecodeDebug> candidate', icand, 'f1', f1, 'sync', sync, 'xdt', xdt, 'xbase', xbase
flush(6)
endif
call timer('js8dec ',0)
call js8dec(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)
message=msg37(1:22) !###
nsnr=nint(xsnr)
xdt=xdt-0.5
xdt=xdt-ASTART
hd=nharderrors+dmin
call timer('ft8b ',1)
if(NWRITELOG.eq.1) then
write(*,*) '<DecodeDebug> candidate', icand, 'hard', hd, 'nbadcrc', nbadcrc
flush(6)
endif
call timer('js8dec ',1)
if(nbadcrc.eq.0) then
ldupe=.false.
do id=1,ndecodes
@ -131,9 +139,14 @@ contains
call this%callback(sync,nsnr,xdt,f1,msg37,iaptype,qual)
endif
endif
if(NWRITELOG.eq.1) then
write(*,*) '<DecodeDebug> ---'
flush(6)
endif
enddo
enddo
return
end subroutine decode
end module ft8_decode
end module js8a_decode

13
lib/js8a_module.f90 Normal file
View File

@ -0,0 +1,13 @@
module js8a_module
include 'js8/js8_params.f90'
include 'js8/js8a_params.f90'
contains
include 'js8/baselinejs8.f90'
include 'js8/syncjs8.f90'
include 'js8/js8_downsample.f90'
include 'js8/syncjs8d.f90'
include 'js8/genjs8refsig.f90'
include 'js8/subtractjs8.f90'
include 'js8/js8dec.f90'
end module js8a_module

175
lib/ldpcsim144.f90
View File

@ -1,175 +0,0 @@
program ldpcsim
use, intrinsic :: iso_c_binding
use iso_c_binding, only: c_loc,c_size_t
use hashing
use packjt
parameter(NRECENT=10)
character*12 recent_calls(NRECENT)
character*22 msg,msgsent,msgreceived
character*8 arg
integer*1, allocatable :: codeword(:), decoded(:), message(:)
integer*1, target:: i1Msg8BitBytes(10)
integer*1 i1hash(4)
integer*1 msgbits(80)
integer*4 i4Msg6BitWords(13)
integer ihash
integer nerrtot(128),nerrdec(128)
real*8, allocatable :: lratio(:), rxdata(:), rxavgd(:)
real, allocatable :: yy(:), llr(:)
equivalence(ihash,i1hash)
do i=1,NRECENT
recent_calls(i)=' '
enddo
nerrtot=0
nerrdec=0
nargs=iargc()
if(nargs.ne.4) then
print*,'Usage: ldpcsim niter navg #trials s '
print*,'eg: ldpcsim 10 1 1000 0.75'
return
endif
call getarg(1,arg)
read(arg,*) max_iterations
call getarg(2,arg)
read(arg,*) navg
call getarg(3,arg)
read(arg,*) ntrials
call getarg(4,arg)
read(arg,*) s
! don't count hash bits as data bits
N=128
K=72
rate=real(K)/real(N)
write(*,*) "rate: ",rate
write(*,*) "niter= ",max_iterations," navg= ",navg," s= ",s
allocate ( codeword(N), decoded(K), message(K) )
allocate ( lratio(N), rxdata(N), rxavgd(N), yy(N), llr(N) )
msg="K9AN K1JT EN50"
call packmsg(msg,i4Msg6BitWords,itype,.false.) !Pack into 12 6-bit bytes
call unpackmsg(i4Msg6BitWords,msgsent,.false.,' ') !Unpack to get msgsent
write(*,*) "message sent ",msgsent
i4=0
ik=0
im=0
do i=1,12
nn=i4Msg6BitWords(i)
do j=1, 6
ik=ik+1
i4=i4+i4+iand(1,ishft(nn,j-6))
i4=iand(i4,255)
if(ik.eq.8) then
im=im+1
! if(i4.gt.127) i4=i4-256
i1Msg8BitBytes(im)=i4
ik=0
endif
enddo
enddo
ihash=nhash(c_loc(i1Msg8BitBytes),int(9,c_size_t),146)
ihash=2*iand(ihash,32767) !Generate the 8-bit hash
i1Msg8BitBytes(10)=i1hash(1) !Hash code to byte 10
mbit=0
do i=1, 10
i1=i1Msg8BitBytes(i)
do ibit=1,8
mbit=mbit+1
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
enddo
enddo
call encode_msk144(msgbits,codeword)
call init_random_seed()
write(*,*) "Eb/N0 SNR2500 ngood nundetected nbadhash sigma"
do idb = -6, 14
db=idb/2.0-1.0
sigma=1/sqrt( 2*rate*(10**(db/10.0)) )
ngood=0
nue=0
nbadhash=0
do itrial=1, ntrials
rxavgd=0d0
do iav=1,navg
call sgran()
! Create a realization of a noisy received word
do i=1,N
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
enddo
rxavgd=rxavgd+rxdata
enddo
rxdata=rxavgd
nerr=0
do i=1,N
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
enddo
nerrtot(nerr)=nerrtot(nerr)+1
! Correct signal normalization is important for this decoder.
rxav=sum(rxdata)/N
rx2av=sum(rxdata*rxdata)/N
rxsig=sqrt(rx2av-rxav*rxav)
rxdata=rxdata/rxsig
! To match the metric to the channel, s should be set to the noise standard deviation.
! For now, set s to the value that optimizes decode probability near threshold.
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
! magnitude in UER
if( s .lt. 0 ) then
ss=sigma
else
ss=s
endif
llr=2.0*rxdata/(ss*ss)
lratio=exp(llr)
yy=rxdata
! max_iterations is max number of belief propagation iterations
! call ldpc_decode(lratio, decoded, max_iterations, niterations, max_dither, ndither)
! call amsdecode(yy, max_iterations, decoded, niterations)
! call bitflipmsk144(rxdata, decoded, niterations)
call bpdecode144(llr, max_iterations, decoded, niterations)
! If the decoder finds a valid codeword, niterations will be .ge. 0.
if( niterations .ge. 0 ) then
call extractmessage144(decoded,msgreceived,nhashflag,recent_calls,nrecent)
if( nhashflag .ne. 1 ) then
nbadhash=nbadhash+1
endif
nueflag=0
! Check the message plus hash against what was sent.
do i=1,K
if( msgbits(i) .ne. decoded(i) ) then
nueflag=1
endif
enddo
if( nhashflag .eq. 1 .and. nueflag .eq. 0 ) then
ngood=ngood+1
nerrdec(nerr)=nerrdec(nerr)+1
else if( nhashflag .eq. 1 .and. nueflag .eq. 1 ) then
nue=nue+1;
endif
endif
enddo
snr2500=db-3.5
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2)") db,snr2500,ngood,nue,nbadhash,ss
enddo
open(unit=23,file='nerrhisto.dat',status='unknown')
do i=1,128
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
enddo
close(23)
end program ldpcsim