mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2025-03-22 12:08:43 -04:00
Remove obsolete files. Modify CMakeLists.txt to use env variable SFOX_DIR.
This commit is contained in:
Joe Taylor
parent
4509b12937
commit
d9e042d13b
@ -1658,10 +1658,19 @@ install (DIRECTORY
|
||||
)
|
||||
|
||||
if (WIN32)
|
||||
|
||||
# set (sfox_dir "$ENV{SFOX_DIR}")
|
||||
|
||||
if (DEFINED ENV{SFOX_DIR})
|
||||
set(sfox_dir "$ENV{SFOX_DIR}")
|
||||
else ()
|
||||
set(sfox_dir lib/superfox/win)
|
||||
endif ()
|
||||
|
||||
install (FILES
|
||||
lib/superfox/win/sfrx.exe
|
||||
lib/superfox/win/sftx.exe
|
||||
lib/superfox/win/foxchk.exe
|
||||
${sfox_dir}/sfrx.exe
|
||||
${sfox_dir}/sftx.exe
|
||||
${sfox_dir}/foxchk.exe
|
||||
DESTINATION ${CMAKE_INSTALL_BINDIR}
|
||||
#COMPONENT runtime
|
||||
)
|
||||
|
||||
@ -1,70 +0,0 @@
|
||||
subroutine decode_sf(iwave)
|
||||
|
||||
use sfox_mod
|
||||
integer*2 iwave(NMAX)
|
||||
integer msg1(0:47)
|
||||
integer, allocatable :: rxdat(:)
|
||||
integer, allocatable :: rxprob(:)
|
||||
integer, allocatable :: rxdat2(:)
|
||||
integer, allocatable :: rxprob2(:)
|
||||
integer, allocatable :: correct(:)
|
||||
real a(3)
|
||||
real, allocatable :: s3(:,:) !Symbol spectra: will be s3(NQ,NN)
|
||||
complex crcvd(NMAX)
|
||||
integer isync(24) !Symbol numbers for sync tones
|
||||
data isync/ 1, 2, 4, 7,11,16,22,29,37,39, &
|
||||
42,43,45,48,52,57,63,70,78,80, &
|
||||
83,84,86,89/
|
||||
|
||||
! Temporary, for initial tests:
|
||||
data msg1/ 5, 126, 55, 29, 5, 127, 86, 117, 6, 0, &
|
||||
118, 77, 6, 2, 22, 37, 6, 3, 53, 125, &
|
||||
1, 27, 124, 110, 54, 12, 9, 43, 43, 64, &
|
||||
96, 94, 85, 92, 6, 7, 21, 5, 104, 48, &
|
||||
67, 37, 110, 67, 4, 106, 26, 64/
|
||||
|
||||
mm0=7 !Symbol size (bits)
|
||||
nn0=127 !Number of information + parity symbols
|
||||
kk0=48 !Number of information symbols
|
||||
fspread=0.0
|
||||
delay=0.0
|
||||
fsample=12000.0 !Sample rate (Hz)
|
||||
ns0=24 !Number of sync symbols
|
||||
call sfox_init(mm0,nn0,kk0,'no',fspread,delay,fsample,ns0)
|
||||
|
||||
! Allocate storage for arrays that depend on code parameters.
|
||||
allocate(s3(0:NQ-1,0:NN-1))
|
||||
allocate(rxdat(0:NN-1))
|
||||
allocate(rxprob(0:NN-1))
|
||||
allocate(rxdat2(0:NN-1))
|
||||
allocate(rxprob2(0:NN-1))
|
||||
allocate(correct(0:NN-1))
|
||||
|
||||
call rs_init_sf(MM,NQ,NN,KK,NFZ) !Initialize the Karn codec
|
||||
|
||||
call sfox_ana(iwave,NMAX,crcvd,NMAX)
|
||||
|
||||
call sfox_sync(iwave,fsample,isync,f,t,fwidth) !Find freq, DT, width
|
||||
|
||||
a=0.
|
||||
a(1)=1500.0-f - baud !Shift frequencies down by one bin
|
||||
call twkfreq(crcvd,crcvd,NMAX,fsample,a)
|
||||
f=1500.0
|
||||
call sfox_demod(crcvd,f,t,isync,s3) !Get s3(0:NQ-1,0:127)
|
||||
call sfox_prob(s3,rxdat,rxprob,rxdat2,rxprob2)
|
||||
|
||||
do i=0,KK-1
|
||||
write(60,3060) i,msg1(i),rxdat(i),rxprob(i),rxdat2(i),rxprob2(i)
|
||||
3060 format(6i8)
|
||||
enddo
|
||||
|
||||
ntrials=1000
|
||||
call ftrsd3(s3,rxdat,rxprob,rxdat2,rxprob2,ntrials, &
|
||||
correct,param,ntry)
|
||||
if(ntry.lt.ntrials) then
|
||||
print*,'A',ntry,count(rxdat(0:KK-1).ne.msg1),count(correct(0:KK-1).ne.msg1)
|
||||
call sfox_unpack(correct(0:KK-1))
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine decode_sf
|
||||
@ -1,186 +0,0 @@
|
||||
subroutine ftrsd3(s3,rxdat,rxprob,rxdat2,rxprob2,ntrials0,correct,param,ntry)
|
||||
|
||||
! Soft-decision decoder for Reed-Solomon codes.
|
||||
|
||||
! This decoding scheme is built around Phil Karn's Berlekamp-Massey
|
||||
! errors and erasures decoder. The approach is inspired by a number of
|
||||
! publications, including the stochastic Chase decoder described
|
||||
! in "Stochastic Chase Decoding of Reed-Solomon Codes", by Leroux et al.,
|
||||
! IEEE Communications Letters, Vol. 14, No. 9, September 2010 and
|
||||
! "Soft-Decision Decoding of Reed-Solomon Codes Using Successive Error-
|
||||
! and-Erasure Decoding," by Soo-Woong Lee and B. V. K. Vijaya Kumar.
|
||||
|
||||
! Steve Franke K9AN and Joe Taylor K1JT
|
||||
|
||||
use sfox_mod
|
||||
|
||||
real s3(0:NQ-1,0:NN-1) !Symbol spectra
|
||||
integer rxdat(0:NN-1) !Hard-decision symbol values
|
||||
integer rxprob(0:NN-1) !Probabilities that rxdat values are correct
|
||||
integer rxdat2(0:NN-1) !Second most probable symbol values
|
||||
integer rxprob2(0:NN-1) !Probabilities that rxdat2 values are correct
|
||||
integer workdat(0:NN-1) !Work array
|
||||
integer correct(0:NN-1) !Corrected codeword
|
||||
integer indexes(0:NN-1) !For sorting probabilities
|
||||
integer probs(0:NN-1) !Temp array for sorting probabilities
|
||||
integer thresh0(0:NN-1) !Temp array for thresholds
|
||||
integer era_pos(0:NN-KK-1) !Index values for erasures
|
||||
integer param(0:8)
|
||||
integer*8 nseed,ir !No unsigned int in Fortran
|
||||
integer pass,tmp,thresh
|
||||
|
||||
integer perr(0:7,0:7)
|
||||
data perr/ 4, 9,11,13,14,14,15,15, &
|
||||
2,20,20,30,40,50,50,50, &
|
||||
7,24,27,40,50,50,50,50, &
|
||||
13,25,35,46,52,70,50,50, &
|
||||
17,30,42,54,55,64,71,70, &
|
||||
25,39,48,57,64,66,77,77, &
|
||||
32,45,54,63,66,75,78,83, &
|
||||
51,58,57,66,72,77,82,86/
|
||||
|
||||
ntrials=ntrials0
|
||||
nhard=0
|
||||
nhard_min=32768
|
||||
nsoft=0
|
||||
nsoft_min=32768
|
||||
ntotal=0
|
||||
ntotal_min=32768
|
||||
nera_best=0
|
||||
nsym=nn
|
||||
|
||||
do i=0,NN-1
|
||||
indexes(i)=i
|
||||
probs(i)=rxprob(i)
|
||||
enddo
|
||||
|
||||
do pass=1,nsym-1
|
||||
do k=0,nsym-pass-1
|
||||
if(probs(k).lt.probs(k+1)) then
|
||||
tmp=probs(k)
|
||||
probs(k)=probs(k+1)
|
||||
probs(k+1)=tmp
|
||||
tmp=indexes(k)
|
||||
indexes(k)=indexes(k+1)
|
||||
indexes(k+1)=tmp
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
correct=-1
|
||||
era_pos=0
|
||||
numera=0
|
||||
workdat=rxdat
|
||||
call rs_decode_sf(workdat,era_pos,numera,nerr) !Call the decoder
|
||||
nerr=-1
|
||||
|
||||
if(nerr.ge.0) then
|
||||
! Hard-decision decoding succeeded. Save codeword and some parameters.
|
||||
nhard=count(workdat.ne.rxdat)
|
||||
correct=workdat
|
||||
param(0)=0
|
||||
param(1)=nhard
|
||||
param(2)=0
|
||||
param(3)=0
|
||||
param(4)=0
|
||||
param(5)=0
|
||||
param(7)=1000*1000 !???
|
||||
ntry=0
|
||||
go to 900
|
||||
endif
|
||||
|
||||
! Hard-decision decoding failed. Try the FT soft-decision method.
|
||||
! Generate random erasure-locator vectors and see if any of them
|
||||
! decode. This will generate a list of "candidate" codewords. The
|
||||
! soft distance between each candidate codeword and the received
|
||||
! word is estimated by finding the largest (pp1) and second-largest
|
||||
! (pp2) outputs from a synchronized filter-bank operating on the
|
||||
! symbol spectra, and using these to decide which candidate
|
||||
! codeword is "best".
|
||||
|
||||
nseed=1 !Seed for random numbers
|
||||
ncandidates=0
|
||||
nsum=0
|
||||
do i=0,NN-1
|
||||
nsum=nsum+rxprob(i)
|
||||
j=indexes(NN-1-i)
|
||||
ratio=float(rxprob2(j))/(float(rxprob(j))+0.01)
|
||||
ii=7.999*ratio
|
||||
jj=int((7.999/NN)*(NN-1-i))
|
||||
thresh0(i)=1.15*perr(jj,ii)
|
||||
enddo
|
||||
if(nsum.le.0) return
|
||||
|
||||
pp1=0.
|
||||
pp2=0.
|
||||
do k=1,ntrials
|
||||
era_pos=0
|
||||
workdat=rxdat
|
||||
|
||||
! Mark a subset of the symbols as erasures.
|
||||
! Run through the ranked symbols, starting with the worst, i=0.
|
||||
! NB: j is the symbol-vector index of the symbol with rank i.
|
||||
|
||||
numera=0
|
||||
do i=0,NN-1
|
||||
j=indexes(NN-1-i)
|
||||
thresh=thresh0(i)
|
||||
! Generate a random number ir, 0 <= ir <= 100 (see POSIX.1-2001 example).
|
||||
ir=100.0*ran1(nseed)
|
||||
if((ir.lt.thresh) .and. numera.lt. 0.69*(NN-KK)) then
|
||||
era_pos(numera)=j
|
||||
numera=numera+1
|
||||
endif
|
||||
enddo
|
||||
call rs_decode_sf(workdat,era_pos,numera,nerr) !Call the decoder
|
||||
if( nerr.ge.0) then
|
||||
! We have a candidate codeword. Find its hard and soft distance from
|
||||
! the received word. Also find pp1 and pp2 from the full array
|
||||
! s3(NQ,NN) of synchronized symbol spectra.
|
||||
ncandidates=ncandidates+1
|
||||
nhard=0
|
||||
nsoft=0
|
||||
do i=0,NN-1
|
||||
if(workdat(i).ne. rxdat(i)) then
|
||||
nhard=nhard+1;
|
||||
if(workdat(i) .ne. rxdat2(i)) nsoft=nsoft+rxprob(i)
|
||||
endif
|
||||
enddo
|
||||
nsoft=NN*nsoft/nsum
|
||||
ntotal=nsoft+nhard
|
||||
|
||||
pp=0.
|
||||
call getpp3(s3,workdat,pp)
|
||||
! write(*,5001) ncandidates,nhard,nsoft,ntotal,pp,pp1,pp2
|
||||
!5001 format(4i8,3f7.3)
|
||||
if(pp.gt.pp1) then
|
||||
pp2=pp1
|
||||
pp1=pp
|
||||
nsoft_min=nsoft
|
||||
nhard_min=nhard
|
||||
ntotal_min=ntotal
|
||||
correct=workdat
|
||||
nera_best=numera
|
||||
ntry=k
|
||||
else
|
||||
if(pp.gt.pp2 .and. pp.ne.pp1) pp2=pp
|
||||
endif
|
||||
if(nhard_min.le.60 .and. ntotal_min.le.90) exit !### Needs tuning
|
||||
endif
|
||||
if(k.eq.ntrials) ntry=k
|
||||
enddo
|
||||
|
||||
param(0)=ncandidates
|
||||
param(1)=nhard_min
|
||||
param(2)=nsoft_min
|
||||
param(3)=nera_best
|
||||
param(4)=1000
|
||||
if(pp1.gt.0.0) param(4)=1000.0*pp2/pp1
|
||||
param(5)=ntotal_min
|
||||
param(6)=ntry
|
||||
param(7)=1000.0*pp2
|
||||
param(8)=1000.0*pp1
|
||||
if(param(0).eq.0) param(2)=-1
|
||||
|
||||
900 return
|
||||
end subroutine ftrsd3
|
||||
@ -1,22 +0,0 @@
|
||||
subroutine getpp3(s3,workdat,p)
|
||||
|
||||
use sfox_mod
|
||||
real s3(NQ,NN)
|
||||
integer workdat(NN)
|
||||
integer a(NN)
|
||||
|
||||
! a(1:NN)=workdat(NN:1:-1)
|
||||
a=workdat
|
||||
|
||||
psum=0.
|
||||
do j=1,NN
|
||||
i=a(j)+1
|
||||
x=s3(i,j)
|
||||
s3(i,j)=0.
|
||||
psum=psum + x
|
||||
s3(i,j)=x
|
||||
enddo
|
||||
p=psum/NN
|
||||
|
||||
return
|
||||
end subroutine getpp3
|
||||
@ -1,28 +0,0 @@
|
||||
FUNCTION ran1(idum)
|
||||
INTEGER idum,IA,IM,IQ,IR,NTAB,NDIV
|
||||
REAL ran1,AM,EPS,RNMX
|
||||
PARAMETER (IA=16807,IM=2147483647,AM=1./IM,IQ=127773,IR=2836, &
|
||||
NTAB=32,NDIV=1+(IM-1)/NTAB,EPS=1.2e-7,RNMX=1.-EPS)
|
||||
INTEGER j,k,iv(NTAB),iy
|
||||
SAVE iv,iy
|
||||
DATA iv /NTAB*0/, iy /0/
|
||||
if (idum.le.0.or.iy.eq.0) then
|
||||
idum=max(-idum,1)
|
||||
do j=NTAB+8,1,-1
|
||||
k=idum/IQ
|
||||
idum=IA*(idum-k*IQ)-IR*k
|
||||
if (idum.lt.0) idum=idum+IM
|
||||
if (j.le.NTAB) iv(j)=idum
|
||||
enddo
|
||||
iy=iv(1)
|
||||
endif
|
||||
k=idum/IQ
|
||||
idum=IA*(idum-k*IQ)-IR*k
|
||||
if (idum.lt.0) idum=idum+IM
|
||||
j=1+iy/NDIV
|
||||
iy=iv(j)
|
||||
iv(j)=idum
|
||||
ran1=min(AM*iy,RNMX)
|
||||
|
||||
return
|
||||
END FUNCTION ran1
|
||||
Binary file not shown.
@ -1,21 +0,0 @@
|
||||
subroutine sfox_ana(iwave,npts,c0,npts2)
|
||||
|
||||
use timer_module, only: timer
|
||||
|
||||
integer*2 iwave(npts) !Raw data at 12000 Hz
|
||||
complex c0(0:npts2-1) !Complex data at 6000 Hz
|
||||
save
|
||||
|
||||
nfft1=npts
|
||||
! nfft2=nfft1/2
|
||||
nfft2=nfft1
|
||||
! df1=12000.0/nfft1
|
||||
fac=2.0/(32767.0*nfft1)
|
||||
c0(0:npts-1)=fac*iwave(1:npts)
|
||||
call four2a(c0,nfft1,1,-1,1) !Forward c2c FFT
|
||||
c0(nfft2/2+1:nfft2-1)=0. !Remove negative frequencies
|
||||
c0(0)=0.5*c0(0) !Scale the DC term to 1/2
|
||||
call four2a(c0,nfft2,1,1,1) !Inverse c2c FFT; c0 is analytic sig
|
||||
|
||||
return
|
||||
end subroutine sfox_ana
|
||||
@ -1,33 +0,0 @@
|
||||
subroutine sfox_demod(crcvd,f,t,isync,s3)
|
||||
|
||||
use sfox_mod
|
||||
complex crcvd(NMAX) !Signal as received
|
||||
complex c(0:NSPS-1) !Work array, one symbol long
|
||||
real s3(0:NQ-1,0:NN-1) !Synchronized symbol spectra
|
||||
integer isync(44)
|
||||
! integer ipk(1)
|
||||
|
||||
j0=nint(12000.0*(t+0.5))
|
||||
df=12000.0/NSPS
|
||||
i0=nint(f/df)-NQ/2
|
||||
k=-1
|
||||
do n=1,NDS !Loop over all symbols
|
||||
if(any(isync(1:NS).eq.n)) cycle
|
||||
jb=n*NSPS + j0
|
||||
ja=jb-NSPS+1
|
||||
if(ja.lt.1 .or. jb.gt.NMAX) cycle
|
||||
k=k+1
|
||||
c=crcvd(ja:jb)
|
||||
call four2a(c,NSPS,1,-1,1) !Compute symbol spectrum
|
||||
do i=0,NQ-1
|
||||
s3(i,k)=real(c(i0+i))**2 + aimag(c(i0+i))**2
|
||||
enddo
|
||||
! ipk=maxloc(s3(0:NQ-1,k))
|
||||
! if(k.lt.10) print*,'AAA',k,ipk(1)-1
|
||||
enddo
|
||||
|
||||
call pctile(s3,NQ*NN,50,base)
|
||||
s3=s3/base
|
||||
|
||||
return
|
||||
end subroutine sfox_demod
|
||||
@ -1,55 +0,0 @@
|
||||
subroutine sfox_prob(s3,rxdat,rxprob,rxdat2,rxprob2)
|
||||
|
||||
! Demodulate the 64-bin spectra for each of 63 symbols in a frame.
|
||||
|
||||
! Parameters
|
||||
! rxdat most reliable symbol value
|
||||
! rxdat2 second most likely symbol value
|
||||
! rxprob probability that rxdat was the transmitted value
|
||||
! rxprob2 probability that rxdat2 was the transmitted value
|
||||
|
||||
use sfox_mod
|
||||
implicit real*8 (a-h,o-z)
|
||||
real*4 s3(0:NQ-1,0:NN-1)
|
||||
integer rxdat(0:NN-1),rxprob(0:NN-1),rxdat2(0:NN-1),rxprob2(0:NN-1)
|
||||
|
||||
afac=1.1
|
||||
! scale=255.999
|
||||
scale=2047.999
|
||||
|
||||
! Compute average spectral value
|
||||
ave=sum(s3)/(NQ*ND)
|
||||
i1=1 !Silence warning
|
||||
i2=1
|
||||
|
||||
! Compute probabilities for most reliable symbol values
|
||||
do j=0,NN-1 !Loop over all symbols
|
||||
s1=-1.e30
|
||||
psum=0.
|
||||
do i=0,NQ-1 !Loop over frequency bins
|
||||
x=min(afac*s3(i,j)/ave,50.d0)
|
||||
psum=psum+s3(i,j)
|
||||
if(s3(i,j).gt.s1) then
|
||||
s1=s3(i,j) !Find max signal+noise power
|
||||
i1=i !Find most reliable symbol value
|
||||
endif
|
||||
enddo
|
||||
if(psum.eq.0.0) psum=1.e-6 !Guard against zero signal+noise
|
||||
|
||||
s2=-1.e30
|
||||
do i=0,NQ-1
|
||||
if(i.ne.i1 .and. s3(i,j).gt.s2) then
|
||||
s2=s3(i,j) !Second largest signal+noise power
|
||||
i2=i !Bin number for second largest power
|
||||
endif
|
||||
enddo
|
||||
p1=s1/psum !p1, p2 are symbol metrics for ftrsd
|
||||
p2=s2/psum
|
||||
rxdat(j)=i1
|
||||
rxdat2(j)=i2
|
||||
rxprob(j)=scale*p1 !Scaled probabilities, 0 - 255
|
||||
rxprob2(j)=scale*p2
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine sfox_prob
|
||||
@ -1,153 +0,0 @@
|
||||
subroutine sfox_sync(iwave,fsample,isync,f,t,fwidth)
|
||||
|
||||
use sfox_mod
|
||||
parameter (NSTEP=8)
|
||||
integer*2 iwave(0:NMAX-1)
|
||||
integer isync(44)
|
||||
integer ipeak(2)
|
||||
integer ipeak2(1)
|
||||
complex, allocatable :: c(:) !Work array
|
||||
real, allocatable :: s(:,:) !Symbol spectra, stepped by NSTEP
|
||||
real, allocatable :: savg(:) !Average spectrum
|
||||
real, allocatable :: ccf(:,:)
|
||||
real, allocatable :: s2(:) !Fine spectrum of sync tone
|
||||
|
||||
nfft=nsps
|
||||
nh=nfft/2
|
||||
istep=NSPS/NSTEP
|
||||
jz=(13.5*fsample)/istep
|
||||
df=fsample/nfft
|
||||
dtstep=istep/fsample
|
||||
fsync=1500.0-bw/2
|
||||
ftol=50.0
|
||||
ia=nint((fsync-ftol)/df)
|
||||
ib=nint((fsync+ftol)/df)
|
||||
lagmax=1.5/dtstep
|
||||
lag1=-lagmax
|
||||
lag2=lagmax
|
||||
|
||||
allocate(s(0:nh/2,jz))
|
||||
allocate(savg(0:nh/2))
|
||||
allocate(c(0:nfft-1))
|
||||
allocate(ccf(ia:ib,lag1:lag2))
|
||||
|
||||
s=0.
|
||||
savg=0.
|
||||
fac=1.0/nfft
|
||||
|
||||
! Compute symbol spectra with df=baud/2 and NSTEP steps per symbol.
|
||||
do j=1,jz
|
||||
i1=(j-1)*istep
|
||||
i2=i1+nsps-1
|
||||
k=-1
|
||||
do i=i1,i2,2 !Load iwave data into complex array c0, for r2c FFT
|
||||
xx=iwave(i)
|
||||
yy=iwave(i+1)
|
||||
k=k+1
|
||||
c(k)=fac*cmplx(xx,yy)
|
||||
enddo
|
||||
c(k+1:)=0.
|
||||
call four2a(c,nfft,1,-1,0) !r2c FFT
|
||||
do i=1,nh/2
|
||||
s(i,j)=real(c(i))**2 + aimag(c(i))**2
|
||||
savg(i)=savg(i) + s(i,j)
|
||||
enddo
|
||||
enddo
|
||||
savg=savg/jz
|
||||
|
||||
ccfbest=0.
|
||||
ibest=0
|
||||
lagpk=0
|
||||
lagbest=0
|
||||
j0=0.5/dtstep !Nominal start-signal index
|
||||
|
||||
do i=ia,ib
|
||||
ccfmax=0.
|
||||
do lag=lag1,lag2
|
||||
ccft=0.
|
||||
do m=1,NS
|
||||
k=isync(m)
|
||||
n=NSTEP*(k-1) + 1
|
||||
j=n+lag+j0
|
||||
if(j.ge.1 .and. j.le.jz) ccft=ccft + s(i,j)
|
||||
enddo ! m
|
||||
ccft=ccft - NS*savg(i)
|
||||
ccf(i,lag)=ccft
|
||||
if(ccft.gt.ccfmax) then
|
||||
ccfmax=ccft
|
||||
lagpk=lag
|
||||
endif
|
||||
enddo ! lag
|
||||
|
||||
if(ccfmax.gt.ccfbest) then
|
||||
ccfbest=ccfmax
|
||||
ibest=i
|
||||
lagbest=lagpk
|
||||
endif
|
||||
enddo ! i
|
||||
|
||||
ipeak=maxloc(ccf)
|
||||
ipk=ipeak(1)-1+ia
|
||||
jpk=ipeak(2)-1+lag1
|
||||
|
||||
dxj=0.
|
||||
if(jpk.gt.lag1 .and. jpk.lt.lag2) then
|
||||
call peakup(ccf(ipk,jpk-1),ccf(ipk,jpk),ccf(ipk,jpk+1),dxj)
|
||||
endif
|
||||
|
||||
f=ibest*df + bw/2 + dxi*df
|
||||
t=(lagbest+dxj)*dtstep
|
||||
t=t-0.01 !### Why is this needed? ###
|
||||
|
||||
nfft2=4*NSPS
|
||||
deallocate(c)
|
||||
allocate(c(0:nfft2-1))
|
||||
allocate(s2(0:nfft2-1))
|
||||
|
||||
i0=(t+0.5)*fsample
|
||||
s2=0.
|
||||
df2=fsample/nfft2
|
||||
do m=1,NS
|
||||
i1=i0+(isync(m)-1)*NSPS
|
||||
i2=i1+NSPS-1
|
||||
k=-1
|
||||
do i=i1,i2,2 !Load iwave data into complex array c0, for r2c FFT
|
||||
if(i.gt.0) then
|
||||
xx=iwave(i)
|
||||
yy=iwave(i+1)
|
||||
else
|
||||
xx=0.
|
||||
yy=0.
|
||||
endif
|
||||
k=k+1
|
||||
c(k)=fac*cmplx(xx,yy)
|
||||
enddo
|
||||
c(k+1:)=0.
|
||||
call four2a(c,nfft2,1,-1,0) !r2c FFT
|
||||
do i=1,nfft2/4
|
||||
s2(i)=s2(i) + real(c(i))**2 + aimag(c(i))**2
|
||||
enddo
|
||||
enddo
|
||||
|
||||
ia=nint((fsync-ftol)/df2)
|
||||
ib=nint((fsync+ftol)/df2)
|
||||
ipeak2=maxloc(s2(ia:ib))
|
||||
ipk=ipeak2(1)-1+ia
|
||||
|
||||
dxi=0.
|
||||
if(ipk.gt.1 .and. ipk.lt.nfft/4) then
|
||||
call peakup(s2(ipk-1),s2(ipk),s2(ipk+1),dxi)
|
||||
endif
|
||||
f=(ipk+dxi)*df2 + bw/2.0
|
||||
fwidth=0.
|
||||
|
||||
if(ipk.gt.100 .and. ipk.lt.nfft2/4-100) then
|
||||
call pctile(s2(ipk-100:ipk+100),201,48,base)
|
||||
s2=s2-base
|
||||
smax=maxval(s2(ipk-10:ipk+10))
|
||||
w=count(s2(ipk-10:ipk+10).gt.0.5*smax)
|
||||
if(w.gt.4.0) fwidth=sqrt(w*w - 4*4)*df2
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine sfox_sync
|
||||
@ -1,51 +0,0 @@
|
||||
subroutine sfox_unpack(imsg)
|
||||
|
||||
use packjt77
|
||||
integer imsg(48)
|
||||
character*336 msgbits
|
||||
character*22 msg(10)
|
||||
character*13 foxcall,c13
|
||||
character*4 crpt(5)
|
||||
logical success
|
||||
|
||||
write(msgbits,1000) imsg
|
||||
1000 format(48b7.7)
|
||||
read(msgbits(331:336),'(b6)') ntype !Message type
|
||||
|
||||
if(ntype.eq.1) then !Get the Fox callsign
|
||||
read(msgbits(271:328),'(b58)') n58 !Compound Fox call
|
||||
call unpack28(n58,foxcall,success)
|
||||
else
|
||||
read(msgbits(303:330),'(b28)') n28 !Standard Fox call
|
||||
call unpack28(n28,foxcall,success)
|
||||
endif
|
||||
|
||||
j=171
|
||||
do i=1,5 !Extract the reports
|
||||
read(msgbits(j:j+3),'(b4)') n
|
||||
if(n.eq.15) then
|
||||
crpt(i)='RR73'
|
||||
else
|
||||
write(crpt(i),1006) 2*n-18
|
||||
1006 format(i3.2)
|
||||
if(crpt(i)(1:1).eq.' ') crpt(i)(1:1)='+'
|
||||
endif
|
||||
j=j+32
|
||||
enddo
|
||||
|
||||
! Unpack and format user-level messages:
|
||||
do i=1,10
|
||||
j=28*i - 27
|
||||
if(i.gt.5) j=143 + (i-5)*32
|
||||
read(msgbits(j:j+27),'(b28)') n28
|
||||
if(n28.eq.0) cycle
|
||||
call unpack28(n28,c13,success)
|
||||
msg(i)=trim(c13)//' '//trim(foxcall)
|
||||
if(i.le.5) msg(i)=trim(msg(i))//' RR73'
|
||||
if(i.gt.5) msg(i)=trim(msg(i))//' '//crpt(i-5)
|
||||
write(*,3001) i,trim(msg(i))
|
||||
3001 format(i2,2x,a)
|
||||
enddo
|
||||
|
||||
return
|
||||
end subroutine sfox_unpack
|
||||
@ -1,40 +0,0 @@
|
||||
subroutine sfox_wave(fname)
|
||||
|
||||
! Called by WSJT-X when it's time for SuperFox to transmit. Reads array
|
||||
! itone(1:151) from disk file 'sfox_2.dat' in the writable data directory.
|
||||
|
||||
parameter (NWAVE=(160+2)*134400*4) !Max WSJT-X waveform (FST4-1800 at 48kHz)
|
||||
parameter (NN=151,NSPS=1024)
|
||||
character*(*) fname
|
||||
integer itone(151)
|
||||
real*8 dt,twopi,f0,baud,phi,dphi
|
||||
|
||||
common/foxcom/wave(NWAVE)
|
||||
|
||||
open(25,file=trim(fname),status='unknown',err=900)
|
||||
read(25,'(20i4)',err=900,end=900) itone
|
||||
close(25)
|
||||
|
||||
! Generate the SuperFox waveform.
|
||||
|
||||
dt=1.d0/48000.d0
|
||||
twopi=8.d0*atan(1.d0)
|
||||
f0=750.0d0
|
||||
phi=0.d0
|
||||
baud=12000.d0/NSPS
|
||||
k=0
|
||||
do j=1,NN
|
||||
f=f0 + baud*mod(itone(j),128)
|
||||
dphi=twopi*f*dt
|
||||
do ii=1,4*NSPS
|
||||
k=k+1
|
||||
phi=phi+dphi
|
||||
xphi=phi
|
||||
wave(k)=sin(xphi)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
900 continue
|
||||
|
||||
return
|
||||
end subroutine sfox_wave
|
||||
Loading…
Reference in New Issue
Block a user