diff --git a/CMakeLists.txt b/CMakeLists.txt index 053fee6d2..96cdc3d05 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -325,7 +325,7 @@ set (wsjt_FSRCS lib/options.f90 lib/packjt.f90 lib/77bit/packjt77.f90 - lib/q65.f90 + lib/qra/q65/q65.f90 lib/q65_decode.f90 lib/readwav.f90 lib/timer_C_wrapper.f90 @@ -496,8 +496,8 @@ set (wsjt_FSRCS lib/polyfit.f90 lib/prog_args.f90 lib/ps4.f90 - lib/q65_avg.f90 - lib/q65_sync.f90 + lib/qra/q65/q65_avg.f90 + lib/qra/q65/q65_sync.f90 lib/qra/q65/q65_ap.f90 lib/qra/q65/q65_loops.f90 lib/qra/q65/q65_set_list.f90 diff --git a/lib/q65_decode.f90 b/lib/q65_decode.f90 index 303fa9df3..2a10b4a67 100644 --- a/lib/q65_decode.f90 +++ b/lib/q65_decode.f90 @@ -42,7 +42,7 @@ contains use timer_module, only: timer use packjt77 use, intrinsic :: iso_c_binding - use q65 + use q65 !Shared variables parameter (NMAX=300*12000) !Max TRperiod is 300 s class(q65_decoder), intent(inout) :: this @@ -89,44 +89,51 @@ contains baud=12000.0/nsps df1=12000.0/nfft1 this%callback => callback - if(nutc.eq.-999) print*,lapdx,nfa,nfb,nfqso !Silence warning nFadingModel=1 - call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) +! Set up the codewords for full-AP list decoding + call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw) dgen=0 - call q65_enc(dgen,codewords) !Initialize Q65 + call q65_enc(dgen,codewords) !Initialize the Q65 codec call timer('sync_q65',0) - call q65_sync(nutc,iwave,ntrperiod,mode65,codewords,ncw,nsps, & - nfqso,ntol,ndepth,lclearave,emedelay,xdt,f0,snr1,width,dat4,snr2,id1) + call q65_sync(nutc,iwave,ntrperiod,mode65,codewords,ncw,nsps, & + nfqso,ntol,ndepth,lclearave,emedelay,xdt,f0,snr1,width,dat4, & + snr2,id1) call timer('sync_q65',1) + if(id1.eq.1 .or. id1.ge.12) then - xdt1=xdt + xdt1=xdt !We have a list-decode result f1=f0 - go to 100 +! go to 100 !### TEMPORARILY REMOVED ### endif if(snr1.lt.2.8) then - xdt1=0. + xdt1=0. !No reliable sync, abandon decoding attempt f1=0. go to 100 endif - jpk0=(xdt+1.0)*6000 !### Is this OK? - if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !### + + jpk0=(xdt+1.0)*6000 !Index of nominal start of signal + if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !For shortest sequences if(jpk0.lt.0) jpk0=0 fac=1.0/32767.0 dd=fac*iwave(1:npts) - nmode=65 - call ana64(dd,npts,c00) + call ana64(dd,npts,c00) !Convert to complex c00() at 6000 Sa/s + +! Generate ap symbols as in FT8 call ft8apset(mycall,hiscall,ncontest,apsym0,aph10) where(apsym0.eq.-1) apsym0=0 +! Main decoding loop starts here npasses=2 if(nQSOprogress.eq.5) npasses=3 if(lapcqonly) npasses=1 iaptype=0 do ipass=0,npasses - apmask=0 + apmask=0 !Try first with no AP information apsymbols=0 + if(ipass.ge.1) then + ! Subsequent passes use AP information appropiate for nQSOprogress call q65_ap(nQSOprogress,ipass,ncontest,lapcqonly,iaptype, & apsym0,apmask1,apsymbols1) write(c78,1050) apmask1 @@ -144,17 +151,21 @@ contains enddo endif endif + call timer('q65loops',0) - call q65_loops(c00,npts/2,nsps/2,nmode,mode65,nsubmode, & + call q65_loops(c00,npts/2,nsps/2,mode65,nsubmode, & nFadingModel,ndepth,jpk0,xdt,f0,width,iaptype,apmask,apsymbols, & xdt1,f1,snr2,dat4,id2) call timer('q65loops',1) -! snr2=snr2 + db(6912.0/nsps) - if(id2.gt.0) exit + if(id2.gt.0) exit !Exit main loop after a successful decode enddo +! No single-transmission decode. +! if(iand(ndepth,16).eq.16) call q65_avg2 + 100 decoded=' ' if(id1.gt.0 .or. id2.gt.0) then +! Unpack decoded message for display to user idec=id1+id2 write(c77,1000) dat4(1:12),dat4(13)/2 1000 format(12b6.6,b5.5) diff --git a/lib/q65.f90 b/lib/qra/q65/q65.f90 similarity index 83% rename from lib/q65.f90 rename to lib/qra/q65/q65.f90 index 50e7fbb16..47849b5af 100644 --- a/lib/q65.f90 +++ b/lib/qra/q65/q65.f90 @@ -1,6 +1,7 @@ module q65 parameter (MAXAVE=64) + parameter (PLOG_MIN=-240.0) !List decoding threshold integer nsave,nlist,LL0 integer iutc(MAXAVE) integer iseq(MAXAVE) diff --git a/lib/q65_avg.f90 b/lib/qra/q65/q65_avg.f90 similarity index 77% rename from lib/q65_avg.f90 rename to lib/qra/q65/q65_avg.f90 index 8a116b3bd..fdd086313 100644 --- a/lib/q65_avg.f90 +++ b/lib/qra/q65/q65_avg.f90 @@ -6,7 +6,6 @@ subroutine q65_avg(nutc,ntrperiod,mode_q65,LL,nfqso,ntol,lclearave, & use q65 use packjt77 - parameter (PLOG_MIN=-240.0) !List decoding threshold character*37 avemsg character*1 csync,cused(MAXAVE) character*6 cutc @@ -69,7 +68,6 @@ subroutine q65_avg(nutc,ntrperiod,mode_q65,LL,nfqso,ntol,lclearave, & 10 continue !10 if(nsave.lt.2) go to 900 - snr1sum=0. xdtsum=0. fsum=0. @@ -107,7 +105,7 @@ subroutine q65_avg(nutc,ntrperiod,mode_q65,LL,nfqso,ntol,lclearave, & fave=fsum/nsum endif -! Write parameters for display to User in the Message Averaging window. +! Write parameters for display to User in the Message Averaging (F7) window. do i=1,nsave if(ntrperiod.le.30) write(14,1000) cused(i),iutc(i),snr1save(i), & xdtsave(i),f0save(i) @@ -118,56 +116,30 @@ subroutine q65_avg(nutc,ntrperiod,mode_q65,LL,nfqso,ntol,lclearave, & enddo ! if(nsum.lt.2) go to 900 !Must have at least 2 -! Find rms scatter of DT and f0 values - sqt=0. - sqf=0. - do j=1,MAXAVE - i=iused(j) - if(i.eq.0) exit - csync='*' - sqt=sqt + (xdtsave(i)-dtave)**2 - sqf=sqf + (f0save(i)-fave)**2 - enddo - rmst=0. - rmsf=0. - if(nsum.ge.2) then - rmst=sqrt(sqt/(nsum-1)) - rmsf=sqrt(sqf/(nsum-1)) - endif - s3avg=s3avg/nsum nFadingModel=1 do ibw=ibwa,ibwb b90=1.72**ibw - call q65_intrinsics_ff(s3avg,nsubmode,b90/baud,nFadingModel,s3prob) - call q65_dec_fullaplist(s3avg,s3prob,codewords,ncw,esnodb,dat4,plog,irc) + b90ts=b90/baud + call q65_dec1(s3,nsubmode,b90ts,codewords,ncw,esnodb,irc,dat4,avemsg) if(irc.ge.0 .and. plog.ge.PLOG_MIN) then snr2=esnodb - db(2500.0/baud) + 3.0 !Empirical adjustment id1=1 !### - write(c77,3050) dat4(1:12),dat4(13)/2 -3050 format(12b6.6,b5.5) - call unpack77(c77,0,avemsg,unpk77_success) !Unpack to get msgsent - open(55,file='fort.55',status='unknown',position='append') - write(55,3055) nutc,ibw,xdt,f0,85.0*base,ccfmax,snr2,plog, & - irc,trim(avemsg) -3055 format(i6,i3,6f8.2,i5,2x,a) - close(55) - print*,'F ',avemsg + print*,'B dec1 ',ibw,irc,avemsg exit endif enddo APmask=0 APsymbols=0 - read(41) LNZ,s3avg do ibw=ibwa,ibwb b90=1.72**ibw - call q65_intrinsics_ff(s3avg,nsubmode,b90/baud,nFadingModel,s3prob) - call q65_dec(s3avg,s3prob,APmask,APsymbols,esnodb,dat4,irc) - print*,'G',ibw,irc,sum(s3avg) + b90ts=b90/baud + call q65_dec2(s3,nsubmode,b90ts,esnodb,irc,dat4,avemsg) if(irc.ge.0) then id2=iaptype+2 + print*,'C dec2 ',ibw,irc,avemsg exit endif enddo ! ibw (b90 loop) diff --git a/lib/qra/q65/q65_loops.f90 b/lib/qra/q65/q65_loops.f90 index 95cf573f5..b89d385ef 100644 --- a/lib/qra/q65/q65_loops.f90 +++ b/lib/qra/q65/q65_loops.f90 @@ -1,4 +1,4 @@ -subroutine q65_loops(c00,npts2,nsps,mode,mode_q65,nsubmode,nFadingModel, & +subroutine q65_loops(c00,npts2,nsps,mode_q65,nsubmode,nFadingModel, & ndepth,jpk0,xdt0,f0,width,iaptype,APmask,APsymbols,xdt1,f1,snr2,dat4,id2) use packjt77 @@ -7,8 +7,7 @@ subroutine q65_loops(c00,npts2,nsps,mode,mode_q65,nsubmode,nFadingModel, & parameter (LN=1152*63) !LN=LL*NN; LL=64*(mode_q65+2), NN=63 complex c00(0:npts2-1) !Analytic representation of dd(), 6000 Hz complex ,allocatable :: c0(:) !Ditto, with freq shift -! character c77*77,decoded*37 -! logical unpk77_success + character decoded*37 real a(3) !twkfreq params f,f1,f2 real s3(LN) !Symbol spectra real s3prob(64*NN) !Symbol-value probabilities @@ -61,7 +60,7 @@ subroutine q65_loops(c00,npts2,nsps,mode,mode_q65,nsubmode,nFadingModel, & jpk=jpk0 + nsps*ndt/16 !tsym/16 if(jpk.lt.0) jpk=0 call timer('spec64 ',0) - call spec64(c0,nsps,mode,mode_q65,jpk,s3,LL,NN) + call spec64(c0,nsps,65,mode_q65,jpk,s3,LL,NN) call timer('spec64 ',1) call pctile(s3,LL*NN,40,base) s3=s3/base @@ -75,54 +74,21 @@ subroutine q65_loops(c00,npts2,nsps,mode,mode_q65,nsubmode,nFadingModel, & xx=1.885*log(3.0*width)+nbw b90=1.7**xx if(b90.gt.345.0) cycle - call timer('q65_intr',0) b90ts = b90/baud - call q65_intrinsics_ff(s3,nsubmode,b90ts,nFadingModel,s3prob) - call timer('q65_intr',1) - call timer('q65_dec ',0) - call q65_dec(s3,s3prob,APmask,APsymbols,esnodb,dat4,irc) - call timer('q65_dec ',1) - print*,'H',ibw,irc,iaptype,sum(s3(1:LL*NN)) -! rewind 41 -! write(41) LL*NN,s3(1:LL*NN) - if(irc.ge.0) id2=iaptype+2 - -!### Temporary ### -! if(irc.ge.0) then -! write(c77,1000) dat4(1:12),dat4(13)/2 -!1000 format(12b6.6,b5.5) -! call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent -! snr2=esnodb - db(2500.0/baud) -! xdt1=xdt0 + nsps*ndt/(16.0*6000.0) -! f1=f0 + 0.5*baud*ndf -! open(56,file='fort.56',status='unknown',position='append') -! write(56,3055) idf,idt,ibw,id2,irc,xdt1,f1,snr2,trim(decoded) -!3055 format(5i3,3f8.2,2x,a) -! close(56) -! endif -!### - - if(irc.ge.0) go to 100 + call q65_dec2(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded) ! irc > 0 ==> number of iterations required to decode ! -1 = invalid params ! -2 = decode failed ! -3 = CRC mismatch + if(irc.ge.0) then + id2=iaptype+2 + print*,'D dec2 ',ibw,irc,decoded + go to 100 + endif enddo ! ibw (b90 loop) enddo ! idt (DT loop) enddo ! idf (f0 loop) -! if(iaptype.eq.0) then -! a=0. -! a(1)=-f0 -! call twkfreq(c00,c0,npts2,6000.0,a) -! jpk=3000 !### Are these definitions OK? -! if(nsps.ge.3600) jpk=6000 !### TR >= 60 s -! call spec64(c0,nsps,mode,mode_q65,jpk,s3,LL,NN) -! call pctile(s3,LL*NN,40,base) -! s3=s3/base -! where(s3(1:LL*NN)>s3lim) s3(1:LL*NN)=s3lim -! endif - 100 if(irc.ge.0) then snr2=esnodb - db(2500.0/baud) xdt1=xdt0 + nsps*ndt/(16.0*6000.0) diff --git a/lib/q65_sync.f90 b/lib/qra/q65/q65_sync.f90 similarity index 75% rename from lib/q65_sync.f90 rename to lib/qra/q65/q65_sync.f90 index 4f1f73b1f..5459815b9 100644 --- a/lib/q65_sync.f90 +++ b/lib/qra/q65/q65_sync.f90 @@ -1,5 +1,5 @@ -subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps,nfqso,ntol, & - ndepth,lclearave,emedelay,xdt,f0,snr1,width,dat4,snr2,id1) +subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps, & + nfqso,ntol,ndepth,lclearave,emedelay,xdt,f0,snr1,width,dat4,snr2,id1) ! Detect and align with the Q65 sync vector, returning time and frequency ! offsets and SNR estimate. @@ -23,9 +23,8 @@ subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps,nfqso,ntol, integer codewords(63,206) integer dat4(13) integer ijpk(2) - logical unpk77_success logical lclearave - character*77 c77,decoded*37 + character*37 decoded real, allocatable :: s1(:,:) !Symbol spectra, 1/8-symbol steps real, allocatable :: s3(:,:) !Data-symbol energies s3(LL,63) real, allocatable :: ccf(:,:) !CCF(freq,lag) @@ -178,34 +177,22 @@ subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps,nfqso,ntol, ibwa=1.8*log(baud*mode_q65) + 2 ibwb=min(10,ibwa+4) -10 do ibw=ibwa,ibwb + do ibw=ibwa,ibwb b90=1.72**ibw - call q65_intrinsics_ff(s3,nsubmode,b90/baud,nFadingModel,s3prob) - call q65_dec_fullaplist(s3,s3prob,codewords,ncw,esnodb,dat4,plog,irc) -!### - write(*,3001) 'A',ibw,irc,xdt,f0,plog,sum(s3) -3001 format(a1,2i3,f7.2,3f8.1) - if(irc.gt.0) go to 100 -!### - if(irc.ge.0 .and. plog.ge.PLOG_MIN) then + b90ts=b90/baud + call q65_dec1(s3,nsubmode,b90ts,codewords,ncw,esnodb,irc,dat4,decoded) +! irc=-99 !### TEMPORARY ### + if(irc.ge.0) then + print*,'A dec1 ',ibw,irc,decoded snr2=esnodb - db(2500.0/baud) + 3.0 !Empirical adjustment id1=1 - -! write(c77,1000) dat4(1:12),dat4(13)/2 -!1000 format(12b6.6,b5.5) -! call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent -! open(55,file='fort.55',status='unknown',position='append') -! write(55,3055) nutc,ibw,xdt,f0,85.0*base,ccfmax,snr2,plog, & -! irc,trim(decoded) -!3055 format(i6,i3,6f8.2,i5,2x,a) -! close(55) - ic=ia2/4; base=(sum(ccf1(-ia2:-ia2+ic)) + sum(ccf1(ia2-ic:ia2)))/(2.0+2.0*ic); ccf1=ccf1-base smax=maxval(ccf1) if(smax.gt.10.0) ccf1=10.0*ccf1/smax - go to 200 + go to 100 !### TEMPORARY ### +! go to 200 endif enddo @@ -248,24 +235,26 @@ subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps,nfqso,ntol, ccf1=ccf(:,jpk)/rms if(snr1.gt.10.0) ccf1=(10.0/snr1)*ccf1 -! Compute s3() here, then call q65_avg(). - i1=i0+ipk-64 - i2=i1+LL-1 - if(snr1.ge.2.8 .and. i1.ge.1 .and. i2.le.iz) then - j=j0+jpk-7 - n=0 - do k=1,85 - j=j+8 - if(sync(k).gt.0.0) then - cycle - endif - n=n+1 - if(j.ge.1 .and. j.le.jz) s3(-64:LL-65,n)=s1(i1:i2,j) - enddo - write(*,3002) 'B',xdt,f0,sum(s3) -3002 format(a1,f7.2,2f8.1) - call q65_avg(nutc,ntrperiod,mode_q65,LL,nfqso,ntol,lclearave, & - baud,nsubmode,ibwa,ibwb,codewords,ncw,xdt,f0,snr1,s3) + if(iand(ndepth,16).eq.16) then +! Fill s3() from s1() here, then call q65_avg(). + i1=i0+ipk-64 + i2=i1+LL-1 + if(snr1.ge.2.8 .and. i1.ge.1 .and. i2.le.iz) then + j=j0+jpk-7 + n=0 + do k=1,85 + j=j+8 + if(sync(k).gt.0.0) then + cycle + endif + n=n+1 + if(j.ge.1 .and. j.le.jz) s3(-64:LL-65,n)=s1(i1:i2,j) + enddo +! write(*,3002) 'B',xdt,f0,sum(s3) +!3002 format(a1,f7.2,2f8.1) + call q65_avg(nutc,ntrperiod,mode_q65,LL,nfqso,ntol,lclearave, & + baud,nsubmode,ibwa,ibwb,codewords,ncw,xdt,f0,snr1,s3) + endif endif 200 smax=maxval(ccf1) @@ -286,3 +275,48 @@ subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps,nfqso,ntol, 900 return end subroutine q65_sync + +subroutine q65_dec1(s3,nsubmode,b90ts,codewords,ncw,esnodb,irc,dat4,decoded) + + use q65 + use packjt77 + real s3prob(0:63,63) !Symbol-value probabilities + integer codewords(63,206) + integer dat4(13) + character c77*77,decoded*37 + logical unpk77_success + + nFadingModel=1 + decoded=' ' + call q65_intrinsics_ff(s3,nsubmode,b90ts,nFadingModel,s3prob) + call q65_dec_fullaplist(s3,s3prob,codewords,ncw,esnodb,dat4,plog,irc) + if(irc.ge.0 .and. plog.gt.PLOG_MIN) then + write(c77,1000) dat4(1:12),dat4(13)/2 +1000 format(12b6.6,b5.5) + call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent + endif + + return +end subroutine q65_dec1 + +subroutine q65_dec2(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded) + + use q65 + use packjt77 + real s3prob(0:63,63) !Symbol-value probabilities + integer dat4(13) + character c77*77,decoded*37 + logical unpk77_success + + nFadingModel=1 + decoded=' ' + call q65_intrinsics_ff(s3,nsubmode,b90ts,nFadingModel,s3prob) + call q65_dec(s3,s3prob,APmask,APsymbols,esnodb,dat4,irc) + if(irc.ge.0) then + write(c77,1000) dat4(1:12),dat4(13)/2 +1000 format(12b6.6,b5.5) + call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent + endif + + return +end subroutine q65_dec2