2018-02-08 21:28:33 -05:00
|
|
|
program wspr_fsk8d
|
|
|
|
|
|
|
|
|
|
! WSPR-LF is a potential WSPR-like mode intended for use at LF and MF.
|
|
|
|
|
! This version uses 4-minute T/R sequences, an LDPC (300,60) code,
|
|
|
|
|
! 8-FSK modulation, and noncoherent demodulation. This decoder reads
|
|
|
|
|
! data from *.wav files.
|
|
|
|
|
|
|
|
|
|
! Reception and Demodulation algorithm:
|
|
|
|
|
! 1. Compute coarse spectrum; find fc1 = approx carrier freq
|
|
|
|
|
! 2. Mix from fc1 to 0; LPF at +/- 0.75*R
|
|
|
|
|
! 3. Find two 7x7 Costas arrays to get xdt and fc2
|
|
|
|
|
! 4. Mix from fc2 to 0, compute aligned symbol spectra
|
|
|
|
|
! 5. Get soft bits from symbol spectra
|
|
|
|
|
|
|
|
|
|
! Still to do: find and decode more than one signal in the specified passband.
|
|
|
|
|
|
|
|
|
|
include 'wspr_fsk8_params.f90'
|
|
|
|
|
character arg*8,message*22,cbits*50,infile*80,fname*16,datetime*11
|
|
|
|
|
character*120 data_dir
|
|
|
|
|
complex csync(0:N7-1) !Sync symbols for Costas 7x7 array
|
|
|
|
|
complex c1(0:2*N7-1)
|
|
|
|
|
complex c2(0:2*N7-1)
|
|
|
|
|
complex c(0:NMAXD-1) !Complex waveform
|
|
|
|
|
real*8 fMHz
|
|
|
|
|
real rxdata(3*ND),llr(3*ND) !Soft symbols
|
|
|
|
|
real a(5) !For twkfreq1
|
|
|
|
|
real s(0:NH2,NN)
|
|
|
|
|
real savg(0:NH2)
|
|
|
|
|
real ss(0:N7)
|
|
|
|
|
real ss0(0:N7)
|
|
|
|
|
real ps(0:7)
|
|
|
|
|
integer ihdr(11)
|
|
|
|
|
integer*2 iwave(NMAX) !Generated full-length waveform
|
|
|
|
|
integer*1 idat(7)
|
|
|
|
|
integer*1 decoded(KK),apmask(3*ND),cw(3*ND)
|
|
|
|
|
integer icos7(0:6)
|
|
|
|
|
data icos7/2,5,6,0,4,1,3/ !Costas 7x7 tone pattern
|
|
|
|
|
|
|
|
|
|
nargs=iargc()
|
|
|
|
|
if(nargs.lt.7) then
|
|
|
|
|
print*,'Usage: wspr_fsk8d -d db -f fMHz -a data_dir file1 [file2 ...]'
|
|
|
|
|
go to 999
|
|
|
|
|
endif
|
|
|
|
|
call getarg(1,arg)
|
|
|
|
|
if(arg(1:3).ne.'-d ') go to 999
|
|
|
|
|
call getarg(2,arg)
|
|
|
|
|
read(arg,*) degrade
|
|
|
|
|
rxbw=3000.
|
|
|
|
|
|
|
|
|
|
call getarg(3,arg)
|
|
|
|
|
if(arg(1:3).ne.'-f ') go to 999
|
|
|
|
|
call getarg(4,arg)
|
|
|
|
|
read(arg,*) fMHz
|
|
|
|
|
|
|
|
|
|
call getarg(5,arg)
|
|
|
|
|
if(arg(1:3).ne.'-a ') go to 999
|
|
|
|
|
call getarg(6,data_dir)
|
|
|
|
|
|
|
|
|
|
open(13,file=trim(data_dir)//'/ALL_WSPR.TXT',status='unknown', &
|
|
|
|
|
position='append')
|
|
|
|
|
|
|
|
|
|
twopi=8.0*atan(1.0)
|
|
|
|
|
fs=NSPS*12000.0/NSPS0 !Sample rate after downsampling (Hz)
|
|
|
|
|
dt=1.0/fs !Sample interval (s)
|
|
|
|
|
ts=NSPS*dt !Symbol duration (s)
|
|
|
|
|
baud=1.0/ts !Keying rate (Hz)
|
|
|
|
|
txt=NZ*dt !Transmission length (s)
|
|
|
|
|
|
|
|
|
|
phi=0.
|
|
|
|
|
k=-1
|
|
|
|
|
do j=0,6
|
|
|
|
|
dphi=twopi*baud*icos7(j)*dt
|
|
|
|
|
do i=1,NSPS
|
|
|
|
|
phi=phi+dphi
|
|
|
|
|
if(phi.gt.twopi) phi=phi-twopi
|
|
|
|
|
k=k+1
|
|
|
|
|
csync(k)=cmplx(cos(phi),sin(phi))
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
do ifile=7,nargs
|
|
|
|
|
call getarg(ifile,infile)
|
|
|
|
|
open(10,file=infile,status='old',access='stream')
|
|
|
|
|
j1=index(infile,'.c4')
|
|
|
|
|
j2=index(infile,'.wav')
|
|
|
|
|
if(j1.gt.0) then
|
|
|
|
|
read(10,end=999) fname,ntrmin,fMHz,c(0:NZ-1)
|
|
|
|
|
read(fname(8:11),*) nutc
|
|
|
|
|
write(datetime,'(i11)') nutc
|
|
|
|
|
else if(j2.gt.0) then
|
|
|
|
|
read(10,end=999) ihdr,iwave
|
|
|
|
|
read(infile(j2-4:j2-1),*) nutc
|
|
|
|
|
datetime=infile(j2-11:j2-1)
|
|
|
|
|
if(degrade.gt.0.0) call degrade_snr(iwave,NMAX,degrade,rxbw)
|
|
|
|
|
call wspr_fsk8_downsample(iwave,c)
|
|
|
|
|
else
|
|
|
|
|
print*,'Wrong file format?'
|
|
|
|
|
go to 999
|
|
|
|
|
endif
|
|
|
|
|
close(10)
|
|
|
|
|
pmax=0.
|
|
|
|
|
df1=fs/(2*N7)
|
|
|
|
|
ia=nint(100.0/df1)
|
|
|
|
|
ib=nint(150.0/df1)
|
|
|
|
|
ipk=0
|
|
|
|
|
jpk=0
|
|
|
|
|
! Get xdt and f0 from the sync arrays
|
|
|
|
|
do j0=0,1000,50
|
|
|
|
|
j0b=j0+107*NSPS
|
|
|
|
|
c1(0:N7-1)=c(j0:j0+N7-1)*conjg(csync)
|
|
|
|
|
c1(N7:)=0.
|
|
|
|
|
c2(0:N7-1)=c(j0b:j0b+N7-1)*conjg(csync)
|
|
|
|
|
c2(N7:)=0.
|
|
|
|
|
call four2a(c1,2*N7,1,-1,1)
|
|
|
|
|
call four2a(c2,2*N7,1,-1,1)
|
|
|
|
|
do i=0,N7
|
|
|
|
|
p=1.e-9*(real(c1(i))**2 + aimag(c1(i))**2 + &
|
|
|
|
|
real(c2(i))**2 + aimag(c2(i))**2)
|
|
|
|
|
ss(i)=p
|
|
|
|
|
enddo
|
|
|
|
|
do i=ia,ib
|
|
|
|
|
p=ss(i)
|
|
|
|
|
if(p.gt.pmax) then
|
|
|
|
|
pmax=p
|
|
|
|
|
ipk=i
|
|
|
|
|
jpk=j0
|
|
|
|
|
endif
|
|
|
|
|
enddo
|
|
|
|
|
if(jpk.eq.j0) ss0=ss
|
|
|
|
|
enddo
|
|
|
|
|
f0=ipk*df1
|
|
|
|
|
xdt=jpk*dt - 1.0
|
|
|
|
|
|
|
|
|
|
sp3n=(ss0(ipk-1)+ss0(ipk)+ss0(ipk+1)) !Sig + 3*noise
|
|
|
|
|
call pctile(ss0,N7,45,base)
|
|
|
|
|
psig=sp3n-3*base !Sig only
|
|
|
|
|
pnoise=(2500.0/df1)*base !Noise in 2500 Hz
|
|
|
|
|
xsnr=db(psig/pnoise) !SNR from sync tones
|
|
|
|
|
|
|
|
|
|
if(jpk.ge.0) c(0:NMAXD-1-jpk)=c(jpk:NMAXD-1)
|
|
|
|
|
|
|
|
|
|
a(1)=-f0
|
|
|
|
|
a(2:5)=0.
|
|
|
|
|
call twkfreq1(c,NZ,fs,a,c) !Mix from f0 down to 0
|
|
|
|
|
call spec8(c,s,savg) !Get symbol spectra
|
|
|
|
|
|
|
|
|
|
do j=1,ND
|
|
|
|
|
k=j+7
|
|
|
|
|
ps=s(0:7,k)
|
2018-03-05 14:49:51 -05:00
|
|
|
ps=sqrt(ps) !### ??? ###
|
|
|
|
|
! ps=log(ps)
|
2018-02-08 21:28:33 -05:00
|
|
|
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))
|
|
|
|
|
rxdata(3*j-2)=r4
|
|
|
|
|
rxdata(3*j-1)=r2
|
|
|
|
|
rxdata(3*j)=r1
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
rxav=sum(rxdata)/ND
|
|
|
|
|
rx2av=sum(rxdata*rxdata)/ND
|
|
|
|
|
rxsig=sqrt(rx2av-rxav*rxav)
|
|
|
|
|
rxdata=rxdata/rxsig
|
2018-03-05 14:49:51 -05:00
|
|
|
s0=1.1
|
2018-02-08 21:28:33 -05:00
|
|
|
llr=2.0*rxdata/(s0*s0)
|
|
|
|
|
apmask=0
|
|
|
|
|
max_iterations=40
|
|
|
|
|
ifer=0
|
|
|
|
|
call bpdecode300(llr,apmask,max_iterations,decoded,niterations,cw)
|
2018-08-05 11:33:30 -04:00
|
|
|
if(niterations.lt.0) call osd300(llr,apmask,5,decoded,cw,nhardmin,dmin)
|
|
|
|
|
if(nhardmin.ge.0) niterations=nhardmin
|
2018-02-08 21:28:33 -05:00
|
|
|
nbadcrc=0
|
|
|
|
|
if(niterations.ge.0) call chkcrc10(decoded,nbadcrc)
|
|
|
|
|
if(niterations.lt.0 .or. nbadcrc.ne.0) ifer=1
|
|
|
|
|
nsnr=nint(xsnr)
|
|
|
|
|
! freq=fMHz + 1.d-6*f0
|
|
|
|
|
freq=1.d-6*(f0+1500)
|
|
|
|
|
nfdot=0
|
|
|
|
|
message=' '
|
|
|
|
|
if(ifer.eq.0) then
|
|
|
|
|
write(cbits,1100) decoded(1:50)
|
|
|
|
|
1100 format(50i1)
|
|
|
|
|
read(cbits,1102) idat
|
|
|
|
|
1102 format(6b8,b2)
|
|
|
|
|
idat(7)=ishft(idat(7),6)
|
|
|
|
|
call wqdecode(idat,message,itype)
|
|
|
|
|
write(*,1112) datetime(8:11),nsnr,xdt,freq,nfdot,message
|
|
|
|
|
1112 format(a4,i4,f5.1,f11.6,i3,2x,a22)
|
|
|
|
|
endif
|
|
|
|
|
write(13,1110) datetime,0,nsnr,xdt,freq,message,nfdot
|
|
|
|
|
1110 format(a11,2i4,f6.2,f12.7,2x,a22,i3)
|
|
|
|
|
enddo ! ifile loop
|
|
|
|
|
write(*,1120)
|
|
|
|
|
1120 format("<DecodeFinished>")
|
|
|
|
|
|
|
|
|
|
999 end program wspr_fsk8d
|
|
|
|
|
|
