From de4bbbc59aaf00a0910a18b96c3981b7b80ac991 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Fri, 14 Feb 2020 16:33:16 -0500 Subject: [PATCH 1/5] Revert "Send "" for FT8 only after the full-length decoding pass." This reverts commit 364db768dbdd7306c408d94e450f8a6e87d6cfeb. --- lib/decoder.f90 | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/lib/decoder.f90 b/lib/decoder.f90 index 6e60c0fd3..3f58f8b3e 100644 --- a/lib/decoder.f90 +++ b/lib/decoder.f90 @@ -276,16 +276,8 @@ subroutine multimode_decoder(ss,id2,params,nfsample) ! JT65 is not yet producing info for nsynced, ndecoded. 800 ndecoded = my_jt4%decoded + my_jt65%decoded + my_jt9%decoded + & my_ft8%decoded + my_ft4%decoded - if(params%nmode.eq.8) then - if(params%nzhsym.lt.50) ndecoded_pass1=ndecoded - if(params%nzhsym.ge.50) then - ndecoded=ndecoded+ndecoded_pass1 - write(*,1010) nsynced,ndecoded - endif - else - write(*,1010) nsynced,ndecoded + write(*,1010) nsynced,ndecoded 1010 format('',2i4) - endif call flush(6) close(13) if(ncontest.eq.6) close(19) From adb7dfcac352412fa6869bd0bdaeffe3233b8633 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Fri, 21 Feb 2020 09:52:20 -0500 Subject: [PATCH 2/5] Satisfy fussy compilers like gcc 10: Type mismatch between actual argument at (1) and actual argument at (2) --- lib/ft8/filt8.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ft8/filt8.f90 b/lib/ft8/filt8.f90 index aeacf2a74..abe797ba7 100644 --- a/lib/ft8/filt8.f90 +++ b/lib/ft8/filt8.f90 @@ -9,7 +9,7 @@ subroutine filt8(f0,nslots,width,wave) equivalence (x,cx) x=wave - call four2a(x,NFFT,1,-1,0) !r2c + call four2a(cx,NFFT,1,-1,0) !r2c df=12000.0/NFFT fa=f0 - 0.5*6.25 fb=f0 + 7.5*6.25 + (nslots-1)*60.0 From 1d159a18c7615e0c7d44a9391a6fb45892df5e09 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Fri, 21 Feb 2020 13:36:49 -0500 Subject: [PATCH 3/5] More cleanup to satisfy fussy gcc 10 compiler. --- lib/extract.f90 | 2 +- lib/lpf1.f90 | 2 +- lib/refspectrum.f90 | 6 +++--- lib/timf2.f90 | 2 +- lib/wav11.f90 | 2 +- lib/wav12.f90 | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/extract.f90 b/lib/extract.f90 index d1a483d35..78da285f7 100644 --- a/lib/extract.f90 +++ b/lib/extract.f90 @@ -209,7 +209,7 @@ subroutine extract(s3,nadd,mode65,ntrials,naggressive,ndepth,nflip, & tmp(i)=correct(64-i) enddo correct(1:63)=tmp(1:63) - call interleave63(correct,63,1) + call interleave63(correct,1) call graycode65(correct,63,1) call unpackmsg(dat4,decoded) !Unpack the user message ncount=0 diff --git a/lib/lpf1.f90 b/lib/lpf1.f90 index f2bb2377c..a620e9a55 100644 --- a/lib/lpf1.f90 +++ b/lib/lpf1.f90 @@ -11,7 +11,7 @@ subroutine lpf1(dd,jz,dat,jz2) fac=1.0/float(NFFT1) x(1:jz)=fac*dd(1:jz) x(jz+1:NFFT1)=0.0 - call four2a(x,NFFT1,1,-1,0) !Forwarxd FFT, r2c + call four2a(cx,NFFT1,1,-1,0) !Forwarxd FFT, r2c cx(NFFT2/2:)=0.0 ! df=11025.0/NFFT1 diff --git a/lib/refspectrum.f90 b/lib/refspectrum.f90 index bc5bede33..fdd302ae5 100644 --- a/lib/refspectrum.f90 +++ b/lib/refspectrum.f90 @@ -40,7 +40,7 @@ subroutine refspectrum(id2,bclear,brefspec,buseref,fname) if(brefspec) then x(0:NH-1)=0.001*id2(1:NH) x(NH:NFFT-1)=0.0 - call four2a(x,NFFT,1,-1,0) !r2c FFT + call four2a(cx,NFFT,1,-1,0) !r2c FFT do i=1,NH s(i)=s(i) + real(cx(i))**2 + aimag(cx(i))**2 @@ -134,7 +134,7 @@ subroutine refspectrum(id2,bclear,brefspec,buseref,fname) ! Make the filter causal for overlap and add. cx(0)=0.0 cx(1:NH)=fil(1:NH)/NFFT - call four2a(x,NFFT,1,1,-1) + call four2a(cx,NFFT,1,1,-1) x=cshift(x,-400) x(800:NH)=0.0 call four2a(cx,NFFT,1,-1,0) @@ -146,7 +146,7 @@ subroutine refspectrum(id2,bclear,brefspec,buseref,fname) x(0:NH-1)=id2(1:NH) x(NH:NFFT-1)=0.0 x=x/NFFT - call four2a(x,NFFT,1,-1,0) + call four2a(cx,NFFT,1,-1,0) cx=cfil*cx call four2a(cx,NFFT,1,1,-1) x(0:NH-1)=x(0:NH-1)+xs diff --git a/lib/timf2.f90 b/lib/timf2.f90 index 07f509831..bec391e2e 100644 --- a/lib/timf2.f90 +++ b/lib/timf2.f90 @@ -59,7 +59,7 @@ subroutine timf2(x0,k,nfft,nwindow,nb,peaklimit,x1, & x(0:nfft-1)=x0 if(nwindow.eq.2) x(0:nfft-1)=w(0:nfft-1)*x(0:nfft-1) - call four2a(x,nfft,1,-1,0) !First forward FFT, r2c + call four2a(cx,nfft,1,-1,0) !First forward FFT, r2c cxt(0:nh)=cx(0:nh) ! Identify frequencies with strong signals. diff --git a/lib/wav11.f90 b/lib/wav11.f90 index 3bba0bf8a..219b7880a 100644 --- a/lib/wav11.f90 +++ b/lib/wav11.f90 @@ -14,7 +14,7 @@ subroutine wav11(d2,npts,dd) jz=min(NZ12,npts) x(1:jz)=d2(1:jz) x(jz+1:)=0.0 - call four2a(x,nfft1,1,-1,0) !Forward FFT, r2c + call four2a(cx,nfft1,1,-1,0) !Forward FFT, r2c df=12000.0/NFFT1 ia=5000.0/df cx(ia:)=0.0 diff --git a/lib/wav12.f90 b/lib/wav12.f90 index 31fe1d599..ff655436a 100644 --- a/lib/wav12.f90 +++ b/lib/wav12.f90 @@ -34,7 +34,7 @@ subroutine wav12(d2,d1,npts,nbitsam2) x(1:jz)=d2(1:jz) x(jz+1:)=0.0 - call four2a(x,nfft1,1,-1,0) !Forwarxd FFT, r2c + call four2a(cx,nfft1,1,-1,0) !Forwarxd FFT, r2c cx(nfft1/2:)=0.0 call four2a(cx,nfft2,1,1,-1) !Inverse FFT, c2r From ff46c5a0c42dd843e3196ddb57b2282348ae75bd Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Mon, 24 Feb 2020 16:18:42 -0500 Subject: [PATCH 4/5] In subtractft8.f90: refine DT for early decodes before subtracting them from dd(). --- lib/ft8/ft8b.f90 | 2 +- lib/ft8/subtractft8.f90 | 121 ++++++++++++++++++++++++++++------------ lib/ft8_decode.f90 | 2 +- 3 files changed, 86 insertions(+), 39 deletions(-) diff --git a/lib/ft8/ft8b.f90 b/lib/ft8/ft8b.f90 index 70040d1af..ec575426c 100644 --- a/lib/ft8/ft8b.f90 +++ b/lib/ft8/ft8b.f90 @@ -418,7 +418,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,nzhsym,lapon, & endif nbadcrc=0 ! If we get this far: valid codeword, valid (i3,n3), nonquirky message. call get_ft8_tones_from_77bits(message77,itone) - if(lsubtract) call subtractft8(dd0,itone,f1,xdt) + if(lsubtract) call subtractft8(dd0,itone,f1,xdt,.false.) ! write(21,3001) nzhsym,npasses,nqsoprogress,ipass,iaptype,lsubtract, & ! f1,xdt,msg37(1:22); flush(21) !3001 format(5i3,L3,f7.1,f7.2,2x,a22) diff --git a/lib/ft8/subtractft8.f90 b/lib/ft8/subtractft8.f90 index ec0beea9a..cf485b657 100644 --- a/lib/ft8/subtractft8.f90 +++ b/lib/ft8/subtractft8.f90 @@ -1,66 +1,113 @@ -subroutine subtractft8(dd,itone,f0,dt) +subroutine subtractft8(dd0,itone,f0,dt,ldt) -! Subtract an ft8 signal -! -! Measured signal : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) +! Subtract an ft8 signal. If ldt==.true., refine DT first. + +! Raw data : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) +! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) ) + + parameter (NMAX=15*12000,NFRAME=1920*79) + real dd(NMAX),dd0(NMAX) + complex cref(NFRAME) + logical ldt + +! Generate complex reference waveform + call gen_ft8wave(itone,79,1920,2.0,12000.0,f0,cref,xjunk,1,NFRAME) + + if(ldt) then !Are we refining DT ? + sqa=sqf(dd0,cref,f0,dt,ldt,-300,dd) !Yes + sqb=sqf(dd0,cref,f0,dt,ldt,300,dd) + endif + sq0=sqf(dd0,cref,f0,dt,ldt,0,dd) !Do the subtraction with idt=0 + if(ldt) then + call peakup(sqa,sq0,sqb,dx) + if(abs(dx).gt.1.0) goto 100 !No acceptable minimum: do not subtract + i1=nint(300.0*dx) !First approximation of better idt + sqa=sqf(dd0,cref,f0,dt,ldt,i1-60,dd) + sqb=sqf(dd0,cref,f0,dt,ldt,i1+60,dd) + sq0=sqf(dd0,cref,f0,dt,ldt,i1,dd) + call peakup(sqa,sq0,sqb,dx) + if(abs(dx).gt.1.0) then !No acceptable minimum + sq0=sqf(dd0,cref,f0,dt,ldt,0,dd) !Use idt=0 for subtraction + go to 100 + endif + i2=nint(60.0*dx) + i1 !Best estimate of idt + sq0=sqf(dd0,cref,f0,dt,ldt,i2,dd) !Do the subtraction with idt=i2 + endif +100 dd0=dd !Return dd0 with signal subtracted + + return +end subroutine subtractft8 + +real function sqf(dd0,cref,f0,dt,ldt,idt,dd) + +! Raw data : dd0(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 - +! Subtract : dd(t) = dd0(t) - 2*REAL{cref*cfilt} + parameter (NMAX=15*12000,NFRAME=1920*79) - parameter (NFFT=NMAX,NFILT=1400) - real*4 dd(NMAX), window(-NFILT/2:NFILT/2), xjunk - complex cref,camp,cfilt,cw - integer itone(79) - logical first + parameter (NFFT=NMAX,NFILT=2800) + real dd(NMAX),dd0(NMAX) + real window(-NFILT/2:NFILT/2) + real x(NFFT+2) + complex cx(0:NFFT/2),cref(NFRAME) + complex camp,cfilt,cw,z + logical first,ldt data first/.true./ - common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX),xjunk(NFRAME) - save first - - nstart=dt*12000+1 - nsym=79 - nsps=1920 - fs=12000.0 - icmplx=1 - bt=2.0 - call gen_ft8wave(itone,nsym,nsps,bt,fs,f0,cref,xjunk,icmplx,NFRAME) - 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 + common/heap8/camp(NMAX),cfilt(NMAX),cw(NMAX) + equivalence (x,cx) + save first,/heap8/ if(first) then ! Create and normalize the filter pi=4.0*atan(1.0) fac=1.0/float(nfft) - sum=0.0 + sumw=0.0 do j=-NFILT/2,NFILT/2 window(j)=cos(pi*j/NFILT)**2 - sum=sum+window(j) + sumw=sumw+window(j) enddo cw=0. - cw(1:NFILT+1)=window/sum + cw(1:NFILT+1)=window/sumw cw=cshift(cw,NFILT/2+1) call four2a(cw,nfft,1,-1,1) cw=cw*fac first=.false. endif - - cfilt=0.0 + + nstart=dt*12000+1 + idt + camp=0. + dd=dd0 + do i=1,nframe + j=nstart-1+i + if(j.ge.1.and.j.le.NMAX) camp(i)=dd(j)*conjg(cref(i)) + enddo cfilt(1:nframe)=camp(1:nframe) + cfilt(nframe+1:)=0.0 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 + x=0. 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)) + if(j.ge.1 .and. j.le.NMAX) then + z=cfilt(i)*cref(i) + dd(j)=dd(j)-2.0*real(z) !Subtract the reconstructed signal + x(i)=dd(j) + endif enddo + sq=0. + if(ldt) then + call four2a(cx,NFFT,1,-1,0) !Forward FFT, r2c + df=12000.0/NFFT + ia=(f0-1.5*6.25)/df + ib=(f0+8.5*6.25)/df + do i=ia,ib + sq=sq + real(cx(i))*real(cx(i)) + aimag(cx(i))*aimag(cx(i)) + enddo + endif + sqf=sq return -end subroutine subtractft8 - +end function sqf diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index 64fb46ee2..d43f5948f 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -77,7 +77,7 @@ contains endif if(nzhsym.eq.50 .and. ndec_early.ge.1) then do i=1,ndec_early - call subtractft8(dd,itone_save(1,i),f1_save(i),xdt_save(i)) + call subtractft8(dd,itone_save(1,i),f1_save(i),xdt_save(i),.true.) enddo endif ifa=nfa From 65fda32a05b8d644d6cd1aec97c016cfad2ccc46 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Tue, 25 Feb 2020 09:04:18 -0500 Subject: [PATCH 5/5] Previous commit was in error. This is the best-performing subtractft8.f90. --- lib/ft8/subtractft8.f90 | 153 +++++++++++++++++++--------------------- 1 file changed, 72 insertions(+), 81 deletions(-) diff --git a/lib/ft8/subtractft8.f90 b/lib/ft8/subtractft8.f90 index cf485b657..00b526934 100644 --- a/lib/ft8/subtractft8.f90 +++ b/lib/ft8/subtractft8.f90 @@ -1,65 +1,27 @@ subroutine subtractft8(dd0,itone,f0,dt,ldt) -! Subtract an ft8 signal. If ldt==.true., refine DT first. - -! Raw data : dd(t) = a(t)cos(2*pi*f0*t+theta(t)) -! Reference signal : cref(t) = exp( j*(2*pi*f0*t+phi(t)) ) - - parameter (NMAX=15*12000,NFRAME=1920*79) - real dd(NMAX),dd0(NMAX) - complex cref(NFRAME) - logical ldt - -! Generate complex reference waveform - call gen_ft8wave(itone,79,1920,2.0,12000.0,f0,cref,xjunk,1,NFRAME) - - if(ldt) then !Are we refining DT ? - sqa=sqf(dd0,cref,f0,dt,ldt,-300,dd) !Yes - sqb=sqf(dd0,cref,f0,dt,ldt,300,dd) - endif - sq0=sqf(dd0,cref,f0,dt,ldt,0,dd) !Do the subtraction with idt=0 - if(ldt) then - call peakup(sqa,sq0,sqb,dx) - if(abs(dx).gt.1.0) goto 100 !No acceptable minimum: do not subtract - i1=nint(300.0*dx) !First approximation of better idt - sqa=sqf(dd0,cref,f0,dt,ldt,i1-60,dd) - sqb=sqf(dd0,cref,f0,dt,ldt,i1+60,dd) - sq0=sqf(dd0,cref,f0,dt,ldt,i1,dd) - call peakup(sqa,sq0,sqb,dx) - if(abs(dx).gt.1.0) then !No acceptable minimum - sq0=sqf(dd0,cref,f0,dt,ldt,0,dd) !Use idt=0 for subtraction - go to 100 - endif - i2=nint(60.0*dx) + i1 !Best estimate of idt - sq0=sqf(dd0,cref,f0,dt,ldt,i2,dd) !Do the subtraction with idt=i2 - endif -100 dd0=dd !Return dd0 with signal subtracted - - return -end subroutine subtractft8 - -real function sqf(dd0,cref,f0,dt,ldt,idt,dd) - -! Raw data : dd0(t) = a(t)cos(2*pi*f0*t+theta(t)) +! 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) = dd0(t) - 2*REAL{cref*cfilt} - +! Subtract : dd(t) = dd(t) - 2*REAL{cref*cfilt} + parameter (NMAX=15*12000,NFRAME=1920*79) parameter (NFFT=NMAX,NFILT=2800) real dd(NMAX),dd0(NMAX) real window(-NFILT/2:NFILT/2) real x(NFFT+2) - complex cx(0:NFFT/2),cref(NFRAME) - complex camp,cfilt,cw,z + complex cx(0:NFFT/2) + complex cref,camp,cfilt,cw,z + integer itone(79) logical first,ldt data first/.true./ - common/heap8/camp(NMAX),cfilt(NMAX),cw(NMAX) + common/heap8/cref(NFRAME),camp(NMAX),cfilt(NMAX),cw(NMAX) equivalence (x,cx) save first,/heap8/ - if(first) then -! Create and normalize the filter + if(first) then ! Create and normalize the filter pi=4.0*atan(1.0) fac=1.0/float(nfft) sumw=0.0 @@ -74,40 +36,69 @@ real function sqf(dd0,cref,f0,dt,ldt,idt,dd) cw=cw*fac first=.false. endif - - nstart=dt*12000+1 + idt - camp=0. - dd=dd0 - do i=1,nframe - j=nstart-1+i - if(j.ge.1.and.j.le.NMAX) camp(i)=dd(j)*conjg(cref(i)) - enddo - cfilt(1:nframe)=camp(1:nframe) - cfilt(nframe+1:)=0.0 - call four2a(cfilt,nfft,1,-1,1) - cfilt(1:nfft)=cfilt(1:nfft)*cw(1:nfft) - call four2a(cfilt,nfft,1,1,1) - x=0. - do i=1,nframe - j=nstart+i-1 - if(j.ge.1 .and. j.le.NMAX) then - z=cfilt(i)*cref(i) - dd(j)=dd(j)-2.0*real(z) !Subtract the reconstructed signal - x(i)=dd(j) - endif - enddo - sq=0. - if(ldt) then - call four2a(cx,NFFT,1,-1,0) !Forward FFT, r2c - df=12000.0/NFFT - ia=(f0-1.5*6.25)/df - ib=(f0+8.5*6.25)/df - do i=ia,ib - sq=sq + real(cx(i))*real(cx(i)) + aimag(cx(i))*aimag(cx(i)) - enddo +! Generate complex reference waveform + call gen_ft8wave(itone,79,1920,2.0,12000.0,f0,cref,xjunk,1,NFRAME) + + if(ldt) then !Are we refining DT ? + sqa=sqf(-300) + sqb=sqf(300) endif - sqf=sq + sq0=sqf(0) !Do the subtraction with idt=0 + if(ldt) then + call peakup(sqa,sq0,sqb,dx) + if(abs(dx).gt.1.0) return !No acceptable minimum: do not subtract + i1=nint(300.0*dx) !First approximation of best idt + sqa=sqf(i1-60) + sqb=sqf(i1+60) + sq0=sqf(i1) + call peakup(sqa,sq0,sqb,dx) + if(abs(dx).gt.1.0) return !No acceptable minimum: do not subtract + i2=nint(60.0*dx) + i1 !Best estimate of idt + sq0=sqf(i2) !Do the subtraction with idt=i2 + endif + dd0=dd !Return dd0 with this signal subtracted return -end function sqf + +contains + + real function sqf(idt) !Internal function: all variables accessible + nstart=dt*12000+1 + idt + camp=0. + dd=dd0 + do i=1,nframe + j=nstart-1+i + if(j.ge.1.and.j.le.NMAX) camp(i)=dd(j)*conjg(cref(i)) + enddo + + cfilt(1:nframe)=camp(1:nframe) + cfilt(nframe+1:)=0.0 + call four2a(cfilt,nfft,1,-1,1) + cfilt(1:nfft)=cfilt(1:nfft)*cw(1:nfft) + call four2a(cfilt,nfft,1,1,1) + + x=0. + do i=1,nframe + j=nstart+i-1 + if(j.ge.1 .and. j.le.NMAX) then + z=cfilt(i)*cref(i) + dd(j)=dd(j)-2.0*real(z) !Subtract the reconstructed signal + x(i)=dd(j) + endif + enddo + sqq=0. + if(ldt) then + call four2a(cx,NFFT,1,-1,0) !Forward FFT, r2c + df=12000.0/NFFT + ia=(f0-1.5*6.25)/df + ib=(f0+8.5*6.25)/df + do i=ia,ib + sqq=sqq + real(cx(i))*real(cx(i)) + aimag(cx(i))*aimag(cx(i)) + enddo + endif + sqf=sqq + return + end function sqf + +end subroutine subtractft8