mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-12-24 11:40:31 -05:00
Add routines for testing a possible 4-FSK mode.
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@7620 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor
parent
e8b812fd08
commit
4f2d3d08d0
46
lib/fsk4hf/Makefile
Normal file
46
lib/fsk4hf/Makefile
Normal file
@ -0,0 +1,46 @@
|
|||||||
|
# Compilers
|
||||||
|
CC = gcc
|
||||||
|
CXX = g++
|
||||||
|
FC = gfortran
|
||||||
|
|
||||||
|
FFLAGS = -O2 -fbounds-check -Wall -Wno-conversion
|
||||||
|
CFLAGS = -O2 -I.
|
||||||
|
|
||||||
|
# Default rules
|
||||||
|
%.o: %.c
|
||||||
|
${CC} ${CFLAGS} -c $<
|
||||||
|
%.o: %.f
|
||||||
|
${FC} ${FFLAGS} -c $<
|
||||||
|
%.o: %.F
|
||||||
|
${FC} ${FFLAGS} -c $<
|
||||||
|
%.o: %.f90
|
||||||
|
${FC} ${FFLAGS} -c $<
|
||||||
|
%.o: %.F90
|
||||||
|
${FC} ${FFLAGS} -c $<
|
||||||
|
|
||||||
|
all: fsk4sim
|
||||||
|
|
||||||
|
OBJS0 = testpsk.o four2a.o bpfilter.o nonlinear.o tweak1.o spectrum.o smo.o
|
||||||
|
testpsk: $(OBJS0)
|
||||||
|
$(FC) -o testpsk $(OBJS0) -lfftw3f
|
||||||
|
|
||||||
|
OBJS1 = gmsk8.o four2a.o gaussfilt.o
|
||||||
|
gmsk8: $(OBJS1)
|
||||||
|
$(FC) -o gmsk8 $(OBJS1) -lfftw3f
|
||||||
|
|
||||||
|
OBJS2 = testfsk.o four2a.o smo.o
|
||||||
|
testfsk: $(OBJS2)
|
||||||
|
$(FC) -o testfsk $(OBJS2) -lfftw3f
|
||||||
|
|
||||||
|
OBJS3 = fsk2sim.o four2a.o smo.o wavhdr.o gran.o
|
||||||
|
fsk2sim: $(OBJS3)
|
||||||
|
$(FC) -o fsk2sim $(OBJS3) -lfftw3f
|
||||||
|
|
||||||
|
OBJS4 = fsk4sim.o four2a.o wavhdr.o gran.o tweak1.o
|
||||||
|
fsk4sim: $(OBJS4)
|
||||||
|
$(FC) -o fsk4sim $(OBJS4) -lfftw3f
|
||||||
|
|
||||||
|
.PHONY : clean
|
||||||
|
|
||||||
|
clean:
|
||||||
|
$(RM) *.o testpsk testfsk fsk2sim fsk4sim
|
||||||
64
lib/fsk4hf/fftw3.f90
Normal file
64
lib/fsk4hf/fftw3.f90
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
INTEGER FFTW_R2HC
|
||||||
|
PARAMETER (FFTW_R2HC=0)
|
||||||
|
INTEGER FFTW_HC2R
|
||||||
|
PARAMETER (FFTW_HC2R=1)
|
||||||
|
INTEGER FFTW_DHT
|
||||||
|
PARAMETER (FFTW_DHT=2)
|
||||||
|
INTEGER FFTW_REDFT00
|
||||||
|
PARAMETER (FFTW_REDFT00=3)
|
||||||
|
INTEGER FFTW_REDFT01
|
||||||
|
PARAMETER (FFTW_REDFT01=4)
|
||||||
|
INTEGER FFTW_REDFT10
|
||||||
|
PARAMETER (FFTW_REDFT10=5)
|
||||||
|
INTEGER FFTW_REDFT11
|
||||||
|
PARAMETER (FFTW_REDFT11=6)
|
||||||
|
INTEGER FFTW_RODFT00
|
||||||
|
PARAMETER (FFTW_RODFT00=7)
|
||||||
|
INTEGER FFTW_RODFT01
|
||||||
|
PARAMETER (FFTW_RODFT01=8)
|
||||||
|
INTEGER FFTW_RODFT10
|
||||||
|
PARAMETER (FFTW_RODFT10=9)
|
||||||
|
INTEGER FFTW_RODFT11
|
||||||
|
PARAMETER (FFTW_RODFT11=10)
|
||||||
|
INTEGER FFTW_FORWARD
|
||||||
|
PARAMETER (FFTW_FORWARD=-1)
|
||||||
|
INTEGER FFTW_BACKWARD
|
||||||
|
PARAMETER (FFTW_BACKWARD=+1)
|
||||||
|
INTEGER FFTW_MEASURE
|
||||||
|
PARAMETER (FFTW_MEASURE=0)
|
||||||
|
INTEGER FFTW_DESTROY_INPUT
|
||||||
|
PARAMETER (FFTW_DESTROY_INPUT=1)
|
||||||
|
INTEGER FFTW_UNALIGNED
|
||||||
|
PARAMETER (FFTW_UNALIGNED=2)
|
||||||
|
INTEGER FFTW_CONSERVE_MEMORY
|
||||||
|
PARAMETER (FFTW_CONSERVE_MEMORY=4)
|
||||||
|
INTEGER FFTW_EXHAUSTIVE
|
||||||
|
PARAMETER (FFTW_EXHAUSTIVE=8)
|
||||||
|
INTEGER FFTW_PRESERVE_INPUT
|
||||||
|
PARAMETER (FFTW_PRESERVE_INPUT=16)
|
||||||
|
INTEGER FFTW_PATIENT
|
||||||
|
PARAMETER (FFTW_PATIENT=32)
|
||||||
|
INTEGER FFTW_ESTIMATE
|
||||||
|
PARAMETER (FFTW_ESTIMATE=64)
|
||||||
|
INTEGER FFTW_ESTIMATE_PATIENT
|
||||||
|
PARAMETER (FFTW_ESTIMATE_PATIENT=128)
|
||||||
|
INTEGER FFTW_BELIEVE_PCOST
|
||||||
|
PARAMETER (FFTW_BELIEVE_PCOST=256)
|
||||||
|
INTEGER FFTW_DFT_R2HC_ICKY
|
||||||
|
PARAMETER (FFTW_DFT_R2HC_ICKY=512)
|
||||||
|
INTEGER FFTW_NONTHREADED_ICKY
|
||||||
|
PARAMETER (FFTW_NONTHREADED_ICKY=1024)
|
||||||
|
INTEGER FFTW_NO_BUFFERING
|
||||||
|
PARAMETER (FFTW_NO_BUFFERING=2048)
|
||||||
|
INTEGER FFTW_NO_INDIRECT_OP
|
||||||
|
PARAMETER (FFTW_NO_INDIRECT_OP=4096)
|
||||||
|
INTEGER FFTW_ALLOW_LARGE_GENERIC
|
||||||
|
PARAMETER (FFTW_ALLOW_LARGE_GENERIC=8192)
|
||||||
|
INTEGER FFTW_NO_RANK_SPLITS
|
||||||
|
PARAMETER (FFTW_NO_RANK_SPLITS=16384)
|
||||||
|
INTEGER FFTW_NO_VRANK_SPLITS
|
||||||
|
PARAMETER (FFTW_NO_VRANK_SPLITS=32768)
|
||||||
|
INTEGER FFTW_NO_VRECURSE
|
||||||
|
PARAMETER (FFTW_NO_VRECURSE=65536)
|
||||||
|
INTEGER FFTW_NO_SIMD
|
||||||
|
PARAMETER (FFTW_NO_SIMD=131072)
|
||||||
115
lib/fsk4hf/four2a.f90
Normal file
115
lib/fsk4hf/four2a.f90
Normal file
@ -0,0 +1,115 @@
|
|||||||
|
subroutine four2a(a,nfft,ndim,isign,iform)
|
||||||
|
|
||||||
|
! IFORM = 1, 0 or -1, as data is
|
||||||
|
! complex, real, or the first half of a complex array. Transform
|
||||||
|
! values are returned in array DATA. They are complex, real, or
|
||||||
|
! the first half of a complex array, as IFORM = 1, -1 or 0.
|
||||||
|
|
||||||
|
! The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
|
||||||
|
! by ... will be returned in the same array, now considered to
|
||||||
|
! be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
|
||||||
|
! IFORM = 0 or -1, N(1) must be even, and enough room must be
|
||||||
|
! reserved. The missing values may be obtained by complex conjugation.
|
||||||
|
|
||||||
|
! The reverse transformation of a half complex array dimensioned
|
||||||
|
! N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
|
||||||
|
! to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
|
||||||
|
! The transform will be real and returned to the input array.
|
||||||
|
|
||||||
|
! This version of four2a makes calls to the FFTW library to do the
|
||||||
|
! actual computations.
|
||||||
|
|
||||||
|
parameter (NPMAX=2100) !Max numberf of stored plans
|
||||||
|
parameter (NSMALL=16384) !Max size of "small" FFTs
|
||||||
|
complex a(nfft) !Array to be transformed
|
||||||
|
complex aa(NSMALL) !Local copy of "small" a()
|
||||||
|
integer nn(NPMAX),ns(NPMAX),nf(NPMAX) !Params of stored plans
|
||||||
|
integer*8 nl(NPMAX),nloc !More params of plans
|
||||||
|
integer*8 plan(NPMAX) !Pointers to stored plans
|
||||||
|
logical found_plan
|
||||||
|
data nplan/0/ !Number of stored plans
|
||||||
|
common/patience/npatience,nthreads !Patience and threads for FFTW plans
|
||||||
|
include 'fftw3.f90' !FFTW definitions
|
||||||
|
save plan,nplan,nn,ns,nf,nl
|
||||||
|
|
||||||
|
if(nfft.lt.0) go to 999
|
||||||
|
|
||||||
|
nloc=loc(a)
|
||||||
|
|
||||||
|
found_plan = .false.
|
||||||
|
!$omp critical(four2a_setup)
|
||||||
|
do i=1,nplan
|
||||||
|
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
|
||||||
|
iform.eq.nf(i) .and. nloc.eq.nl(i)) then
|
||||||
|
found_plan = .true.
|
||||||
|
exit
|
||||||
|
end if
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if(i.ge.NPMAX) stop 'Too many FFTW plans requested.'
|
||||||
|
|
||||||
|
if (.not. found_plan) then
|
||||||
|
nplan=nplan+1
|
||||||
|
i=nplan
|
||||||
|
|
||||||
|
nn(i)=nfft
|
||||||
|
ns(i)=isign
|
||||||
|
nf(i)=iform
|
||||||
|
nl(i)=nloc
|
||||||
|
|
||||||
|
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
|
||||||
|
! FFTW_PATIENT, FFTW_EXHAUSTIVE
|
||||||
|
nflags=FFTW_ESTIMATE
|
||||||
|
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
|
||||||
|
if(npatience.eq.2) nflags=FFTW_MEASURE
|
||||||
|
if(npatience.eq.3) nflags=FFTW_PATIENT
|
||||||
|
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
|
||||||
|
|
||||||
|
if(nfft.le.NSMALL) then
|
||||||
|
jz=nfft
|
||||||
|
if(iform.eq.0) jz=nfft/2
|
||||||
|
aa(1:jz)=a(1:jz)
|
||||||
|
endif
|
||||||
|
|
||||||
|
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
|
||||||
|
if(isign.eq.-1 .and. iform.eq.1) then
|
||||||
|
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
|
||||||
|
else if(isign.eq.1 .and. iform.eq.1) then
|
||||||
|
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
|
||||||
|
else if(isign.eq.-1 .and. iform.eq.0) then
|
||||||
|
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
|
||||||
|
else if(isign.eq.1 .and. iform.eq.-1) then
|
||||||
|
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
|
||||||
|
else
|
||||||
|
stop 'Unsupported request in four2a'
|
||||||
|
endif
|
||||||
|
!$omp end critical(fftw)
|
||||||
|
|
||||||
|
if(nfft.le.NSMALL) then
|
||||||
|
jz=nfft
|
||||||
|
if(iform.eq.0) jz=nfft/2
|
||||||
|
a(1:jz)=aa(1:jz)
|
||||||
|
endif
|
||||||
|
end if
|
||||||
|
!$omp end critical(four2a_setup)
|
||||||
|
|
||||||
|
call sfftw_execute(plan(i))
|
||||||
|
return
|
||||||
|
|
||||||
|
999 continue
|
||||||
|
|
||||||
|
!$omp critical(four2a)
|
||||||
|
do i=1,nplan
|
||||||
|
! The test is only to silence a compiler warning:
|
||||||
|
if(ndim.ne.-999) then
|
||||||
|
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
|
||||||
|
call sfftw_destroy_plan(plan(i))
|
||||||
|
!$omp end critical(fftw)
|
||||||
|
end if
|
||||||
|
enddo
|
||||||
|
|
||||||
|
nplan=0
|
||||||
|
!$omp end critical(four2a)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine four2a
|
||||||
233
lib/fsk4hf/fsk4sim.f90
Normal file
233
lib/fsk4hf/fsk4sim.f90
Normal file
@ -0,0 +1,233 @@
|
|||||||
|
program fsk4sim
|
||||||
|
|
||||||
|
use wavhdr
|
||||||
|
parameter (NR=4) !Ramp up, ramp down
|
||||||
|
parameter (NS=12) !Sync symbols (2 @ Costas 4x4)
|
||||||
|
parameter (ND=84) !Data symbols: LDPC (168,84), r=1/2
|
||||||
|
parameter (NN=NR+NS+ND) !Total symbols (100)
|
||||||
|
parameter (NSPS=2688) !Samples per symbol at 12000 sps
|
||||||
|
parameter (NZ=NSPS*NN) !Samples in waveform (258048)
|
||||||
|
parameter (NFFT=512*1024)
|
||||||
|
parameter (NSYNC=NS*NSPS)
|
||||||
|
|
||||||
|
type(hdr) header !Header for .wav file
|
||||||
|
character*8 arg
|
||||||
|
complex c(0:NFFT-1) !Complex waveform
|
||||||
|
complex cf(0:NFFT-1)
|
||||||
|
complex cs(0:NSYNC-1)
|
||||||
|
complex ct(0:NSPS-1)
|
||||||
|
complex csync(0:NSYNC-1)
|
||||||
|
complex z
|
||||||
|
real*8 twopi,dt,fs,baud,f0,dphi,phi
|
||||||
|
real tmp(NN) !For generating random data
|
||||||
|
real s(0:NFFT-1)
|
||||||
|
! real s2(0:NFFT-1)
|
||||||
|
real xnoise(NZ) !Generated random noise
|
||||||
|
real ps(0:3)
|
||||||
|
integer*2 iwave(NZ) !Generated waveform
|
||||||
|
integer id(NN) !Encoded 2-bit data (values 0-3)
|
||||||
|
integer icos4(4) !4x4 Costas array
|
||||||
|
data icos4/0,1,3,2/
|
||||||
|
|
||||||
|
nargs=iargc()
|
||||||
|
if(nargs.ne.3) then
|
||||||
|
print*,'Usage: fsk8sim f0 iters snr'
|
||||||
|
go to 999
|
||||||
|
endif
|
||||||
|
call getarg(1,arg)
|
||||||
|
read(arg,*) f0 !Low tone frequency
|
||||||
|
call getarg(2,arg)
|
||||||
|
read(arg,*) iters
|
||||||
|
call getarg(3,arg)
|
||||||
|
read(arg,*) snrdb
|
||||||
|
|
||||||
|
|
||||||
|
twopi=8.d0*atan(1.d0)
|
||||||
|
fs=12000.d0
|
||||||
|
dt=1.0/fs
|
||||||
|
ts=NSPS*dt
|
||||||
|
baud=1.d0/ts
|
||||||
|
txt=NZ*dt
|
||||||
|
|
||||||
|
isna=-20
|
||||||
|
isnb=-30
|
||||||
|
if(snrdb.ne.0.0) then
|
||||||
|
isna=nint(snrdb)
|
||||||
|
isnb=isna
|
||||||
|
endif
|
||||||
|
do isnr=isna,isnb,-1
|
||||||
|
snrdb=isnr
|
||||||
|
|
||||||
|
bandwidth_ratio=2500.0/6000.0
|
||||||
|
sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
|
||||||
|
if(snrdb.gt.90.0) sig=1.0
|
||||||
|
header=default_header(12000,NZ)
|
||||||
|
open(10,file='000000_0001.wav',access='stream',status='unknown')
|
||||||
|
|
||||||
|
nsyncerr=0
|
||||||
|
nharderr=0
|
||||||
|
nbiterr=0
|
||||||
|
do iter=1,iters
|
||||||
|
id=0
|
||||||
|
call random_number(tmp)
|
||||||
|
where(tmp.ge.0.25 .and. tmp.lt.0.50) id=1
|
||||||
|
where(tmp.ge.0.50 .and. tmp.lt.0.75) id=2
|
||||||
|
where(tmp.ge.0.75) id=3
|
||||||
|
|
||||||
|
id(1:2)=icos4(3:4) !Ramp up
|
||||||
|
id(45:48)=icos4 !Costas sync
|
||||||
|
id(49:52)=icos4 !Costas sync
|
||||||
|
id(53:56)=icos4 !Costas sync
|
||||||
|
id(NN-1:NN)=icos4(1:2) !Ramp down
|
||||||
|
|
||||||
|
! Generate sync waveform
|
||||||
|
phi=0.d0
|
||||||
|
k=-1
|
||||||
|
do j=45,56
|
||||||
|
dphi=twopi*(id(j)*baud)*dt
|
||||||
|
do i=1,NSPS
|
||||||
|
k=k+1
|
||||||
|
phi=phi+dphi
|
||||||
|
if(phi.gt.twopi) phi=phi-twopi
|
||||||
|
xphi=phi
|
||||||
|
csync(k)=cmplx(cos(xphi),-sin(xphi))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Generate the 4-FSK waveform
|
||||||
|
x=0.
|
||||||
|
c=0.
|
||||||
|
phi=0.d0
|
||||||
|
k=-1
|
||||||
|
u=0.5
|
||||||
|
do j=1,NN
|
||||||
|
dphi=twopi*(f0 + id(j)*baud)*dt
|
||||||
|
do i=1,NSPS
|
||||||
|
k=k+1
|
||||||
|
phi=phi+dphi
|
||||||
|
if(phi.gt.twopi) phi=phi-twopi
|
||||||
|
xphi=phi
|
||||||
|
c(k)=cmplx(cos(xphi),sin(xphi))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if(sig.ne.1.0) c=sig*c
|
||||||
|
|
||||||
|
nh=NFFT/2
|
||||||
|
df=12000.0/NFFT
|
||||||
|
s=0.
|
||||||
|
cf=c
|
||||||
|
call four2a(cf,NFFT,1,-1,1) !Transform to frequency domain
|
||||||
|
|
||||||
|
flo=f0-baud
|
||||||
|
fhi=f0+4*baud
|
||||||
|
do i=0,NFFT-1 !Remove spectral sidelobes
|
||||||
|
f=i*df
|
||||||
|
if(i.gt.nh) f=(i-nfft)*df
|
||||||
|
if(f.le.flo .or. f.ge.fhi) cf(i)=0.
|
||||||
|
s(i)=s(i) + real(cf(i))**2 + aimag(cf(i))**2
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! s2=cshift(s,nh)
|
||||||
|
! s2=s2/maxval(s2)
|
||||||
|
! do i=0,NFFT-1
|
||||||
|
! f=(i-nh)*df
|
||||||
|
! write(13,1000) f,s2(i),10.0*log10(s2(i)+1.e-12)
|
||||||
|
!1000 format(3f12.3)
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
c=cf
|
||||||
|
call four2a(c,NFFT,1,1,1) !Transform back to time domain
|
||||||
|
c=c/nfft
|
||||||
|
|
||||||
|
xnoise=0.
|
||||||
|
if(snrdb.lt.90) then
|
||||||
|
a=1.0/sqrt(2.0)
|
||||||
|
do i=0,NZ-1
|
||||||
|
xx=a*gran()
|
||||||
|
yy=a*gran()
|
||||||
|
c(i)=c(i) + cmplx(xx,yy) !Scale signal and add noise
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
fac=32767.0
|
||||||
|
rms=100.0
|
||||||
|
if(snrdb.ge.90.0) iwave(1:NZ)=nint(fac*aimag(c(0:NZ-1)))
|
||||||
|
if(snrdb.lt.90.0) iwave(1:NZ)=nint(rms*aimag(c(0:NZ-1)))
|
||||||
|
call set_wsjtx_wav_params(14.0,'JT65 ',1,30,iwave)
|
||||||
|
write(10) header,iwave !Save the .wav file
|
||||||
|
|
||||||
|
! do i=0,NZ-1
|
||||||
|
! a=abs(c(i))
|
||||||
|
! j=mod(i,NSPS)
|
||||||
|
! write(14,1010) i*dt/ts,c(i),a
|
||||||
|
!1010 format(4f12.6)
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
ppmax=0.
|
||||||
|
fpk=-99.
|
||||||
|
xdt=-99.
|
||||||
|
do j4=-40,40
|
||||||
|
ia=(44+0.25*j4)*NSPS
|
||||||
|
ib=ia+NSYNC-1
|
||||||
|
cs=csync*c(ia:ib)
|
||||||
|
call four2a(cs,NSYNC,1,-1,1) !Transform to frequency domain
|
||||||
|
df1=12000.0/NSYNC
|
||||||
|
fac=1.e-6
|
||||||
|
do i=0,NSYNC/2
|
||||||
|
pp=fac*(real(cs(i))**2 + aimag(cs(i))**2)
|
||||||
|
if(pp.gt.ppmax) then
|
||||||
|
fpk=i*df1
|
||||||
|
xdt=0.25*j4*ts
|
||||||
|
ppmax=pp
|
||||||
|
endif
|
||||||
|
! if(j4.eq.0) then
|
||||||
|
! f=i*df1
|
||||||
|
! write(16,1030) f,pp,10.0*log10(pp)
|
||||||
|
!1030 format(3f15.3)
|
||||||
|
! endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if(xdt.ne.0.0 .or. fpk.ne.1500.0) nsyncerr=nsyncerr+1
|
||||||
|
ipk=0
|
||||||
|
do j=1,NN
|
||||||
|
ia=(j-1)*NSPS + 1
|
||||||
|
ib=ia+NSPS
|
||||||
|
pmax=0.
|
||||||
|
do i=0,3
|
||||||
|
f=fpk + i*baud
|
||||||
|
call tweak1(c(ia:ib),NSPS,-f,ct)
|
||||||
|
z=sum(ct)
|
||||||
|
ps(i)=1.e-3*(real(z)**2 + aimag(z)**2)
|
||||||
|
if(ps(i).gt.pmax) then
|
||||||
|
ipk=i
|
||||||
|
pmax=ps(i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
nlo=0
|
||||||
|
nhi=0
|
||||||
|
if(max(ps(1),ps(3)).ge.max(ps(0),ps(2))) nlo=1
|
||||||
|
if(max(ps(2),ps(3)).ge.max(ps(0),ps(1))) nhi=1
|
||||||
|
! if(ps(1)+ps(3).ge.ps(0)+ps(2)) nlo=1
|
||||||
|
! if(ps(2)+ps(3).ge.ps(0)+ps(1)) nhi=1
|
||||||
|
|
||||||
|
if(nlo.ne.iand(id(j),1)) nbiterr=nbiterr+1
|
||||||
|
if(nhi.ne.iand(id(j)/2,1)) nbiterr=nbiterr+1
|
||||||
|
|
||||||
|
if(ipk.ne.id(j)) nharderr=nharderr+1
|
||||||
|
write(17,1040) j,ps,ipk,id(j),2*nhi+nlo,nhi,nlo,nbiterr
|
||||||
|
1040 format(i3,4f12.1,6i4)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
fsyncerr=float(nsyncerr)/iters
|
||||||
|
ser=float(nharderr)/(NN*iters)
|
||||||
|
ber=float(nbiterr)/(2*NN*iters)
|
||||||
|
write(*,1050) snrdb,nsyncerr,nharderr,nbiterr,fsyncerr,ser,ber
|
||||||
|
write(18,1050) snrdb,nsyncerr,nharderr,nbiterr,fsyncerr,ser,ber
|
||||||
|
1050 format(f6.1,3i6,3f10.6)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
999 end program fsk4sim
|
||||||
28
lib/fsk4hf/gran.c
Normal file
28
lib/fsk4hf/gran.c
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
#include <stdlib.h>
|
||||||
|
#include <math.h>
|
||||||
|
|
||||||
|
/* Generate gaussian random float with mean=0 and std_dev=1 */
|
||||||
|
float gran_()
|
||||||
|
{
|
||||||
|
float fac,rsq,v1,v2;
|
||||||
|
static float gset;
|
||||||
|
static int iset;
|
||||||
|
|
||||||
|
if(iset){
|
||||||
|
/* Already got one */
|
||||||
|
iset = 0;
|
||||||
|
return gset;
|
||||||
|
}
|
||||||
|
/* Generate two evenly distributed numbers between -1 and +1
|
||||||
|
* that are inside the unit circle
|
||||||
|
*/
|
||||||
|
do {
|
||||||
|
v1 = 2.0 * (float)rand() / RAND_MAX - 1;
|
||||||
|
v2 = 2.0 * (float)rand() / RAND_MAX - 1;
|
||||||
|
rsq = v1*v1 + v2*v2;
|
||||||
|
} while(rsq >= 1.0 || rsq == 0.0);
|
||||||
|
fac = sqrt(-2.0*log(rsq)/rsq);
|
||||||
|
gset = v1*fac;
|
||||||
|
iset++;
|
||||||
|
return v2*fac;
|
||||||
|
}
|
||||||
23
lib/fsk4hf/tweak1.f90
Normal file
23
lib/fsk4hf/tweak1.f90
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
subroutine tweak1(ca,jz,f0,cb)
|
||||||
|
|
||||||
|
! Shift frequency of analytic signal ca, with output to cb
|
||||||
|
|
||||||
|
complex ca(jz),cb(jz)
|
||||||
|
real*8 twopi
|
||||||
|
complex*16 w,wstep
|
||||||
|
complex w4
|
||||||
|
data twopi/0.d0/
|
||||||
|
save twopi
|
||||||
|
|
||||||
|
if(twopi.eq.0.d0) twopi=8.d0*atan(1.d0)
|
||||||
|
w=1.d0
|
||||||
|
dphi=twopi*f0/12000.d0
|
||||||
|
wstep=cmplx(cos(dphi),sin(dphi))
|
||||||
|
do i=1,jz
|
||||||
|
w=w*wstep
|
||||||
|
w4=w
|
||||||
|
cb(i)=w4*ca(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine tweak1
|
||||||
110
lib/fsk4hf/wavhdr.f90
Normal file
110
lib/fsk4hf/wavhdr.f90
Normal file
@ -0,0 +1,110 @@
|
|||||||
|
module wavhdr
|
||||||
|
type hdr
|
||||||
|
character*4 ariff
|
||||||
|
integer*4 lenfile
|
||||||
|
character*4 awave
|
||||||
|
character*4 afmt
|
||||||
|
integer*4 lenfmt
|
||||||
|
integer*2 nfmt2
|
||||||
|
integer*2 nchan2
|
||||||
|
integer*4 nsamrate
|
||||||
|
integer*4 nbytesec
|
||||||
|
integer*2 nbytesam2
|
||||||
|
integer*2 nbitsam2
|
||||||
|
character*4 adata
|
||||||
|
integer*4 ndata
|
||||||
|
end type hdr
|
||||||
|
|
||||||
|
contains
|
||||||
|
|
||||||
|
function default_header(nsamrate,npts)
|
||||||
|
type(hdr) default_header,h
|
||||||
|
h%ariff='RIFF'
|
||||||
|
h%awave='WAVE'
|
||||||
|
h%afmt='fmt '
|
||||||
|
h%lenfmt=16
|
||||||
|
h%nfmt2=1
|
||||||
|
h%nchan2=1
|
||||||
|
h%nsamrate=nsamrate
|
||||||
|
h%nbitsam2=16
|
||||||
|
h%nbytesam2=h%nbitsam2 * h%nchan2 / 8
|
||||||
|
h%adata='data'
|
||||||
|
h%nbytesec=h%nsamrate * h%nbitsam2 * h%nchan2 / 8
|
||||||
|
h%ndata=2*npts
|
||||||
|
h%lenfile=h%ndata + 44 - 8
|
||||||
|
default_header=h
|
||||||
|
end function default_header
|
||||||
|
|
||||||
|
subroutine set_wsjtx_wav_params(fMHz,mode,nsubmode,ntrperiod,id2)
|
||||||
|
|
||||||
|
parameter (NBANDS=23,NMODES=11)
|
||||||
|
character*8 mode,modes(NMODES)
|
||||||
|
integer*2 id2(4)
|
||||||
|
integer iperiod(7)
|
||||||
|
real fband(NBANDS)
|
||||||
|
data fband/0.137,0.474,1.8,3.5,5.1,7.0,10.14,14.0,18.1,21.0,24.9, &
|
||||||
|
28.0,50.0,144.0,222.0,432.0,902.0,1296.0,2304.0,3400.0, &
|
||||||
|
5760.0,10368.0,24048.0/
|
||||||
|
data modes/'Echo','FSK441','ISCAT','JT4','JT65','JT6M','JT9', &
|
||||||
|
'JT9+JT65','JTMS','JTMSK','WSPR'/
|
||||||
|
data iperiod/5,10,15,30,60,120,900/
|
||||||
|
|
||||||
|
dmin=1.e30
|
||||||
|
iband=0
|
||||||
|
do i=1,NBANDS
|
||||||
|
if(abs(fMHz-fband(i)).lt.dmin) then
|
||||||
|
dmin=abs(fMHz-fband(i))
|
||||||
|
iband=i
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
imode=0
|
||||||
|
do i=1,NMODES
|
||||||
|
if(mode.eq.modes(i)) imode=i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
ip=0
|
||||||
|
do i=1,7
|
||||||
|
if(ntrperiod.eq.iperiod(i)) ip=i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
id2(1)=iband
|
||||||
|
id2(2)=imode
|
||||||
|
id2(3)=nsubmode
|
||||||
|
id2(4)=ip
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine set_wsjtx_wav_params
|
||||||
|
|
||||||
|
subroutine get_wsjtx_wav_params(id2,band,mode,nsubmode,ntrperiod,ok)
|
||||||
|
|
||||||
|
parameter (NBANDS=23,NMODES=11)
|
||||||
|
character*8 mode,modes(NMODES)
|
||||||
|
character*6 band,bands(NBANDS)
|
||||||
|
integer*2 id2(4)
|
||||||
|
integer iperiod(7)
|
||||||
|
logical ok
|
||||||
|
data modes/'Echo','FSK441','ISCAT','JT4','JT65','JT6M','JT9', &
|
||||||
|
'JT9+JT65','JTMS','JTMSK','WSPR'/
|
||||||
|
data iperiod/5,10,15,30,60,120,900/
|
||||||
|
data bands/'2190m','630m','160m','80m','60m','40m','30m','20m', &
|
||||||
|
'17m','15m','12m','10m','6m','2m','1.25m','70cm','33cm', &
|
||||||
|
'23cm','13cm','9cm','6cm','3cm','1.25cm'/
|
||||||
|
|
||||||
|
ok=.true.
|
||||||
|
if(id2(1).lt.1 .or. id2(1).gt.NBANDS) ok=.false.
|
||||||
|
if(id2(2).lt.1 .or. id2(2).gt.NMODES) ok=.false.
|
||||||
|
if(id2(3).lt.1 .or. id2(3).gt.8) ok=.false.
|
||||||
|
if(id2(4).lt.1 .or. id2(4).gt.7) ok=.false.
|
||||||
|
|
||||||
|
if(ok) then
|
||||||
|
band=bands(id2(1))
|
||||||
|
mode=modes(id2(2))
|
||||||
|
nsubmode=id2(3)
|
||||||
|
ntrperiod=iperiod(id2(4))
|
||||||
|
endif
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine get_wsjtx_wav_params
|
||||||
|
|
||||||
|
end module wavhdr
|
||||||
Loading…
Reference in New Issue
Block a user