From 69629c3748624a6e2f6818b55053466080f89c14 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 23 Sep 2024 17:27:01 -0500 Subject: [PATCH] More work on tone removal. --- CMakeLists.txt | 1 + lib/superfox/qpc_decode2.f90 | 92 ------------------------------ lib/superfox/sfox_remove_tone.f90 | 95 +++++++++++++++++++++++++++++++ lib/superfox/sfrx_sub.f90 | 2 +- 4 files changed, 97 insertions(+), 93 deletions(-) create mode 100644 lib/superfox/sfox_remove_tone.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index f43b44dfb..1c732cd1f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -612,6 +612,7 @@ set (wsjt_FSRCS lib/superfox/sfox_demod.f90 lib/superfox/sfox_pack.f90 lib/superfox/sfox_remove_ft8.f90 + lib/superfox/sfox_remove_tone.f90 lib/superfox/sfox_unpack.f90 lib/superfox/sfox_wave.f90 lib/superfox/sfox_wave_gfsk.f90 diff --git a/lib/superfox/qpc_decode2.f90 b/lib/superfox/qpc_decode2.f90 index fbf292624..57152ab8c 100644 --- a/lib/superfox/qpc_decode2.f90 +++ b/lib/superfox/qpc_decode2.f90 @@ -148,95 +148,3 @@ subroutine smo121a(x,nz,a,b) return end subroutine smo121a - -subroutine remove_tone(c0,fsync) - - parameter (NMAX=15*12000) - parameter (NFILT=8000) - complex c0(NMAX) - complex cwindow(15*12000) - complex cref(NMAX) - complex cfilt(NMAX) - real window(-NFILT/2:NFILT/2) -! real endcorrection(NFILT/2+1) - real s(NMAX/4) - integer ipk(1) - logical first - data first/.true./ - save cwindow,first,pi - - if(first) then - pi=4.0*atan(1.0) - fac=1.0/float(NMAX) - sumw=0.0 - do j=-NFILT/2,NFILT/2 - window(j)=cos(pi*j/NFILT)**2 - sumw=sumw+window(j) - enddo - cwindow=0. - cwindow(1:NFILT+1)=window/sumw - cwindow=cshift(cwindow,NFILT/2+1) - call four2a(cwindow,NMAX,1,-1,1) - cwindow=cwindow*fac ! frequency domain smoothing filter - first=.false. - endif - - fsample=12000.0 - df=fsample/NMAX - fac=1.0/NMAX - cfilt=fac*c0 - call four2a(cfilt,NMAX,1,-1,1) ! fourier transform of input data - iz=NMAX/4 - do i=1,iz - s(i)=real(cfilt(i))**2 + aimag(cfilt(i))**2 - enddo - - ia=nint((fsync-100.0)/df) - ib=nint((fsync+100.0)/df) - ipk=maxloc(s(ia:ib)) - i0=ipk(1) + ia - 1 - - i10=nint(10.0/df) - ia=i0-i10 - ib=i0+i10 - s0=0.0 - s1=0.0 - s2=0.0 - do i=ia,ib - s0=s0+s(i) - s1=s1+(i-i0)*s(i) - enddo - delta=s1/s0 - i0=nint(i0+delta) - f2=i0*df - - ia=i0-i10 - ib=i0+i10 - do i=ia,ib - s2=s2 + s(i)*(i-i0)**2 - enddo - sigma=sqrt(s2/s0)*df - -! write(*,*) 'frequency, spectral width ',f2,sigma - if(sigma .gt. 2.5) go to 999 -! write(*,*) 'remove_tone - frequency: ',f2 - - dt=1.0/fsample - do i=1, NMAX - arg=2*pi*f2*i*dt - cref(i)=cmplx(cos(arg),sin(arg)) - enddo - cfilt=c0*conjg(cref) ! baseband to be filtered - call four2a(cfilt,NMAX,1,-1,1) - cfilt=cfilt*cwindow - call four2a(cfilt,NMAX,1,1,1) - - nframe=50*3456 - do i=1,nframe - cref(i)=cfilt(i)*cref(i) - c0(i)=c0(i)-cref(i) - enddo - -999 return - -end subroutine remove_tone diff --git a/lib/superfox/sfox_remove_tone.f90 b/lib/superfox/sfox_remove_tone.f90 new file mode 100644 index 000000000..bc32cc8ef --- /dev/null +++ b/lib/superfox/sfox_remove_tone.f90 @@ -0,0 +1,95 @@ +subroutine sfox_remove_tone(c0,fsync) + + parameter (NMAX=15*12000) + parameter (NFILT=8000) + complex c0(NMAX) + complex cwindow(15*12000) + complex cref(NMAX) + complex cfilt(NMAX) + real window(-NFILT/2:NFILT/2) +! real endcorrection(NFILT/2+1) + real s(NMAX/4) + integer ipk(1) + logical first + data first/.true./ + save cwindow,first,pi + + if(first) then + pi=4.0*atan(1.0) + fac=1.0/float(NMAX) + sumw=0.0 + do j=-NFILT/2,NFILT/2 + window(j)=cos(pi*j/NFILT)**2 + sumw=sumw+window(j) + enddo + cwindow=0. + cwindow(1:NFILT+1)=window/sumw + cwindow=cshift(cwindow,NFILT/2+1) + call four2a(cwindow,NMAX,1,-1,1) + cwindow=cwindow*fac ! frequency domain smoothing filter + first=.false. + endif + + fsample=12000.0 + baud=fsample/1024.0 + df=fsample/NMAX + fac=1.0/NMAX + + do it=1,2 + cfilt=fac*c0 + call four2a(cfilt,NMAX,1,-1,1) ! fourier transform of input data + iz=NMAX/4 + do i=1,iz + s(i)=real(cfilt(i))**2 + aimag(cfilt(i))**2 + enddo + + ia=nint((fsync-100.0)/df) + ib=nint((fsync+1500.0+100.0)/df) + ipk=maxloc(s(ia:ib)) + i0=ipk(1) + ia - 1 + + nbaud=nint(baud/df) + ia=i0-nbaud + ib=i0+nbaud + s0=0.0 + s1=0.0 + s2=0.0 + do i=ia,ib + s0=s0+s(i) + s1=s1+(i-i0)*s(i) + enddo + delta=s1/s0 + i0=nint(i0+delta) + f2=i0*df + + ia=i0-nbaud + ib=i0+nbaud + do i=ia,ib + s2=s2 + s(i)*(i-i0)**2 + enddo + sigma=sqrt(s2/s0)*df + + write(*,*) 'frequency, spectral width ',f2,sigma + if(sigma .gt. 2.5) exit + write(*,*) 'remove_tone - frequency: ',f2 + + dt=1.0/fsample + do i=1, NMAX + arg=2*pi*f2*i*dt + cref(i)=cmplx(cos(arg),sin(arg)) + enddo + cfilt=c0*conjg(cref) ! baseband to be filtered + call four2a(cfilt,NMAX,1,-1,1) + cfilt=cfilt*cwindow + call four2a(cfilt,NMAX,1,1,1) + + nframe=50*3456 + do i=1,nframe + cref(i)=cfilt(i)*cref(i) + c0(i)=c0(i)-cref(i) + enddo + enddo + + return + +end subroutine sfox_remove_tone diff --git a/lib/superfox/sfrx_sub.f90 b/lib/superfox/sfrx_sub.f90 index 0779b23ef..08047989f 100644 --- a/lib/superfox/sfrx_sub.f90 +++ b/lib/superfox/sfrx_sub.f90 @@ -36,7 +36,7 @@ subroutine sfrx_sub(nyymmdd,nutc,nfqso,ntol,iwave) call sfox_ana(dd,npts,c0,npts) -! call remove_tone(c0,fsync) ! Needs testing +! call sfox_remove_tone(c0,fsync) ! Needs testing ndepth=3 dth=0.5