From 535c02d900c2164b6f0a0deea4a7309d972cd904 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sun, 13 Dec 2020 15:33:12 -0600 Subject: [PATCH 01/46] Implements decoding of FST4W messages as (240,50) crc-less codewords. By cascading the full 24-bit crc generator matrix with the (240,74) LDPC code generator, create a (240,50) generator that is used to decode with approximately 1 dB better sensitivity than the (240,64) with 14-bit CRC approach that is normally used. This approach treats the CRC bits as additional parity bits and provides no means for identifying incorrect codewords. All codewords on the list generated by the OSD algorithm have CRCs that match the CRC of the message payload. Codewords are validated by unpacking the message and comparing the unpacked message with the list of stored callsign/grid pairs stored in the fst4w_calls.txt file. --- CMakeLists.txt | 1 + lib/fst4/decode240_74.f90 | 3 +- lib/fst4/fastosd240_74.f90 | 291 +++++++++++++++++++++++++++++++++++++ lib/fst4/ldpcsim240_74.f90 | 2 +- lib/fst4_decode.f90 | 232 +++++++++++++++++++---------- 5 files changed, 452 insertions(+), 77 deletions(-) create mode 100644 lib/fst4/fastosd240_74.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 41e2d74a0..2ab9a20b0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -570,6 +570,7 @@ set (wsjt_FSRCS lib/fst4/ldpcsim240_74.f90 lib/fst4/osd240_101.f90 lib/fst4/osd240_74.f90 + lib/fst4/fastosd240_74.f90 lib/fst4/get_crc24.f90 lib/fst4/fst4_baseline.f90 ) diff --git a/lib/fst4/decode240_74.f90 b/lib/fst4/decode240_74.f90 index be18f6e09..20a83362f 100644 --- a/lib/fst4/decode240_74.f90 +++ b/lib/fst4/decode240_74.f90 @@ -135,7 +135,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder do i=1,nosd zn=zsave(:,i) - call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) +! call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) + call fastosd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) if(nharderror.gt.0) then hdec=0 where(llr .ge. 0) hdec=1 diff --git a/lib/fst4/fastosd240_74.f90 b/lib/fst4/fastosd240_74.f90 new file mode 100644 index 000000000..03ae4071c --- /dev/null +++ b/lib/fst4/fastosd240_74.f90 @@ -0,0 +1,291 @@ +subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) +! +! An ordered-statistics decoder for the (240,74) code. +! Message payload is 50 bits. Any or all of a 24-bit CRC can be +! used for detecting incorrect codewords. The remaining CRC bits are +! cascaded with the LDPC code for the purpose of improving the +! distance spectrum of the code. +! +! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are +! to be used for bad codeword detection, then the argument k should +! be set to 77+p1. +! +! Valid values for k are in the range [50,74]. +! + character*24 c24 + integer, parameter:: N=240 + integer*1 apmask(N),apmaskr(N) + integer*1, allocatable, save :: gen(:,:) + integer*1, allocatable :: genmrb(:,:),g2(:,:) + integer*1, allocatable :: temp(:),temprow(:),m0(:),me(:),mi(:) + integer indices(N),indices2(N),nxor(N) + integer*1 cw(N),ce(N),c0(N),hdec(N) + integer*1, allocatable :: decoded(:) + integer*1 message74(74) + integer*1, allocatable :: sp(:) + integer indx(N),ksave + real llr(N),rx(N),absrx(N) + + logical first + data first/.true./,ksave/64/ + save first,ksave + + allocate( genmrb(k,N), g2(N,k) ) + allocate( temp(k), temprow(n), m0(k), me(k), mi(k) ) + allocate( decoded(k) ) + + if( first .or. k.ne.ksave) then ! fill the generator matrix +! +! Create generator matrix for partial CRC cascaded with LDPC code. +! +! Let p2=74-k and p1+p2=24. +! +! The last p2 bits of the CRC24 are cascaded with the LDPC code. +! +! The first p1=k-50 CRC24 bits will be used for error detection. +! + if( allocated(gen) ) deallocate(gen) + allocate( gen(k,N) ) + gen=0 + do i=1,k + message74=0 + message74(i)=1 + if(i.le.50) then + call get_crc24(message74,74,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') message74(51:74) + message74(51:k)=0 + endif + call encode240_74(message74,cw) + gen(i,:)=cw + enddo + + first=.false. + ksave=k + endif + +! Use best k elements from the sorted list for the first basis. For the 2nd basis replace +! the nswap lowest quality symbols with the best nswap elements from the parity symbols. + nswap=20 + + do ibasis=1,2 + rx=llr + apmaskr=apmask + +! Hard decisions on the received word. + hdec=0 + where(rx .ge. 0) hdec=1 + +! Use magnitude of received symbols as a measure of reliability. + absrx=abs(llr) + call indexx(absrx,N,indx) + +! Re-order the columns of the generator matrix in order of decreasing reliability. + do i=1,N + genmrb(1:k,i)=gen(1:k,indx(N+1-i)) + indices(i)=indx(N+1-i) + enddo + + if(ibasis.eq.2) then + do i=k-nswap+1,k + temp(1:k)=genmrb(1:k,i) + genmrb(1:k,i)=genmrb(1:k,i+nswap) + genmrb(1:k,i+nswap)=temp(1:k) + itmp=indices(i) + indices(i)=indices(i+nswap) + indices(i+nswap)=itmp + enddo + endif + +! Do gaussian elimination to create a generator matrix with the most reliable +! received bits in positions 1:k in order of decreasing reliability (more or less). + + icol=1 + indices2=0 + nskipped=0 + do id=1,k + iflag=0 + do while(iflag.eq.0) + if(genmrb(id,icol).ne.1) then + do j=id+1,k + if(genmrb(j,icol).eq.1) then + temprow=genmrb(id,:) + genmrb(id,:)=genmrb(j,:) + genmrb(j,:)=temprow + iflag=1 + endif + enddo + if(iflag.eq.0) then ! skip this column + nskipped=nskipped+1 + indices2(k+nskipped)=icol ! put icol where skipped columns go + icol=icol+1 ! look at the next column + endif + else + iflag=1 + endif + enddo + indices2(id)=icol + do j=1,k + if(id.ne.j .and. genmrb(j,icol).eq.1) then + genmrb(j,:)=ieor(genmrb(id,:),genmrb(j,:)) + endif + enddo + icol=icol+1 + enddo + do i=k+nskipped+1,240 + indices2(i)=i + enddo + genmrb(1:k,:)=genmrb(1:k,indices2) + indices=indices(indices2) + +!************************************ + g2=transpose(genmrb) + +! The hard decisions for the k MRB bits define the order 0 message, m0. +! Encode m0 using the modified generator matrix to find the "order 0" codeword. +! Flip various combinations of bits in m0 and re-encode to generate a list of +! codewords. Return the member of the list that has the smallest Euclidean +! distance to the received word. + + hdec=hdec(indices) ! hard decisions from received symbols + m0=hdec(1:k) ! zero'th order message + absrx=abs(llr) + absrx=absrx(indices) + rx=rx(indices) + apmaskr=apmaskr(indices) + + call mrbencode74(m0,c0,g2,N,k) + nxor=ieor(c0,hdec) + nhardmin=sum(nxor) + dmin=sum(nxor*absrx) + np=32 + if(ibasis.eq.1) allocate(sp(np)) + + cw=c0 + ntotal=0 + nrejected=0 + + if(ndeep.eq.0) goto 998 ! norder=0 + if(ndeep.gt.4) ndeep=4 + if( ndeep.eq. 1) then + nord=1 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.2) then + nord=2 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.3) then + nord=3 + xlambda=4.0 + nsyncmax=11 + elseif(ndeep.eq.4) then + nord=4 + xlambda=3.5 + nsyndmax=11 + endif + + s1=sum(absrx(1:k)) + s2=sum(absrx(k+1:N)) + rho=s1/(s1+xlambda*s2) + rhodmin=rho*dmin + nerr64=-1 + do iorder=1,nord +!beta=0.0 +!if(iorder.ge.3) beta=0.4 +!spnc_order=sum(absrx(k-iorder+1:k))+beta*(N-k) +!if(dmin.lt.spnc_order) cycle + mi(1:k-iorder)=0 + mi(k-iorder+1:k)=1 + iflag=k-iorder+1 + do while(iflag .ge.0) + ntotal=ntotal+1 + me=ieor(m0,mi) + d1=sum(mi(1:k)*absrx(1:k)) + if(d1.gt.rhodmin) exit + call partial_syndrome(me,sp,np,g2,N,K) + nwhsp=sum(ieor(sp(1:np),hdec(k:k+np-1))) + if(nwhsp.le.nsyndmax) then + call mrbencode74(me,ce,g2,N,k) + nxor=ieor(ce,hdec) + dd=sum(nxor*absrx(1:N)) + if( dd .lt. dmin ) then + dmin=dd + rhodmin=rho*dmin + cw=ce + nhardmin=sum(nxor) + nwhspmin=nwhsp + nerr64=sum(nxor(1:K)) + endif + endif +! Get the next test error pattern, iflag will go negative +! when the last pattern with weight iorder has been generated. + call nextpat74(mi,k,iorder,iflag) + enddo + enddo + +998 continue +! Re-order the codeword to [message bits][parity bits] format. + cw(indices)=cw + hdec(indices)=hdec + message74=cw(1:74) + call get_crc24(message74,74,nbadcrc) + if(nbadcrc.eq.0) exit + nhardmin=-nhardmin + enddo ! basis loop + return +end subroutine fastosd240_74 + +subroutine mrbencode74(me,codeword,g2,N,K) + integer*1 me(K),codeword(N),g2(N,K) +! fast encoding for low-weight test patterns + codeword=0 + do i=1,K + if( me(i) .eq. 1 ) then + codeword=ieor(codeword,g2(1:N,i)) + endif + enddo + return +end subroutine mrbencode74 + +subroutine partial_syndrome(me,sp,np,g2,N,K) + integer*1 me(K),sp(np),g2(N,K) +! compute partial syndrome + sp=0 + do i=1,K + if( me(i) .eq. 1 ) then + sp=ieor(sp,g2(K:K+np-1,i)) + endif + enddo + return +end subroutine partial_syndrome + +subroutine nextpat74(mi,k,iorder,iflag) + integer*1 mi(k),ms(k) +! generate the next test error pattern + ind=-1 + do i=1,k-1 + if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i + enddo + if( ind .lt. 0 ) then ! no more patterns of this order + iflag=ind + return + endif + ms=0 + ms(1:ind-1)=mi(1:ind-1) + ms(ind)=1 + ms(ind+1)=0 + if( ind+1 .lt. k ) then + nz=iorder-sum(ms) + ms(k-nz+1:k)=1 + endif + mi=ms + do i=1,k ! iflag will point to the lowest-index 1 in mi + if(mi(i).eq.1) then + iflag=i + exit + endif + enddo + return +end subroutine nextpat74 + diff --git a/lib/fst4/ldpcsim240_74.f90 b/lib/fst4/ldpcsim240_74.f90 index b488aa6b6..78e8e6b5f 100644 --- a/lib/fst4/ldpcsim240_74.f90 +++ b/lib/fst4/ldpcsim240_74.f90 @@ -101,7 +101,7 @@ write(*,'(24i1)') msgbits(51:74) llr=2.0*rxdata/(ss*ss) apmask=0 dmin=0.0 - maxosd=0 + maxosd=2 call decode240_74(llr, Keff, maxosd, norder, apmask, message74, cw, ntype, nharderror, dmin) if(nharderror.ge.0) then n2err=0 diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index ba49fb54d..ccf6d9662 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -33,15 +33,17 @@ contains ndepth,ntrperiod,nexp_decode,ntol,emedelay,lagain,lapcqonly,mycall, & hiscall,iwspr) + use prog_args use timer_module, only: timer use packjt77 use, intrinsic :: iso_c_binding include 'fst4/fst4_params.f90' - parameter (MAXCAND=100) + parameter (MAXCAND=100,MAXWCALLS=100) class(fst4_decoder), intent(inout) :: this procedure(fst4_decode_callback) :: callback character*37 decodes(100) character*37 msg,msgsent + character*20 wcalls(MAXWCALLS), wpart character*77 c77 character*12 mycall,hiscall character*12 mycall0,hiscall0 @@ -66,7 +68,8 @@ contains integer mcq(29),mrrr(19),m73(19),mrr73(19) logical badsync,unpk77_success,single_decode - logical first,nohiscall,lwspr,ex + logical first,nohiscall,lwspr,ex,wcalls_exists,donocrcdecode + logical new_callsign integer*2 iwave(30*60*12000) @@ -80,6 +83,7 @@ contains 0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/ data first/.true./,hmod/1/ save first,apbits,nappasses,naptypes,mycall0,hiscall0 + save wcalls,nwcalls this%callback => callback dxcall13=hiscall ! initialize for use in packjt77 @@ -88,6 +92,24 @@ contains if(iwspr.ne.0.and.iwspr.ne.1) return if(first) then +! read the fst4_calls.txt file + write(*,*) 'data_dir is:',trim(data_dir) + inquire(file=trim(data_dir)//'/fst4w_calls.txt',exist=wcalls_exists) + if( wcalls_exists ) then + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + write(*,*) 'fst4w_calls.txt exists' + do i=1,MAXWCALLS + wcalls(i)='' + read(42,fmt='(a)',end=2867) wcalls(i) + wcalls(i)=adjustl(wcalls(i)) + if(len(trim(wcalls(i))).eq.0) exit + write(*,*) 'record ',i,':',wcalls(i),':',len(trim(wcalls(i))) + enddo +2867 nwcalls=i-1 + write(*,*) 'nwcalls ',nwcalls + close(42) + endif + mcq=2*mod(mcq+rvec(1:29),2)-1 mrrr=2*mod(mrrr+rvec(59:77),2)-1 m73=2*mod(m73+rvec(59:77),2)-1 @@ -216,12 +238,15 @@ contains if(ndepth.eq.3) then nblock=4 jittermax=2 + donocrcdecode=.true. elseif(ndepth.eq.2) then - nblock=3 - jittermax=0 + nblock=4 + jittermax=2 + donocrcdecode=.false. elseif(ndepth.eq.1) then - nblock=1 + nblock=4 jittermax=0 + donocrcdecode=.false. endif ndropmax=1 @@ -244,7 +269,7 @@ contains if(iwspr.eq.1) then !FST4W !300 Hz wide noise-fit window - nfa=max(100,nint(nfqso+1.5*baud-150)) + nfa=max(100,nint(nfqso+1.5*baud-150)) nfb=min(4800,nint(nfqso+1.5*baud+150)) fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window fb=min(4800,nint(nfqso+1.5*baud+ntol)) @@ -252,18 +277,19 @@ contains fa=max(100,nint(nfa+1.5*baud)) fb=min(4800,nint(nfb+1.5*baud)) ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) + nfa=max(100,nfa-100) nfb=min(4800,nfb+100) else fa=max(100,nint(nfa+1.5*baud)) fb=min(4800,nint(nfb+1.5*baud)) ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) + nfa=max(100,nfa-100) nfb=min(4800,nfb+100) endif - + ndecodes=0 decodes=' ' + new_callsign=.false. do inb=0,inb1,inb2 if(nb.lt.0) npct=inb call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) @@ -275,16 +301,16 @@ contains nsyncoh=8 minsync=1.20 if(ntrperiod.eq.15) minsync=1.15 - + ! Get first approximation of candidate frequencies call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & - minsync,ncand,candidates0) + minsync,ncand,candidates0) isbest=0 fc2=0. do icand=1,ncand fc0=candidates0(icand,1) if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & - abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle detmet=candidates0(icand,2) ! Downconvert and downsample a slice of the spectrum centered on the @@ -330,7 +356,7 @@ contains endif enddo ncand=ic - + ! If FST4 and Single Decode is not checked, then find candidates within ! 20 Hz of nfqso and put them at the top of the list if(iwspr.eq.0 .and. .not.single_decode) then @@ -373,7 +399,7 @@ contains bitmetrics=0 call timer('bitmetrc',0) call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & - s4,nsync_qual,badsync) + s4,nsync_qual,badsync) call timer('bitmetrc',1) if(badsync) cycle @@ -405,7 +431,7 @@ contains iaptype=0 endif - if(itry.gt.nblock) then ! do ap passes + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes iaptype=naptypes(nQSOProgress,itry-nblock) if(lapcqonly) iaptype=1 @@ -428,7 +454,7 @@ contains apmask(1:58)=1 llr(1:58)=apmag*apbits(1:58) endif - + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then apmask=0 apmask(1:77)=1 @@ -438,7 +464,7 @@ contains if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) endif endif - + dmin=0.0 nharderrors=-1 unpk77_success=.false. @@ -448,83 +474,133 @@ contains norder=3 call timer('d240_101',0) call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & - cw,ntype,nharderrors,dmin) + cw,ntype,nharderrors,dmin) call timer('d240_101',1) - elseif(iwspr.eq.1) then - maxosd=2 - call timer('d240_74 ',0) - Keff=64 - norder=4 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - endif - - if(nharderrors .ge.0) then if(count(cw.eq.1).eq.0) then nharderrors=-nharderrors cycle endif - if(iwspr.eq.0) then - write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then + iaptype=0 + if( donocrcdecode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) - else + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + iaptype=8 + endif + enddo + endif + endif + if(.not. unpk77_success) then + maxosd=2 + call timer('d240_74 ',0) + Keff=64 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) cycle + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) endif - if(unpk77_success) then - idupe=0 - do i=1,ndecodes - if(decodes(i).eq.msg) idupe=1 + + if(unpk77_success.and.Keff.eq.64) then + + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) + + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 enddo - if(idupe.eq.1) goto 800 - ndecodes=ndecodes+1 - decodes(ndecodes)=msg - - if(iwspr.eq.0) then - call get_fst4_tones_from_bits(message101,itone,0) - else - call get_fst4_tones_from_bits(message74,itone,1) - endif - inquire(file='plotspec',exist=ex) - fmid=-999.0 - call timer('dopsprd ',0) - if(ex) then - call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & - isbest,fc_synced,fmid,w50) - endif - call timer('dopsprd ',1) - xsig=0 - do i=1,NN - xsig=xsig+s4(itone(i),i) - enddo - base=candidates(icand,5) - arg=600.0*(xsig/base)-1.0 - if(arg.gt.0.0) then - xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) - if(ntrperiod.eq. 15) xsnr=xsnr+2 - if(ntrperiod.eq. 30) xsnr=xsnr+1 - if(ntrperiod.eq. 900) xsnr=xsnr+1 - if(ntrperiod.eq.1800) xsnr=xsnr+2 - else - xsnr=-99.9 + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif endif + endif + endif + + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) else - cycle + call get_fst4_tones_from_bits(message74,itone,1) + endif + inquire(file='plotspec',exist=ex) + fmid=-999.0 + call timer('dopsprd ',0) + if(ex) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + arg=600.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) + if(ntrperiod.eq. 15) xsnr=xsnr+2 + if(ntrperiod.eq. 30) xsnr=xsnr+1 + if(ntrperiod.eq. 900) xsnr=xsnr+1 + if(ntrperiod.eq.1800) xsnr=xsnr+2 + else + xsnr=-99.9 endif nsnr=nint(xsnr) - qual=0. + qual=0.0 + if(iaptype.eq.8) qual=1. fsig=fc_synced - 1.5*baud if(ex) then write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,nsync_qual,nharderrors,dmin, & - sync,xsnr,xdt,fsig,w50,trim(msg) + ijitter,ntype,nsync_qual,nharderrors,dmin, & + sync,xsnr,xdt,fsig,w50,trim(msg) 3021 format(i6.6,6i3,2i4,f6.1,f7.2,f6.1,f6.2,f7.1,f7.3,1x,a) flush(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & - iaptype,qual,ntrperiod,lwspr,fmid,w50) + iaptype,qual,ntrperiod,lwspr,fmid,w50) if(iwspr.eq.0 .and. nb.lt.0) go to 900 goto 800 endif @@ -532,9 +608,15 @@ contains enddo ! istart jitter 800 enddo !candidate list enddo ! noise blanker loop - + if(new_callsign) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif 900 return - end subroutine decode + end subroutine decode subroutine sync_fst4(cd0,i0,f0,hmod,ncoh,np,nss,ntr,fs,sync) @@ -902,6 +984,6 @@ contains enddo return - end subroutine dopspread + end subroutine dopspread end module fst4_decode From 771e71bc8434c6cc9c8eea34df942f45ec9d3134 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sun, 13 Dec 2020 15:47:38 -0600 Subject: [PATCH 02/46] Remove some debug prints. --- lib/fst4_decode.f90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index ccf6d9662..c1ef0ed26 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -93,20 +93,16 @@ contains if(first) then ! read the fst4_calls.txt file - write(*,*) 'data_dir is:',trim(data_dir) inquire(file=trim(data_dir)//'/fst4w_calls.txt',exist=wcalls_exists) if( wcalls_exists ) then open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') - write(*,*) 'fst4w_calls.txt exists' do i=1,MAXWCALLS wcalls(i)='' read(42,fmt='(a)',end=2867) wcalls(i) wcalls(i)=adjustl(wcalls(i)) if(len(trim(wcalls(i))).eq.0) exit - write(*,*) 'record ',i,':',wcalls(i),':',len(trim(wcalls(i))) enddo 2867 nwcalls=i-1 - write(*,*) 'nwcalls ',nwcalls close(42) endif From 939e35bd2658158a1bdfa351975ddec9a0bd4166 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 14 Dec 2020 10:19:48 -0600 Subject: [PATCH 03/46] More work on K=50 decoding. --- lib/fst4_decode.f90 | 117 +++++++++++++++++++++++--------------------- 1 file changed, 61 insertions(+), 56 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index c1ef0ed26..34f32bf9c 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -68,8 +68,9 @@ contains integer mcq(29),mrrr(19),m73(19),mrr73(19) logical badsync,unpk77_success,single_decode - logical first,nohiscall,lwspr,ex,wcalls_exists,donocrcdecode - logical new_callsign + logical first,nohiscall,lwspr + logical new_callsign,plotspec_exists,wcalls_exists,do_nocrc_decode + logical decdata_exists integer*2 iwave(30*60*12000) @@ -234,15 +235,15 @@ contains if(ndepth.eq.3) then nblock=4 jittermax=2 - donocrcdecode=.true. + do_nocrc_decode=.true. elseif(ndepth.eq.2) then nblock=4 jittermax=2 - donocrcdecode=.false. + do_nocrc_decode=.false. elseif(ndepth.eq.1) then nblock=4 jittermax=0 - donocrcdecode=.false. + do_nocrc_decode=.false. endif ndropmax=1 @@ -479,52 +480,24 @@ contains write(c77,'(77i1)') mod(message101(1:77)+rvec,2) call unpack77(c77,1,msg,unpk77_success) elseif(iwspr.eq.1) then - iaptype=0 - if( donocrcdecode ) then - maxosd=1 - call timer('d240_74 ',0) - Keff=50 - norder=4 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success) then - unpk77_success=.false. - do i=1,nwcalls - if(index(msg,trim(wcalls(i))).gt.0) then - unpk77_success=.true. - iaptype=8 - endif - enddo - endif +! First try decoding with Keff=64 + maxosd=2 + call timer('d240_74 ',0) + Keff=64 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle endif - if(.not. unpk77_success) then - maxosd=2 - call timer('d240_74 ',0) - Keff=64 - norder=3 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(nharderrors.lt.0) cycle - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) - endif - - if(unpk77_success.and.Keff.eq.64) then - + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) + if(unpk77_success) then +! If decode was obtained with Keff=64, save call/grid in fst4w_calls.txt if not there already. i1=index(msg,' ') i2=i1+index(msg(i1+1:),' ') wpart=trim(msg(1:i2)) @@ -545,6 +518,36 @@ contains endif endif endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_nocrc_decode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) +! No CRC in this mode, so only accept the decode if call/grid have been seen before + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo + endif + endif + endif if(nharderrors .ge.0 .and. unpk77_success) then @@ -561,10 +564,10 @@ contains else call get_fst4_tones_from_bits(message74,itone,1) endif - inquire(file='plotspec',exist=ex) + inquire(file='plotspec',exist=plotspec_exists) fmid=-999.0 call timer('dopsprd ',0) - if(ex) then + if(plotspec_exists) then call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & isbest,fc_synced,fmid,w50) endif @@ -586,13 +589,13 @@ contains endif nsnr=nint(xsnr) qual=0.0 - if(iaptype.eq.8) qual=1. fsig=fc_synced - 1.5*baud - if(ex) then + inquire(file='decdata',exist=decdata_exists) + if(decdata_exists) then write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,nsync_qual,nharderrors,dmin, & + ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,6i3,2i4,f6.1,f7.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6.6,6i3,3i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) flush(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & @@ -604,6 +607,7 @@ contains enddo ! istart jitter 800 enddo !candidate list enddo ! noise blanker loop + if(new_callsign) then ! re-write the fst4w_calls.txt file open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') do i=1,nwcalls @@ -611,6 +615,7 @@ contains enddo close(42) endif + 900 return end subroutine decode From 2960adc5572b2c32fdb3a57694bf06ab5ef9ac39 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 14 Dec 2020 16:25:37 -0600 Subject: [PATCH 04/46] FST4W: Use K=66 for first OSD decode attempt and for updating fst4w_calls.txt. Use K=50 for 2nd attempt. --- lib/fst4_decode.f90 | 49 ++++++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 34f32bf9c..d4cb47a8b 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -69,7 +69,7 @@ contains logical badsync,unpk77_success,single_decode logical first,nohiscall,lwspr - logical new_callsign,plotspec_exists,wcalls_exists,do_nocrc_decode + logical new_callsign,plotspec_exists,wcalls_exists,do_k50_decode logical decdata_exists integer*2 iwave(30*60*12000) @@ -232,18 +232,19 @@ contains allocate( cframe(0:160*nss-1) ) jittermax=2 + do_k50_decode=.false. if(ndepth.eq.3) then nblock=4 jittermax=2 - do_nocrc_decode=.true. + do_k50_decode=.true. elseif(ndepth.eq.2) then nblock=4 jittermax=2 - do_nocrc_decode=.false. + do_k50_decode=.false. elseif(ndepth.eq.1) then nblock=4 jittermax=0 - do_nocrc_decode=.false. + do_k50_decode=.false. endif ndropmax=1 @@ -480,10 +481,10 @@ contains write(c77,'(77i1)') mod(message101(1:77)+rvec,2) call unpack77(c77,1,msg,unpk77_success) elseif(iwspr.eq.1) then -! First try decoding with Keff=64 +! Try decoding with Keff=66 maxosd=2 call timer('d240_74 ',0) - Keff=64 + Keff=66 norder=3 call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & ntype,nharderrors,dmin) @@ -496,25 +497,27 @@ contains write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success) then -! If decode was obtained with Keff=64, save call/grid in fst4w_calls.txt if not there already. + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. i1=index(msg,' ') i2=i1+index(msg(i1+1:),' ') wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo - ifound=0 - do i=1,nwcalls - if(index(wcalls(i),wpart).ne.0) ifound=1 - enddo - - if(ifound.eq.0) then ! This is a new callsign - new_callsign=.true. - if(nwcalls.lt.MAXWCALLS) then - nwcalls=nwcalls+1 - wcalls(nwcalls)=wpart - else - wcalls(1:nwcalls-1)=wcalls(2:nwcalls) - wcalls(nwcalls)=wpart + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif endif endif endif @@ -522,7 +525,7 @@ contains ! If no decode then try Keff=50 iaptype=0 - if( .not. unpk77_success .and. do_nocrc_decode ) then + if( .not. unpk77_success .and. do_k50_decode ) then maxosd=1 call timer('d240_74 ',0) Keff=50 @@ -608,7 +611,7 @@ contains 800 enddo !candidate list enddo ! noise blanker loop - if(new_callsign) then ! re-write the fst4w_calls.txt file + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') do i=1,nwcalls write(42,'(a20)') trim(wcalls(i)) From 187868513401ce49ef74cb41b1b431313abe2437 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 09:46:16 -0600 Subject: [PATCH 05/46] If file decdata is present in the data directory, then write detailed decoder data to file fst4_decodes.dat in the same directory. --- lib/fst4_decode.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index d4cb47a8b..d95f6d04d 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -593,13 +593,14 @@ contains nsnr=nint(xsnr) qual=0.0 fsig=fc_synced - 1.5*baud - inquire(file='decdata',exist=decdata_exists) + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) if(decdata_exists) then + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown') write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & sync,xsnr,xdt,fsig,w50,trim(msg) 3021 format(i6.6,6i3,3i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) - flush(21) + close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & iaptype,qual,ntrperiod,lwspr,fmid,w50) From 1e5578b7046376dd15df471d57a73b2a9235d17a Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 09:52:50 -0600 Subject: [PATCH 06/46] Do not save c2 files in FST4W mode. --- widgets/mainwindow.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index 8075f6b52..d8e80d6bd 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -1609,7 +1609,7 @@ void MainWindow::dataSink(qint64 frames) m_saveWAVWatcher.setFuture (QtConcurrent::run (std::bind (&MainWindow::save_wave_file, this, m_fnameWE, &dec_data.d2[0], samples, m_config.my_callsign(), m_config.my_grid(), m_mode, m_nSubMode, m_freqNominal, m_hisCall, m_hisGrid))); - if (m_mode=="WSPR" or m_mode=="FST4W") { + if (m_mode=="WSPR") { QString c2name_string {m_fnameWE + ".c2"}; int len1=c2name_string.length(); char c2name[80]; From c87926e657d9e2f0becda815f89a5102acf91333 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 10:32:57 -0600 Subject: [PATCH 07/46] Append decoder data to file fst4_decodes.dat instead of overwriting. --- lib/fst4_decode.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index d95f6d04d..3407e41f2 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -595,7 +595,7 @@ contains fsig=fc_synced - 1.5*baud inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) if(decdata_exists) then - open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown') + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & sync,xsnr,xdt,fsig,w50,trim(msg) From 17195680ee673f3c7cbc5868f9562226d66fa1fb Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 14:31:46 -0600 Subject: [PATCH 08/46] Don't waste time on excess BP iterations when doing K=50. Decode a little deeper. --- lib/fst4/decode240_74.f90 | 5 +++++ lib/fst4/fastosd240_74.f90 | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lib/fst4/decode240_74.f90 b/lib/fst4/decode240_74.f90 index 20a83362f..f5aac2e10 100644 --- a/lib/fst4/decode240_74.f90 +++ b/lib/fst4/decode240_74.f90 @@ -25,6 +25,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder include "ldpc_240_74_parity.f90" maxiterations=30 + if(Keff.eq.50) maxiterations=1 + nosd=0 if(maxosd.gt.3) maxosd=3 if(maxosd.eq.0) then ! osd with channel llrs @@ -36,6 +38,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder nosd=0 endif + if(maxosd.eq.0) goto 73 + toc=0 tov=0 tanhtoc=0 @@ -133,6 +137,7 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder enddo ! bp iterations +73 continue do i=1,nosd zn=zsave(:,i) ! call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) diff --git a/lib/fst4/fastosd240_74.f90 b/lib/fst4/fastosd240_74.f90 index 03ae4071c..f4bb61d60 100644 --- a/lib/fst4/fastosd240_74.f90 +++ b/lib/fst4/fastosd240_74.f90 @@ -181,8 +181,8 @@ subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) nsyncmax=11 elseif(ndeep.eq.4) then nord=4 - xlambda=3.5 - nsyndmax=11 + xlambda=3.4 + nsyndmax=12 endif s1=sum(absrx(1:k)) From dd631699da4a6eef8d7cf5ecc0969bc1d1e8051e Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Mon, 21 Dec 2020 01:31:57 +0000 Subject: [PATCH 09/46] Add the Tx message to the UDP Status(1) message Thanks to Morgan (sri no other attribution given) for the initial contribution this change is based on. --- Network/MessageClient.cpp | 8 +++++--- Network/MessageClient.hpp | 3 ++- Network/NetworkMessage.hpp | 4 +++- UDPExamples/ClientWidget.cpp | 8 +++++--- UDPExamples/ClientWidget.hpp | 3 ++- UDPExamples/MessageServer.cpp | 7 +++++-- UDPExamples/MessageServer.hpp | 2 +- UDPExamples/UDPDaemon.cpp | 2 +- widgets/mainwindow.cpp | 12 ++++++++++-- 9 files changed, 34 insertions(+), 15 deletions(-) diff --git a/Network/MessageClient.cpp b/Network/MessageClient.cpp index 45d47f9b6..4374e8dc1 100644 --- a/Network/MessageClient.cpp +++ b/Network/MessageClient.cpp @@ -569,7 +569,8 @@ void MessageClient::status_update (Frequency f, QString const& mode, QString con , bool watchdog_timeout, QString const& sub_mode , bool fast_mode, quint8 special_op_mode , quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name) + , QString const& configuration_name + , QString const& tx_message) { if (m_->server_port_ && !m_->server_.isNull ()) { @@ -578,8 +579,9 @@ void MessageClient::status_update (Frequency f, QString const& mode, QString con out << f << mode.toUtf8 () << dx_call.toUtf8 () << report.toUtf8 () << tx_mode.toUtf8 () << tx_enabled << transmitting << decoding << rx_df << tx_df << de_call.toUtf8 () << de_grid.toUtf8 () << dx_grid.toUtf8 () << watchdog_timeout << sub_mode.toUtf8 () - << fast_mode << special_op_mode << frequency_tolerance << tr_period << configuration_name.toUtf8 (); - TRACE_UDP ("frequency:" << f << "mode:" << mode << "DX:" << dx_call << "report:" << report << "Tx mode:" << tx_mode << "tx_enabled:" << tx_enabled << "Tx:" << transmitting << "decoding:" << decoding << "Rx df:" << rx_df << "Tx df:" << tx_df << "DE:" << de_call << "DE grid:" << de_grid << "DX grid:" << dx_grid << "w/d t/o:" << watchdog_timeout << "sub_mode:" << sub_mode << "fast mode:" << fast_mode << "spec op mode:" << special_op_mode << "frequency tolerance:" << frequency_tolerance << "T/R period:" << tr_period << "configuration name:" << configuration_name); + << fast_mode << special_op_mode << frequency_tolerance << tr_period << configuration_name.toUtf8 () + << tx_message.toUtf8 (); + TRACE_UDP ("frequency:" << f << "mode:" << mode << "DX:" << dx_call << "report:" << report << "Tx mode:" << tx_mode << "tx_enabled:" << tx_enabled << "Tx:" << transmitting << "decoding:" << decoding << "Rx df:" << rx_df << "Tx df:" << tx_df << "DE:" << de_call << "DE grid:" << de_grid << "DX grid:" << dx_grid << "w/d t/o:" << watchdog_timeout << "sub_mode:" << sub_mode << "fast mode:" << fast_mode << "spec op mode:" << special_op_mode << "frequency tolerance:" << frequency_tolerance << "T/R period:" << tr_period << "configuration name:" << configuration_name << "Tx message:" << tx_message); m_->send_message (out, message); } } diff --git a/Network/MessageClient.hpp b/Network/MessageClient.hpp index cc348be2d..3f21a598a 100644 --- a/Network/MessageClient.hpp +++ b/Network/MessageClient.hpp @@ -63,7 +63,8 @@ public: , quint32 rx_df, quint32 tx_df, QString const& de_call, QString const& de_grid , QString const& dx_grid, bool watchdog_timeout, QString const& sub_mode , bool fast_mode, quint8 special_op_mode, quint32 frequency_tolerance - , quint32 tr_period, QString const& configuration_name); + , quint32 tr_period, QString const& configuration_name + , QString const& tx_message); Q_SLOT void decode (bool is_new, QTime time, qint32 snr, float delta_time, quint32 delta_frequency , QString const& mode, QString const& message, bool low_confidence , bool off_air); diff --git a/Network/NetworkMessage.hpp b/Network/NetworkMessage.hpp index f892eda06..61aaf7038 100644 --- a/Network/NetworkMessage.hpp +++ b/Network/NetworkMessage.hpp @@ -160,6 +160,7 @@ * Frequency Tolerance quint32 * T/R Period quint32 * Configuration Name utf8 + * Tx Message utf8 * * WSJT-X sends this status message when various internal state * changes to allow the server to track the relevant state of each @@ -183,7 +184,8 @@ * when the Tx watchdog is set or reset, * when the frequency tolerance is changed, * when the T/R period is changed, - * when the configuration name changes. + * when the configuration name changes, + * when the message being transmitted changes. * * The Special operation mode is an enumeration that indicates the * setting selected in the WSJT-X "Settings->Advanced->Special diff --git a/UDPExamples/ClientWidget.cpp b/UDPExamples/ClientWidget.cpp index 75930b7e5..b82836f04 100644 --- a/UDPExamples/ClientWidget.cpp +++ b/UDPExamples/ClientWidget.cpp @@ -147,6 +147,7 @@ ClientWidget::ClientWidget (QAbstractItemModel * decodes_model, QAbstractItemMod , mode_line_edit_ {new QLineEdit {this}} , frequency_tolerance_spin_box_ {new QSpinBox {this}} , tx_mode_label_ {new QLabel {this}} + , tx_message_label_ {new QLabel {this}} , submode_line_edit_ {new QLineEdit {this}} , fast_mode_check_box_ {new QCheckBox {this}} , tr_period_spin_box_ {new QSpinBox {this}} @@ -302,6 +303,7 @@ ClientWidget::ClientWidget (QAbstractItemModel * decodes_model, QAbstractItemMod // set up status area status_bar_->addPermanentWidget (de_label_); status_bar_->addPermanentWidget (tx_mode_label_); + status_bar_->addPermanentWidget (tx_message_label_); status_bar_->addPermanentWidget (frequency_label_); status_bar_->addPermanentWidget (tx_df_label_); status_bar_->addPermanentWidget (report_label_); @@ -400,7 +402,7 @@ void ClientWidget::update_status (ClientKey const& key, Frequency f, QString con , QString const& de_call, QString const& de_grid, QString const& dx_grid , bool watchdog_timeout, QString const& submode, bool fast_mode , quint8 special_op_mode, quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name) + , QString const& configuration_name, QString const& tx_message) { if (key == key_) { @@ -427,8 +429,8 @@ void ClientWidget::update_status (ClientKey const& key, Frequency f, QString con update_spin_box (frequency_tolerance_spin_box_, frequency_tolerance , quint32_max == frequency_tolerance ? QString {"n/a"} : QString {}); update_line_edit (submode_line_edit_, submode, false); - tx_mode_label_->setText (QString {"Tx Mode: %1"} - .arg (tx_mode.isEmpty () || tx_mode == mode ? "" : '(' + tx_mode + ')')); + tx_mode_label_->setText (tx_mode.isEmpty () || tx_mode == mode ? "" : "Tx Mode: (" + tx_mode + ')'); + tx_message_label_->setText (tx_message.isEmpty () ? "" : "Tx Msg: " + tx_message.trimmed ()); frequency_label_->setText ("QRG: " + Radio::pretty_frequency_MHz_string (f)); update_line_edit (dx_call_line_edit_, dx_call); update_line_edit (dx_grid_line_edit_, dx_grid); diff --git a/UDPExamples/ClientWidget.hpp b/UDPExamples/ClientWidget.hpp index ee91d084a..fb0ef47f4 100644 --- a/UDPExamples/ClientWidget.hpp +++ b/UDPExamples/ClientWidget.hpp @@ -52,7 +52,7 @@ public: , QString const& de_call, QString const& de_grid, QString const& dx_grid , bool watchdog_timeout, QString const& sub_mode, bool fast_mode , quint8 special_op_mode, quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name); + , QString const& configuration_name, QString const& tx_message); Q_SLOT void decode_added (bool is_new, ClientKey const& key, QTime, qint32 snr , float delta_time, quint32 delta_frequency, QString const& mode , QString const& message, bool low_confidence, bool off_air); @@ -122,6 +122,7 @@ private: QLineEdit * mode_line_edit_; QSpinBox * frequency_tolerance_spin_box_; QLabel * tx_mode_label_; + QLabel * tx_message_label_; QLineEdit * submode_line_edit_; QCheckBox * fast_mode_check_box_; QSpinBox * tr_period_spin_box_; diff --git a/UDPExamples/MessageServer.cpp b/UDPExamples/MessageServer.cpp index 8aadd08a6..74090395b 100644 --- a/UDPExamples/MessageServer.cpp +++ b/UDPExamples/MessageServer.cpp @@ -243,9 +243,11 @@ void MessageServer::impl::parse_message (QHostAddress const& sender, port_type s quint32 frequency_tolerance {quint32_max}; quint32 tr_period {quint32_max}; QByteArray configuration_name; + QByteArray tx_message; in >> f >> mode >> dx_call >> report >> tx_mode >> tx_enabled >> transmitting >> decoding >> rx_df >> tx_df >> de_call >> de_grid >> dx_grid >> watchdog_timeout >> sub_mode - >> fast_mode >> special_op_mode >> frequency_tolerance >> tr_period >> configuration_name; + >> fast_mode >> special_op_mode >> frequency_tolerance >> tr_period >> configuration_name + >> tx_message; if (check_status (in) != Fail) { Q_EMIT self_->status_update (client_key, f, QString::fromUtf8 (mode) @@ -256,7 +258,8 @@ void MessageServer::impl::parse_message (QHostAddress const& sender, port_type s , QString::fromUtf8 (dx_grid), watchdog_timeout , QString::fromUtf8 (sub_mode), fast_mode , special_op_mode, frequency_tolerance, tr_period - , QString::fromUtf8 (configuration_name)); + , QString::fromUtf8 (configuration_name) + , QString::fromUtf8 (tx_message)); } } break; diff --git a/UDPExamples/MessageServer.hpp b/UDPExamples/MessageServer.hpp index 7cf5653a0..c18cc95fd 100644 --- a/UDPExamples/MessageServer.hpp +++ b/UDPExamples/MessageServer.hpp @@ -97,7 +97,7 @@ public: , QString const& de_call, QString const& de_grid, QString const& dx_grid , bool watchdog_timeout, QString const& sub_mode, bool fast_mode , quint8 special_op_mode, quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name); + , QString const& configuration_name, QString const& tx_message); Q_SIGNAL void client_closed (ClientKey const&); Q_SIGNAL void decode (bool is_new, ClientKey const&, QTime time, qint32 snr, float delta_time , quint32 delta_frequency, QString const& mode, QString const& message diff --git a/UDPExamples/UDPDaemon.cpp b/UDPExamples/UDPDaemon.cpp index 2d028f074..1d3a7abef 100644 --- a/UDPExamples/UDPDaemon.cpp +++ b/UDPExamples/UDPDaemon.cpp @@ -59,7 +59,7 @@ public: , QString const& /*de_call*/, QString const& /*de_grid*/, QString const& /*dx_grid*/ , bool /* watchdog_timeout */, QString const& sub_mode, bool /*fast_mode*/ , quint8 /*special_op_mode*/, quint32 /*frequency_tolerance*/, quint32 /*tr_period*/ - , QString const& /*configuration_name*/) + , QString const& /*configuration_name*/, QString const& /*tx_message*/) { if (key == key_) { diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index a24065d60..f7517079d 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -4135,7 +4135,14 @@ void MainWindow::guiUpdate() } } - m_currentMessage = QString::fromLatin1(msgsent); + { + auto temp = m_currentMessage; + m_currentMessage = QString::fromLatin1(msgsent); + if (m_currentMessage != temp) // check if tx message changed + { + statusUpdate (); + } + } m_bCallingCQ = CALLING == m_QSOProgress || m_currentMessage.contains (QRegularExpression {"^(CQ|QRZ) "}); if(m_mode=="FT8" or m_mode=="FT4") { @@ -8398,7 +8405,8 @@ void MainWindow::statusUpdate () const m_hisGrid, m_tx_watchdog, submode != QChar::Null ? QString {submode} : QString {}, m_bFastMode, static_cast (m_config.special_op_id ()), - ftol, tr_period, m_multi_settings->configuration_name ()); + ftol, tr_period, m_multi_settings->configuration_name (), + m_currentMessage); } void MainWindow::childEvent (QChildEvent * e) From 938d96fecc4bed0928947602d5da3b0c92fc12ec Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Tue, 22 Dec 2020 03:48:35 +0000 Subject: [PATCH 10/46] Save sub-mode details to .WAV file metadata for Q65 mode --- widgets/mainwindow.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index f347318e0..75d24590a 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -1671,7 +1671,7 @@ QString MainWindow::save_wave_file (QString const& name, short const * data, int auto comment = QString {"Mode=%1%2; Freq=%3%4"} .arg (mode) .arg (QString {(mode.contains ('J') && !mode.contains ('+')) - || mode.startsWith ("FST4") || mode.startsWith ("QRA") + || mode.startsWith ("FST4") || mode.startsWith ('Q') ? QString {"; Sub Mode="} + QString::number (int (samples / 12000)) + QChar {'A' + sub_mode} : QString {}}) .arg (Radio::frequency_MHz_string (frequency)) From 71ed4776f9baf91e411454190d4350f888295a55 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 22 Dec 2020 12:33:24 -0600 Subject: [PATCH 11/46] For fst4sim, use Lorentzian fading spectrum when fspread is negative. --- lib/fst4/fst4sim.f90 | 3 ++- lib/fst4/lorentzian_fading.f90 | 43 ++++++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 1 deletion(-) create mode 100644 lib/fst4/lorentzian_fading.f90 diff --git a/lib/fst4/fst4sim.f90 b/lib/fst4/fst4sim.f90 index 5b8f33bc3..e42bbbb02 100644 --- a/lib/fst4/fst4sim.f90 +++ b/lib/fst4/fst4sim.f90 @@ -118,7 +118,8 @@ program fst4sim do ifile=1,nfiles c=c0 - if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread) + if(fspread.gt.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread) + if(fspread.lt.0.0) call lorentzian_fading(c,nwave,fs,-fspread) c=sig*c wave=real(c) if(snrdb.lt.90) then diff --git a/lib/fst4/lorentzian_fading.f90 b/lib/fst4/lorentzian_fading.f90 new file mode 100644 index 000000000..c1bd5c325 --- /dev/null +++ b/lib/fst4/lorentzian_fading.f90 @@ -0,0 +1,43 @@ +subroutine lorentzian_fading(c,npts,fs,fspread) +! +! npts is the total length of the simulated data vector +! + complex c(0:npts-1) + complex cspread(0:npts-1) + complex z + + twopi=8.0*atan(1.0) + df=fs/npts + nh=npts/2 + cspread(0)=1.0 + cspread(nh)=0. + b=6.0 + do i=1,nh + f=i*df + x=b*f/fspread + z=0. + a=0. + if(x.lt.3.0) then + a=sqrt(1.111/(1.0+x*x)-0.1) + phi1=twopi*rran() + z=a*cmplx(cos(phi1),sin(phi1)) + endif + cspread(i)=z + z=0. + if(x.lt.3.0) then + phi2=twopi*rran() + z=a*cmplx(cos(phi2),sin(phi2)) + endif + cspread(npts-i)=z + enddo + + call four2a(cspread,npts,1,1,1) + + s=sum(abs(cspread)**2) + avep=s/npts + fac=sqrt(1.0/avep) + cspread=fac*cspread + c=cspread*c + + return +end subroutine lorentzian_fading From 318a0abda7c7693d3a757d803b767de79cda2e53 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 22 Dec 2020 12:34:12 -0600 Subject: [PATCH 12/46] Forgot to commit CMakeLists.txt change. --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2ab9a20b0..71e1adfd2 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -462,6 +462,7 @@ set (wsjt_FSRCS lib/jtmsg.f90 lib/libration.f90 lib/lorentzian.f90 + lib/fst4/lorentzian_fading.f90 lib/lpf1.f90 lib/mixlpf.f90 lib/makepings.f90 From c6e42549c483706e6e11a30d387b298fa9e91fac Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 22 Dec 2020 13:12:58 -0600 Subject: [PATCH 13/46] Remove hmod from command line parameters for fst4sim. --- lib/fst4/fst4sim.f90 | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/lib/fst4/fst4sim.f90 b/lib/fst4/fst4sim.f90 index e42bbbb02..83ac5baed 100644 --- a/lib/fst4/fst4sim.f90 +++ b/lib/fst4/fst4sim.f90 @@ -19,10 +19,10 @@ program fst4sim ! Get command-line argument(s) nargs=iargc() - if(nargs.ne.10) then - print*,'Need 10 arguments, got ',nargs - print*,'Usage: fst4sim "message" TRsec f0 DT h fdop del nfiles snr W' - print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15 F' + if(nargs.ne.9) then + print*,'Need 9 arguments, got ',nargs + print*,'Usage: fst4sim "message" TRsec f0 DT fdop del nfiles snr W' + print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 0.1 1.0 10 -15 F' print*,'W (T or F) argument is hint to encoder to use WSPR message when there is abiguity' go to 999 endif @@ -34,16 +34,14 @@ program fst4sim call getarg(4,arg) read(arg,*) xdt !Time offset from nominal (s) call getarg(5,arg) - read(arg,*) hmod !Modulation index, h - call getarg(6,arg) read(arg,*) fspread !Watterson frequency spread (Hz) - call getarg(7,arg) + call getarg(6,arg) read(arg,*) delay !Watterson delay (ms) - call getarg(8,arg) + call getarg(7,arg) read(arg,*) nfiles !Number of files - call getarg(9,arg) + call getarg(8,arg) read(arg,*) snrdb !SNR_2500 - call getarg(10,arg) + call getarg(9,arg) read(arg,*) wspr_hint !0:break ties as 77-bit 1:break ties as 50-bit nfiles=abs(nfiles) @@ -89,8 +87,8 @@ program fst4sim call genfst4(msg37,0,msgsent37,msgbits,itone,iwspr) write(*,*) write(*,'(a9,a37,a3,L2,a7,i2)') 'Message: ',msgsent37,'W:',wspr_hint,' iwspr:',iwspr - write(*,1000) f00,xdt,hmod,txt,snrdb -1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',i6,' TxT:',f6.1,' SNR:',f6.1) + write(*,1000) f00,xdt,txt,snrdb +1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1) write(*,*) if(i3.eq.1) then write(*,*) ' mycall hiscall hisgrid' @@ -106,7 +104,8 @@ program fst4sim ! call sgran() - fsample=12000.0 + fsample=12000.0 + hmod=1 icmplx=1 f0=f00+1.5*hmod*baud call gen_fst4wave(itone,NN,nsps,nwave,fsample,hmod,f0,icmplx,c0,wave) From b26d29dd1e2579da1c98cbb4184614f6a041da7f Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Wed, 23 Dec 2020 11:45:13 -0600 Subject: [PATCH 14/46] Avoid a possible of bounds error. Compute some more decode diagnostic data. --- lib/fst4_decode.f90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 3407e41f2..a1b39f744 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -59,7 +59,7 @@ contains integer itone(NN) integer hmod integer ipct(0:7) - integer*1 apmask(240),cw(240) + integer*1 apmask(240),cw(240),hdec(240) integer*1 message101(101),message74(74),message77(77) integer*1 rvec(77) integer apbits(240) @@ -392,8 +392,9 @@ contains if(ijitter.eq.1) ioffset=1 if(ijitter.eq.2) ioffset=-1 is0=isbest+ioffset - if(is0.lt.0) cycle - cframe=c2(is0:is0+160*nss-1) + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) bitmetrics=0 call timer('bitmetrc',0) call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & @@ -408,10 +409,10 @@ contains llrs(181:240,il)=bitmetrics(245:304, il) enddo - apmag=maxval(abs(llrs(:,1)))*1.1 + apmag=maxval(abs(llrs(:,4)))*1.1 ntmax=nblock+nappasses(nQSOProgress) if(lapcqonly) ntmax=nblock+1 - if(ndepth.eq.1) ntmax=nblock + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 apmask=0 if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding @@ -595,11 +596,15 @@ contains fsig=fc_synced - 1.5*baud inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & + ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,6i3,3i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6.6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & From 27bf7bb9640283064dd0dcab055248e5152457a3 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Fri, 25 Dec 2020 12:22:25 -0600 Subject: [PATCH 15/46] FT8: Fix jt9 crash when nagain is invoked. --- lib/ft8/get_spectrum_baseline.f90 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/lib/ft8/get_spectrum_baseline.f90 b/lib/ft8/get_spectrum_baseline.f90 index 9cf4e637c..f815eba14 100644 --- a/lib/ft8/get_spectrum_baseline.f90 +++ b/lib/ft8/get_spectrum_baseline.f90 @@ -35,8 +35,19 @@ subroutine get_spectrum_baseline(dd,nfa,nfb,sbase) savg=savg + s(1:NH1,j) !Average spectrum enddo - if(nfa.lt.100) nfa=100 - if(nfb.gt.4910) nfb=4910 + nwin=nfb-nfa + if(nfa.lt.100) then + nfa=100 + if(nwin.lt.100) then ! nagain + nfb=nfa+nwin + endif + endif + if(nfb.gt.4910) then + nfb=4910 + if(nwin.lt.100) then + nfa=nfb-nwin + endif + endif call baseline(savg,nfa,nfb,sbase) return From 1ba788ecc31df727a284c0a4304d26b4aeec3762 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Fri, 25 Dec 2020 12:31:02 -0600 Subject: [PATCH 16/46] FT8: Commit the rest of the fix for the nagain crash. --- lib/ft8_decode.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index 26b12d6c9..a7a467a31 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -132,8 +132,8 @@ contains ifa=nfa ifb=nfb if(nagain) then - ifa=nfqso-10 - ifb=nfqso+10 + ifa=nfqso-20 + ifb=nfqso+20 endif ! For now: From d8be8ff0e596e9a7c5442a637aa197c1b5c5caf2 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 26 Dec 2020 09:46:19 -0600 Subject: [PATCH 17/46] FT8: Make nagain work. --- lib/ft8_decode.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index a7a467a31..73d0f8c2a 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -118,7 +118,7 @@ contains dd1=dd go to 900 endif - if(nzhsym.eq.50 .and. ndec_early.ge.1) then + if(nzhsym.eq.50 .and. ndec_early.ge.1 .and. .not.nagain) then n=47*3456 dd(1:n)=dd1(1:n) dd(n+1:)=iwave(n+1:) @@ -131,7 +131,8 @@ contains endif ifa=nfa ifb=nfb - if(nagain) then + if(nzhsym.eq.50 .and. nagain) then + dd=iwave ifa=nfqso-20 ifb=nfqso+20 endif From 4e706092234e8c7e15a6cf6dce443d43c456f4fd Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 28 Dec 2020 09:27:48 -0600 Subject: [PATCH 18/46] Minor format change for nutc in fst4_decodes.dat. --- lib/fst4_decode.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index a1b39f744..0e306abe2 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -604,7 +604,7 @@ contains write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & From a3638c456adb11fce5c567673a49e1660d8717d9 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 28 Dec 2020 09:39:08 -0600 Subject: [PATCH 19/46] Minor formatting change in fst4_decodes.dat. --- lib/fst4_decode.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 0e306abe2..d3ecd371b 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -604,7 +604,7 @@ contains write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6.6,i4,5i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & From a38ec853a43532be17ab7dfff821c10a7de96516 Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Wed, 30 Dec 2020 21:45:57 +0000 Subject: [PATCH 20/46] Don't pick up reports to other stations as ours --- widgets/mainwindow.cpp | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index f7517079d..39cb8b479 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -3571,7 +3571,16 @@ void MainWindow::readFromStdout() //readFromStdout decodedtext.deCallAndGrid(/*out*/deCall,grid); { auto t = Radio::base_callsign (ui->dxCallEntry->text ()); - if ((t == deCall || ui->dxCallEntry->text () == deCall || !t.size ()) && rpt.size ()) m_rptRcvd = rpt; + auto const& dx_call = decodedtext.call (); + if (rpt.size () // report in message + && (m_baseCall == Radio::base_callsign (dx_call) // for us + || "DE" == dx_call) // probably for us + && (t == deCall // DX station base call is QSO partner + || ui->dxCallEntry->text () == deCall // DX station full call is QSO partner + || !t.size ())) // not in QSO + { + m_rptRcvd = rpt; + } } // extract details and send to PSKreporter int nsec=QDateTime::currentMSecsSinceEpoch()/1000-m_secBandChanged; From ebb6e5b69771770a683eed6d8bf4f0e866630d9c Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 2 Jan 2021 10:09:44 -0600 Subject: [PATCH 21/46] Fix a conflict between noise baseline percentile level and noise blanker percentage. Both were using the npct variable. Add an option for an FST4 pass when in FST4W mode. --- lib/fst4_decode.f90 | 681 +++++++++++++++++++++++--------------------- 1 file changed, 354 insertions(+), 327 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index d3ecd371b..9a1aa0f16 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -43,6 +43,7 @@ contains procedure(fst4_decode_callback) :: callback character*37 decodes(100) character*37 msg,msgsent + character*8 s_nfa_nfb character*20 wcalls(MAXWCALLS), wpart character*77 c77 character*12 mycall,hiscall @@ -58,7 +59,6 @@ contains logical lagain,lapcqonly integer itone(NN) integer hmod - integer ipct(0:7) integer*1 apmask(240),cw(240),hdec(240) integer*1 message101(101),message74(74),message77(77) integer*1 rvec(77) @@ -74,7 +74,6 @@ contains integer*2 iwave(30*60*12000) - data ipct/0,8,14,4,12,2,10,6/ data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ @@ -247,6 +246,7 @@ contains do_k50_decode=.false. endif +! Noise blanker setup ndropmax=1 single_decode=iand(nexp_decode,32).ne.0 npct=0 @@ -262,278 +262,260 @@ contains inb2=1 !Try NB = 0, 1, 2,... 20% else inb1=0 !Fixed NB value, 0 to 25% - ipct(0)=npct endif - if(iwspr.eq.1) then !FST4W - !300 Hz wide noise-fit window - nfa=max(100,nint(nfqso+1.5*baud-150)) - nfb=min(4800,nint(nfqso+1.5*baud+150)) - fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window - fb=min(4800,nint(nfqso+1.5*baud+ntol)) - else if(single_decode) then - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) - else - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) +! If environment variable FST4W_ALSO_FST4 exists then, when in FST4W mode, +! do a second pass for FST4 decodes. The value of FST4W_ALSO_FST4 +! is of the form xxxxyyyy where nfa=xxxx and nfb=yyyy are the +! search limits for the FST4 decoding pass, e.g. +! FST4W_ALSO_FST4=08001700 will set FST4 search window to [800Hz,1700Hz] +! + nmode=1 + call get_environment_variable("FST4W_ALSO_FST4",s_nfa_nfb,nlength) + if(iwspr.eq.1 .and. nlength.eq.8) then + read(s_nfa_nfb,"(i4.4,i4.4)") nfa_mode2,nfb_mode2 + nmode=2 endif - ndecodes=0 - decodes=' ' - new_callsign=.false. - do inb=0,inb1,inb2 - if(nb.lt.0) npct=inb - call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) + do imode=1,nmode + if(imode.eq.1) iwspr=1 + if(imode.eq.2) then ! this is FST4 after a FST4W pass + iwspr=0 + nfa=nfa_mode2 + nfb=nfb_mode2 + endif + +! nfa,nfb: define the noise-baseline analysis window +! fa, fb: define the signal search window +! We usually make nfafb so that noise baseline analysis +! window extends outside of the [fa,fb] window where we think the signals are. +! + if(iwspr.eq.1) then !FST4W + nfa=max(100,nfqso-ntol-100) + nfb=min(4800,nfqso+ntol+100) + fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window + fb=min(4800,nint(nfqso+1.5*baud+ntol)) + else if(iwspr.eq.0) then + if(imode.eq.1 .and. single_decode) then + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + else + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + endif + endif + + ndecodes=0 + decodes=' ' + new_callsign=.false. + do inb=0,inb1,inb2 + if(nb.lt.0) npct=inb ! we are looping over blanker settings + call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) ! The big fft is done once and is used for calculating the smoothed spectrum ! and also for downconverting/downsampling each candidate. - call four2a(c_bigfft,nfft1,1,-1,0) !r2c - nhicoh=1 - nsyncoh=8 - minsync=1.20 - if(ntrperiod.eq.15) minsync=1.15 + call four2a(c_bigfft,nfft1,1,-1,0) !r2c + nhicoh=1 + nsyncoh=8 + minsync=1.20 + if(ntrperiod.eq.15) minsync=1.15 ! Get first approximation of candidate frequencies - call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & - minsync,ncand,candidates0) - isbest=0 - fc2=0. - do icand=1,ncand - fc0=candidates0(icand,1) - if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & - abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle - detmet=candidates0(icand,2) + call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & + minsync,ncand,candidates0) + isbest=0 + fc2=0. + do icand=1,ncand + fc0=candidates0(icand,1) + if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso + detmet=candidates0(icand,2) ! Downconvert and downsample a slice of the spectrum centered on the ! rough estimate of the candidates frequency. ! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. ! The size of the downsampled c2 array is nfft2=nfft1/ndown + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) + call timer('dwnsmpl ',1) - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) - call timer('dwnsmpl ',1) + call timer('sync240 ',0) + call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) + call timer('sync240 ',1) - call timer('sync240 ',0) - call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) - call timer('sync240 ',1) - - fc_synced = fc0 + fcbest - dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 - candidates0(icand,3)=fc_synced - candidates0(icand,4)=isbest - enddo + fc_synced = fc0 + fcbest + dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 + candidates0(icand,3)=fc_synced + candidates0(icand,4)=isbest + enddo ! remove duplicate candidates - do icand=1,ncand - fc=candidates0(icand,3) - isbest=nint(candidates0(icand,4)) - do ic2=icand+1,ncand - fc2=candidates0(ic2,3) - isbest2=nint(candidates0(ic2,4)) - if(fc2.gt.0.0) then - if(abs(fc2-fc).lt.0.10*baud) then ! same frequency - if(abs(isbest2-isbest).le.2) then - candidates0(ic2,3)=-1 - endif - endif - endif - enddo - enddo - ic=0 - do icand=1,ncand - if(candidates0(icand,3).gt.0) then - ic=ic+1 - candidates0(ic,:)=candidates0(icand,:) - endif - enddo - ncand=ic - -! If FST4 and Single Decode is not checked, then find candidates within -! 20 Hz of nfqso and put them at the top of the list - if(iwspr.eq.0 .and. .not.single_decode) then - nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) - k=0 - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - else - candidates=candidates0 - endif - - xsnr=0. - do icand=1,ncand - sync=candidates(icand,2) - fc_synced=candidates(icand,3) - isbest=nint(candidates(icand,4)) - xdt=(isbest-nspsec)/fs2 - if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) - call timer('dwnsmpl ',1) - - do ijitter=0,jittermax - if(ijitter.eq.0) ioffset=0 - if(ijitter.eq.1) ioffset=1 - if(ijitter.eq.2) ioffset=-1 - is0=isbest+ioffset - iend=is0+160*nss-1 - if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle - cframe=c2(is0:iend) - bitmetrics=0 - call timer('bitmetrc',0) - call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & - s4,nsync_qual,badsync) - call timer('bitmetrc',1) - if(badsync) cycle - - do il=1,4 - llrs( 1: 60,il)=bitmetrics( 17: 76, il) - llrs( 61:120,il)=bitmetrics( 93:152, il) - llrs(121:180,il)=bitmetrics(169:228, il) - llrs(181:240,il)=bitmetrics(245:304, il) - enddo - - apmag=maxval(abs(llrs(:,4)))*1.1 - ntmax=nblock+nappasses(nQSOProgress) - if(lapcqonly) ntmax=nblock+1 - if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 - apmask=0 - - if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding - nblock=4 - ntmax=nblock - endif - - do itry=1,ntmax - if(itry.eq.1) llr=llrs(:,1) - if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) - if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) - if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) - if(itry.le.nblock) then - apmask=0 - iaptype=0 - endif - - if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes - llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes - iaptype=naptypes(nQSOProgress,itry-nblock) - if(lapcqonly) iaptype=1 - if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall - if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall - if(iaptype.eq.1) then ! CQ - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*mcq(1:29) - endif - - if(iaptype.eq.2) then ! MyCall ??? ??? - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*apbits(1:29) - endif - - if(iaptype.eq.3) then ! MyCall DxCall ??? - apmask=0 - apmask(1:58)=1 - llr(1:58)=apmag*apbits(1:58) - endif - - if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then - apmask=0 - apmask(1:77)=1 - llr(1:58)=apmag*apbits(1:58) - if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) - if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) - if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) - endif - endif - - dmin=0.0 - nharderrors=-1 - unpk77_success=.false. - if(iwspr.eq.0) then - maxosd=2 - Keff=91 - norder=3 - call timer('d240_101',0) - call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & - cw,ntype,nharderrors,dmin) - call timer('d240_101',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(77i1)') mod(message101(1:77)+rvec,2) - call unpack77(c77,1,msg,unpk77_success) - elseif(iwspr.eq.1) then -! Try decoding with Keff=66 - maxosd=2 - call timer('d240_74 ',0) - Keff=66 - norder=3 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(nharderrors.lt.0) goto 3465 - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success .and. do_k50_decode) then -! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. - i1=index(msg,' ') - i2=i1+index(msg(i1+1:),' ') - wpart=trim(msg(1:i2)) -! Only save callsigns/grids from type 1 messages - if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then - ifound=0 - do i=1,nwcalls - if(index(wcalls(i),wpart).ne.0) ifound=1 - enddo - - if(ifound.eq.0) then ! This is a new callsign - new_callsign=.true. - if(nwcalls.lt.MAXWCALLS) then - nwcalls=nwcalls+1 - wcalls(nwcalls)=wpart - else - wcalls(1:nwcalls-1)=wcalls(2:nwcalls) - wcalls(nwcalls)=wpart - endif - endif + do icand=1,ncand + fc=candidates0(icand,3) + isbest=nint(candidates0(icand,4)) + do ic2=icand+1,ncand + fc2=candidates0(ic2,3) + isbest2=nint(candidates0(ic2,4)) + if(fc2.gt.0.0) then + if(abs(fc2-fc).lt.0.10*baud) then ! same frequency + if(abs(isbest2-isbest).le.2) then + candidates0(ic2,3)=-1 endif endif -3465 continue + endif + enddo + enddo + ic=0 + do icand=1,ncand + if(candidates0(icand,3).gt.0) then + ic=ic+1 + candidates0(ic,:)=candidates0(icand,:) + endif + enddo + ncand=ic -! If no decode then try Keff=50 - iaptype=0 - if( .not. unpk77_success .and. do_k50_decode ) then - maxosd=1 +! If FST4 mode and Single Decode is not checked, then find candidates +! within 20 Hz of nfqso and put them at the top of the list + if(iwspr.eq.0 .and. .not.single_decode) then + nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) + k=0 + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + else + candidates=candidates0 + endif + + xsnr=0. + do icand=1,ncand + sync=candidates(icand,2) + fc_synced=candidates(icand,3) + isbest=nint(candidates(icand,4)) + xdt=(isbest-nspsec)/fs2 + if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) + call timer('dwnsmpl ',1) + + do ijitter=0,jittermax + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=1 + if(ijitter.eq.2) ioffset=-1 + is0=isbest+ioffset + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) + bitmetrics=0 + call timer('bitmetrc',0) + call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & + s4,nsync_qual,badsync) + call timer('bitmetrc',1) + if(badsync) cycle + + do il=1,4 + llrs( 1: 60,il)=bitmetrics( 17: 76, il) + llrs( 61:120,il)=bitmetrics( 93:152, il) + llrs(121:180,il)=bitmetrics(169:228, il) + llrs(181:240,il)=bitmetrics(245:304, il) + enddo + + apmag=maxval(abs(llrs(:,4)))*1.1 + ntmax=nblock+nappasses(nQSOProgress) + if(lapcqonly) ntmax=nblock+1 + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 + apmask=0 + + if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding + nblock=4 + ntmax=nblock + endif + + do itry=1,ntmax + if(itry.eq.1) llr=llrs(:,1) + if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) + if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) + if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) + if(itry.le.nblock) then + apmask=0 + iaptype=0 + endif + + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes + llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes + iaptype=naptypes(nQSOProgress,itry-nblock) + if(lapcqonly) iaptype=1 + if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall + if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall + if(iaptype.eq.1) then ! CQ + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*mcq(1:29) + endif + + if(iaptype.eq.2) then ! MyCall ??? ??? + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*apbits(1:29) + endif + + if(iaptype.eq.3) then ! MyCall DxCall ??? + apmask=0 + apmask(1:58)=1 + llr(1:58)=apmag*apbits(1:58) + endif + + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then + apmask=0 + apmask(1:77)=1 + llr(1:58)=apmag*apbits(1:58) + if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) + if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) + if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) + endif + endif + + dmin=0.0 + nharderrors=-1 + unpk77_success=.false. + if(iwspr.eq.0) then + maxosd=2 + Keff=91 + norder=3 + call timer('d240_101',0) + call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & + cw,ntype,nharderrors,dmin) + call timer('d240_101',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then +! Try decoding with Keff=66 + maxosd=2 call timer('d240_74 ',0) - Keff=50 - norder=4 + Keff=66 + norder=3 call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & ntype,nharderrors,dmin) call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 if(count(cw.eq.1).eq.0) then nharderrors=-nharderrors cycle @@ -541,89 +523,134 @@ contains write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) -! No CRC in this mode, so only accept the decode if call/grid have been seen before - if(unpk77_success) then - unpk77_success=.false. - do i=1,nwcalls - if(index(msg,trim(wcalls(i))).gt.0) then - unpk77_success=.true. + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif endif - enddo + endif endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_k50_decode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) +! No CRC in this mode, so only accept the decode if call/grid have been seen before + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo + endif + endif + endif - endif + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg - if(nharderrors .ge.0 .and. unpk77_success) then - idupe=0 - do i=1,ndecodes - if(decodes(i).eq.msg) idupe=1 - enddo - if(idupe.eq.1) goto 800 - ndecodes=ndecodes+1 - decodes(ndecodes)=msg + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) + else + call get_fst4_tones_from_bits(message74,itone,1) + endif + inquire(file='plotspec',exist=plotspec_exists) + fmid=-999.0 + call timer('dopsprd ',0) + if(plotspec_exists) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + arg=600.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) + if(ntrperiod.eq. 15) xsnr=xsnr+2 + if(ntrperiod.eq. 30) xsnr=xsnr+1 + if(ntrperiod.eq. 900) xsnr=xsnr+1 + if(ntrperiod.eq.1800) xsnr=xsnr+2 + else + xsnr=-99.9 + endif + nsnr=nint(xsnr) + qual=0.0 + fsig=fc_synced - 1.5*baud + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) + if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') + write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & + ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & + sync,xsnr,xdt,fsig,w50,trim(msg) +3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) + close(21) + endif + call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & + iaptype,qual,ntrperiod,lwspr,fmid,w50) + if(iwspr.eq.0 .and. nb.lt.0 .and. imode.eq.1) go to 900 + goto 800 + endif + enddo ! metrics + enddo ! istart jitter +800 enddo !candidate list + enddo ! noise blanker loop - if(iwspr.eq.0) then - call get_fst4_tones_from_bits(message101,itone,0) - else - call get_fst4_tones_from_bits(message74,itone,1) - endif - inquire(file='plotspec',exist=plotspec_exists) - fmid=-999.0 - call timer('dopsprd ',0) - if(plotspec_exists) then - call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & - isbest,fc_synced,fmid,w50) - endif - call timer('dopsprd ',1) - xsig=0 - do i=1,NN - xsig=xsig+s4(itone(i),i) - enddo - base=candidates(icand,5) - arg=600.0*(xsig/base)-1.0 - if(arg.gt.0.0) then - xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) - if(ntrperiod.eq. 15) xsnr=xsnr+2 - if(ntrperiod.eq. 30) xsnr=xsnr+1 - if(ntrperiod.eq. 900) xsnr=xsnr+1 - if(ntrperiod.eq.1800) xsnr=xsnr+2 - else - xsnr=-99.9 - endif - nsnr=nint(xsnr) - qual=0.0 - fsig=fc_synced - 1.5*baud - inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) - if(decdata_exists) then - hdec=0 - where(llrs(:,1).ge.0.0) hdec=1 - nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols - hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols - open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') - write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & - sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,i4,5i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) - close(21) - endif - call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & - iaptype,qual,ntrperiod,lwspr,fmid,w50) - if(iwspr.eq.0 .and. nb.lt.0) go to 900 - goto 800 - endif - enddo ! metrics - enddo ! istart jitter -800 enddo !candidate list - enddo ! noise blanker loop + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif - if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file - open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') - do i=1,nwcalls - write(42,'(a20)') trim(wcalls(i)) - enddo - close(42) - endif + enddo ! mode loop 900 return end subroutine decode @@ -818,8 +845,8 @@ contains do i=ina,inb !Compute CCF of s() and 4 tones s2(i)=s(i-hmod*3) + s(i-hmod) +s(i+hmod) +s(i+hmod*3) enddo - npct=30 - call fst4_baseline(s2,nnw,ina+hmod*3,inb-hmod*3,npct,sbase) + npctile=30 + call fst4_baseline(s2,nnw,ina+hmod*3,inb-hmod*3,npctile,sbase) if(any(sbase(ina:inb).le.0.0)) return s2(ina:inb)=s2(ina:inb)/sbase(ina:inb) !Normalize wrt noise level From 41258a5ddc2661f218176abe6e6276a6e3864ad0 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 2 Jan 2021 10:25:29 -0600 Subject: [PATCH 22/46] Add rudimentary sanity checks to the values parsed from FST4W_ALSO_FST4. --- lib/fst4_decode.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 9a1aa0f16..9b066e61f 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -275,6 +275,7 @@ contains if(iwspr.eq.1 .and. nlength.eq.8) then read(s_nfa_nfb,"(i4.4,i4.4)") nfa_mode2,nfb_mode2 nmode=2 + if(nfa_mode2.lt.100 .or. nfb_mode2.gt.4910 .or. nfb_mode2.le.nfa_mode2) nmode=1 endif do imode=1,nmode From e2c2228d365c7daed5f43f6428eebba2b5317cd2 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 2 Jan 2021 11:37:16 -0600 Subject: [PATCH 23/46] Remove some debug code. --- lib/fst4_decode.f90 | 638 +++++++++++++++++++++----------------------- 1 file changed, 307 insertions(+), 331 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 9b066e61f..5fb591ffa 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -43,7 +43,6 @@ contains procedure(fst4_decode_callback) :: callback character*37 decodes(100) character*37 msg,msgsent - character*8 s_nfa_nfb character*20 wcalls(MAXWCALLS), wpart character*77 c77 character*12 mycall,hiscall @@ -264,259 +263,281 @@ contains inb1=0 !Fixed NB value, 0 to 25% endif -! If environment variable FST4W_ALSO_FST4 exists then, when in FST4W mode, -! do a second pass for FST4 decodes. The value of FST4W_ALSO_FST4 -! is of the form xxxxyyyy where nfa=xxxx and nfb=yyyy are the -! search limits for the FST4 decoding pass, e.g. -! FST4W_ALSO_FST4=08001700 will set FST4 search window to [800Hz,1700Hz] -! - nmode=1 - call get_environment_variable("FST4W_ALSO_FST4",s_nfa_nfb,nlength) - if(iwspr.eq.1 .and. nlength.eq.8) then - read(s_nfa_nfb,"(i4.4,i4.4)") nfa_mode2,nfb_mode2 - nmode=2 - if(nfa_mode2.lt.100 .or. nfb_mode2.gt.4910 .or. nfb_mode2.le.nfa_mode2) nmode=1 - endif - - do imode=1,nmode - if(imode.eq.1) iwspr=1 - if(imode.eq.2) then ! this is FST4 after a FST4W pass - iwspr=0 - nfa=nfa_mode2 - nfb=nfb_mode2 - endif ! nfa,nfb: define the noise-baseline analysis window ! fa, fb: define the signal search window ! We usually make nfafb so that noise baseline analysis ! window extends outside of the [fa,fb] window where we think the signals are. ! - if(iwspr.eq.1) then !FST4W - nfa=max(100,nfqso-ntol-100) - nfb=min(4800,nfqso+ntol+100) - fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window - fb=min(4800,nint(nfqso+1.5*baud+ntol)) - else if(iwspr.eq.0) then - if(imode.eq.1 .and. single_decode) then - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) - else - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) - endif + if(iwspr.eq.1) then !FST4W + nfa=max(100,nfqso-ntol-100) + nfb=min(4800,nfqso+ntol+100) + fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window + fb=min(4800,nint(nfqso+1.5*baud+ntol)) + else if(iwspr.eq.0) then + if(single_decode) then + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + else + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) endif + endif - ndecodes=0 - decodes=' ' - new_callsign=.false. - do inb=0,inb1,inb2 - if(nb.lt.0) npct=inb ! we are looping over blanker settings - call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) + ndecodes=0 + decodes=' ' + new_callsign=.false. + do inb=0,inb1,inb2 + if(nb.lt.0) npct=inb ! we are looping over blanker settings + call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) ! The big fft is done once and is used for calculating the smoothed spectrum ! and also for downconverting/downsampling each candidate. - call four2a(c_bigfft,nfft1,1,-1,0) !r2c - nhicoh=1 - nsyncoh=8 - minsync=1.20 - if(ntrperiod.eq.15) minsync=1.15 + call four2a(c_bigfft,nfft1,1,-1,0) !r2c + nhicoh=1 + nsyncoh=8 + minsync=1.20 + if(ntrperiod.eq.15) minsync=1.15 ! Get first approximation of candidate frequencies - call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & - minsync,ncand,candidates0) - isbest=0 - fc2=0. - do icand=1,ncand - fc0=candidates0(icand,1) - if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & - abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso - detmet=candidates0(icand,2) + call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & + minsync,ncand,candidates0) + isbest=0 + fc2=0. + do icand=1,ncand + fc0=candidates0(icand,1) + if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso + detmet=candidates0(icand,2) ! Downconvert and downsample a slice of the spectrum centered on the ! rough estimate of the candidates frequency. ! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. ! The size of the downsampled c2 array is nfft2=nfft1/ndown - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) - call timer('dwnsmpl ',1) + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) + call timer('dwnsmpl ',1) - call timer('sync240 ',0) - call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) - call timer('sync240 ',1) + call timer('sync240 ',0) + call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) + call timer('sync240 ',1) - fc_synced = fc0 + fcbest - dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 - candidates0(icand,3)=fc_synced - candidates0(icand,4)=isbest - enddo + fc_synced = fc0 + fcbest + dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 + candidates0(icand,3)=fc_synced + candidates0(icand,4)=isbest + enddo ! remove duplicate candidates - do icand=1,ncand - fc=candidates0(icand,3) - isbest=nint(candidates0(icand,4)) - do ic2=icand+1,ncand - fc2=candidates0(ic2,3) - isbest2=nint(candidates0(ic2,4)) - if(fc2.gt.0.0) then - if(abs(fc2-fc).lt.0.10*baud) then ! same frequency - if(abs(isbest2-isbest).le.2) then - candidates0(ic2,3)=-1 - endif + do icand=1,ncand + fc=candidates0(icand,3) + isbest=nint(candidates0(icand,4)) + do ic2=icand+1,ncand + fc2=candidates0(ic2,3) + isbest2=nint(candidates0(ic2,4)) + if(fc2.gt.0.0) then + if(abs(fc2-fc).lt.0.10*baud) then ! same frequency + if(abs(isbest2-isbest).le.2) then + candidates0(ic2,3)=-1 endif endif - enddo - enddo - ic=0 - do icand=1,ncand - if(candidates0(icand,3).gt.0) then - ic=ic+1 - candidates0(ic,:)=candidates0(icand,:) endif enddo - ncand=ic - -! If FST4 mode and Single Decode is not checked, then find candidates -! within 20 Hz of nfqso and put them at the top of the list - if(iwspr.eq.0 .and. .not.single_decode) then - nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) - k=0 - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - else - candidates=candidates0 + enddo + ic=0 + do icand=1,ncand + if(candidates0(icand,3).gt.0) then + ic=ic+1 + candidates0(ic,:)=candidates0(icand,:) endif + enddo + ncand=ic - xsnr=0. - do icand=1,ncand - sync=candidates(icand,2) - fc_synced=candidates(icand,3) - isbest=nint(candidates(icand,4)) - xdt=(isbest-nspsec)/fs2 - if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) - call timer('dwnsmpl ',1) +! If FST4 mode and Single Decode is not checked, then find candidates +! within 20 Hz of nfqso and put them at the top of the list + if(iwspr.eq.0 .and. .not.single_decode) then + nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) + k=0 + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + else + candidates=candidates0 + endif - do ijitter=0,jittermax - if(ijitter.eq.0) ioffset=0 - if(ijitter.eq.1) ioffset=1 - if(ijitter.eq.2) ioffset=-1 - is0=isbest+ioffset - iend=is0+160*nss-1 - if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle - cframe=c2(is0:iend) - bitmetrics=0 - call timer('bitmetrc',0) - call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & - s4,nsync_qual,badsync) - call timer('bitmetrc',1) - if(badsync) cycle + xsnr=0. + do icand=1,ncand + sync=candidates(icand,2) + fc_synced=candidates(icand,3) + isbest=nint(candidates(icand,4)) + xdt=(isbest-nspsec)/fs2 + if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) + call timer('dwnsmpl ',1) - do il=1,4 - llrs( 1: 60,il)=bitmetrics( 17: 76, il) - llrs( 61:120,il)=bitmetrics( 93:152, il) - llrs(121:180,il)=bitmetrics(169:228, il) - llrs(181:240,il)=bitmetrics(245:304, il) - enddo + do ijitter=0,jittermax + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=1 + if(ijitter.eq.2) ioffset=-1 + is0=isbest+ioffset + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) + bitmetrics=0 + call timer('bitmetrc',0) + call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & + s4,nsync_qual,badsync) + call timer('bitmetrc',1) + if(badsync) cycle - apmag=maxval(abs(llrs(:,4)))*1.1 - ntmax=nblock+nappasses(nQSOProgress) - if(lapcqonly) ntmax=nblock+1 - if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 - apmask=0 + do il=1,4 + llrs( 1: 60,il)=bitmetrics( 17: 76, il) + llrs( 61:120,il)=bitmetrics( 93:152, il) + llrs(121:180,il)=bitmetrics(169:228, il) + llrs(181:240,il)=bitmetrics(245:304, il) + enddo - if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding - nblock=4 - ntmax=nblock + apmag=maxval(abs(llrs(:,4)))*1.1 + ntmax=nblock+nappasses(nQSOProgress) + if(lapcqonly) ntmax=nblock+1 + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 + apmask=0 + + if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding + nblock=4 + ntmax=nblock + endif + + do itry=1,ntmax + if(itry.eq.1) llr=llrs(:,1) + if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) + if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) + if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) + if(itry.le.nblock) then + apmask=0 + iaptype=0 endif - do itry=1,ntmax - if(itry.eq.1) llr=llrs(:,1) - if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) - if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) - if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) - if(itry.le.nblock) then + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes + llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes + iaptype=naptypes(nQSOProgress,itry-nblock) + if(lapcqonly) iaptype=1 + if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall + if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall + if(iaptype.eq.1) then ! CQ apmask=0 - iaptype=0 + apmask(1:29)=1 + llr(1:29)=apmag*mcq(1:29) endif - if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes - llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes - iaptype=naptypes(nQSOProgress,itry-nblock) - if(lapcqonly) iaptype=1 - if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall - if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall - if(iaptype.eq.1) then ! CQ - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*mcq(1:29) - endif - - if(iaptype.eq.2) then ! MyCall ??? ??? - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*apbits(1:29) - endif - - if(iaptype.eq.3) then ! MyCall DxCall ??? - apmask=0 - apmask(1:58)=1 - llr(1:58)=apmag*apbits(1:58) - endif - - if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then - apmask=0 - apmask(1:77)=1 - llr(1:58)=apmag*apbits(1:58) - if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) - if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) - if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) - endif + if(iaptype.eq.2) then ! MyCall ??? ??? + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*apbits(1:29) endif - dmin=0.0 - nharderrors=-1 - unpk77_success=.false. - if(iwspr.eq.0) then - maxosd=2 - Keff=91 - norder=3 - call timer('d240_101',0) - call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & - cw,ntype,nharderrors,dmin) - call timer('d240_101',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(77i1)') mod(message101(1:77)+rvec,2) - call unpack77(c77,1,msg,unpk77_success) - elseif(iwspr.eq.1) then + if(iaptype.eq.3) then ! MyCall DxCall ??? + apmask=0 + apmask(1:58)=1 + llr(1:58)=apmag*apbits(1:58) + endif + + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then + apmask=0 + apmask(1:77)=1 + llr(1:58)=apmag*apbits(1:58) + if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) + if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) + if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) + endif + endif + + dmin=0.0 + nharderrors=-1 + unpk77_success=.false. + if(iwspr.eq.0) then + maxosd=2 + Keff=91 + norder=3 + call timer('d240_101',0) + call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & + cw,ntype,nharderrors,dmin) + call timer('d240_101',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then ! Try decoding with Keff=66 - maxosd=2 + maxosd=2 + call timer('d240_74 ',0) + Keff=66 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif + endif + endif + endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_k50_decode ) then + maxosd=1 call timer('d240_74 ',0) - Keff=66 - norder=3 + Keff=50 + norder=4 call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & ntype,nharderrors,dmin) call timer('d240_74 ',1) - if(nharderrors.lt.0) goto 3465 if(count(cw.eq.1).eq.0) then nharderrors=-nharderrors cycle @@ -524,134 +545,89 @@ contains write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success .and. do_k50_decode) then -! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. - i1=index(msg,' ') - i2=i1+index(msg(i1+1:),' ') - wpart=trim(msg(1:i2)) -! Only save callsigns/grids from type 1 messages - if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then - ifound=0 - do i=1,nwcalls - if(index(wcalls(i),wpart).ne.0) ifound=1 - enddo - - if(ifound.eq.0) then ! This is a new callsign - new_callsign=.true. - if(nwcalls.lt.MAXWCALLS) then - nwcalls=nwcalls+1 - wcalls(nwcalls)=wpart - else - wcalls(1:nwcalls-1)=wcalls(2:nwcalls) - wcalls(nwcalls)=wpart - endif - endif - endif - endif -3465 continue - -! If no decode then try Keff=50 - iaptype=0 - if( .not. unpk77_success .and. do_k50_decode ) then - maxosd=1 - call timer('d240_74 ',0) - Keff=50 - norder=4 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) ! No CRC in this mode, so only accept the decode if call/grid have been seen before - if(unpk77_success) then - unpk77_success=.false. - do i=1,nwcalls - if(index(msg,trim(wcalls(i))).gt.0) then - unpk77_success=.true. - endif - enddo - endif + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo endif - endif - if(nharderrors .ge.0 .and. unpk77_success) then - idupe=0 - do i=1,ndecodes - if(decodes(i).eq.msg) idupe=1 - enddo - if(idupe.eq.1) goto 800 - ndecodes=ndecodes+1 - decodes(ndecodes)=msg + endif - if(iwspr.eq.0) then - call get_fst4_tones_from_bits(message101,itone,0) - else - call get_fst4_tones_from_bits(message74,itone,1) - endif - inquire(file='plotspec',exist=plotspec_exists) - fmid=-999.0 - call timer('dopsprd ',0) - if(plotspec_exists) then - call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & - isbest,fc_synced,fmid,w50) - endif - call timer('dopsprd ',1) - xsig=0 - do i=1,NN - xsig=xsig+s4(itone(i),i) - enddo - base=candidates(icand,5) - arg=600.0*(xsig/base)-1.0 - if(arg.gt.0.0) then - xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) - if(ntrperiod.eq. 15) xsnr=xsnr+2 - if(ntrperiod.eq. 30) xsnr=xsnr+1 - if(ntrperiod.eq. 900) xsnr=xsnr+1 - if(ntrperiod.eq.1800) xsnr=xsnr+2 - else - xsnr=-99.9 - endif - nsnr=nint(xsnr) - qual=0.0 - fsig=fc_synced - 1.5*baud - inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) - if(decdata_exists) then - hdec=0 - where(llrs(:,1).ge.0.0) hdec=1 - nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols - hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols - open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') - write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & - sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) - close(21) - endif - call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & - iaptype,qual,ntrperiod,lwspr,fmid,w50) - if(iwspr.eq.0 .and. nb.lt.0 .and. imode.eq.1) go to 900 - goto 800 + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) + else + call get_fst4_tones_from_bits(message74,itone,1) endif - enddo ! metrics - enddo ! istart jitter -800 enddo !candidate list - enddo ! noise blanker loop + inquire(file='plotspec',exist=plotspec_exists) + fmid=-999.0 + call timer('dopsprd ',0) + if(plotspec_exists) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + arg=600.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) + if(ntrperiod.eq. 15) xsnr=xsnr+2 + if(ntrperiod.eq. 30) xsnr=xsnr+1 + if(ntrperiod.eq. 900) xsnr=xsnr+1 + if(ntrperiod.eq.1800) xsnr=xsnr+2 + else + xsnr=-99.9 + endif + nsnr=nint(xsnr) + qual=0.0 + fsig=fc_synced - 1.5*baud + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) + if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') + write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & + ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & + sync,xsnr,xdt,fsig,w50,trim(msg) +3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) + close(21) + endif + call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & + iaptype,qual,ntrperiod,lwspr,fmid,w50) + if(iwspr.eq.0 .and. nb.lt.0) go to 900 + goto 800 + endif + enddo ! metrics + enddo ! istart jitter +800 enddo !candidate list + enddo ! noise blanker loop - if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file - open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') - do i=1,nwcalls - write(42,'(a20)') trim(wcalls(i)) - enddo - close(42) - endif - - enddo ! mode loop + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif 900 return end subroutine decode From e4a7591a835d672a052655fb0ba48951799b54f7 Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Sat, 2 Jan 2021 18:02:09 +0000 Subject: [PATCH 24/46] Make the colour highlighting scheme immune to style sheet overrides --- widgets/colorhighlighting.cpp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/widgets/colorhighlighting.cpp b/widgets/colorhighlighting.cpp index 6ad0bd4da..e7e9deddb 100644 --- a/widgets/colorhighlighting.cpp +++ b/widgets/colorhighlighting.cpp @@ -1,7 +1,7 @@ #include "colorhighlighting.h" #include -#include +#include #include "SettingsGroup.hpp" #include "models/DecodeHighlightingModel.hpp" @@ -113,16 +113,16 @@ void ColorHighlighting::set_items (DecodeHighlightingModel const& highlighting_m default: continue; } - auto palette = example->parentWidget ()->palette (); + auto style_sheet = example->parentWidget ()->styleSheet (); if (Qt::NoBrush != item.background_.style ()) { - palette.setColor (QPalette::Window, item.background_.color ()); + style_sheet += QString {"; background-color: #%1"}.arg (item.background_.color ().rgb (), 8, 16, QLatin1Char {'0'}); } if (Qt::NoBrush != item.foreground_.style ()) { - palette.setColor (QPalette::WindowText, item.foreground_.color ()); + style_sheet += QString {"; color: #%1"}.arg (item.foreground_.color ().rgb (), 8, 16, QLatin1Char {'0'}); } - example->setPalette (palette); + example->setStyleSheet (style_sheet); example->setEnabled (item.enabled_); label->setText (DecodeHighlightingModel::highlight_name (item.type_)); label->setEnabled (item.enabled_); From b0b16033a8c4a4735f634d99d8e90bda355c807e Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Sat, 2 Jan 2021 21:12:45 +0000 Subject: [PATCH 25/46] Updated Danish UI translation, tnx Michael, 5P1KZX --- translations/wsjtx_da.ts | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/translations/wsjtx_da.ts b/translations/wsjtx_da.ts index bb7744752..ecb74c401 100644 --- a/translations/wsjtx_da.ts +++ b/translations/wsjtx_da.ts @@ -247,7 +247,7 @@ <html><head/><body><p>Right-click here for available actions.</p></body></html> - <html><head/><body> <p> Højreklik her for tilgængelige muligheder. </p> </body> </html> + <html><head/><body><p> Højreklik her for tilgængelige muligheder.</p></body></html> @@ -318,7 +318,7 @@ New Call - Ny kaldesignal + Nyt kaldesignal @@ -2197,7 +2197,7 @@ Fejl(%2): %3 &Decode - &Dekod + &Dekode @@ -2492,7 +2492,7 @@ Gul er for lavt Fast - Fast + Hurtig @@ -5578,7 +5578,7 @@ Fejl(%2): %3 Monitor returns to last used frequency - Montor til seneste brugte frekvens + Monitor til seneste brugte frekvens @@ -5673,7 +5673,7 @@ den stille periode, når dekodningen er udført. Serial Port Parameters - Seriek Port Parametre + Seriel Port Parametre @@ -5774,7 +5774,7 @@ den stille periode, når dekodningen er udført. Default - Deafult + Default From 11b7aa9429751e28713f9218de23e21b5820ea64 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sun, 13 Dec 2020 15:33:12 -0600 Subject: [PATCH 26/46] Implements decoding of FST4W messages as (240,50) crc-less codewords. By cascading the full 24-bit crc generator matrix with the (240,74) LDPC code generator, create a (240,50) generator that is used to decode with approximately 1 dB better sensitivity than the (240,64) with 14-bit CRC approach that is normally used. This approach treats the CRC bits as additional parity bits and provides no means for identifying incorrect codewords. All codewords on the list generated by the OSD algorithm have CRCs that match the CRC of the message payload. Codewords are validated by unpacking the message and comparing the unpacked message with the list of stored callsign/grid pairs stored in the fst4w_calls.txt file. --- CMakeLists.txt | 1 + lib/fst4/decode240_74.f90 | 3 +- lib/fst4/fastosd240_74.f90 | 291 +++++++++++++++++++++++++++++++++++++ lib/fst4/ldpcsim240_74.f90 | 2 +- lib/fst4_decode.f90 | 232 +++++++++++++++++++---------- 5 files changed, 452 insertions(+), 77 deletions(-) create mode 100644 lib/fst4/fastosd240_74.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index e9c6db665..1adbcd0ee 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -562,6 +562,7 @@ set (wsjt_FSRCS lib/fst4/ldpcsim240_74.f90 lib/fst4/osd240_101.f90 lib/fst4/osd240_74.f90 + lib/fst4/fastosd240_74.f90 lib/fst4/get_crc24.f90 lib/fst4/fst4_baseline.f90 ) diff --git a/lib/fst4/decode240_74.f90 b/lib/fst4/decode240_74.f90 index be18f6e09..20a83362f 100644 --- a/lib/fst4/decode240_74.f90 +++ b/lib/fst4/decode240_74.f90 @@ -135,7 +135,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder do i=1,nosd zn=zsave(:,i) - call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) +! call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) + call fastosd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) if(nharderror.gt.0) then hdec=0 where(llr .ge. 0) hdec=1 diff --git a/lib/fst4/fastosd240_74.f90 b/lib/fst4/fastosd240_74.f90 new file mode 100644 index 000000000..03ae4071c --- /dev/null +++ b/lib/fst4/fastosd240_74.f90 @@ -0,0 +1,291 @@ +subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) +! +! An ordered-statistics decoder for the (240,74) code. +! Message payload is 50 bits. Any or all of a 24-bit CRC can be +! used for detecting incorrect codewords. The remaining CRC bits are +! cascaded with the LDPC code for the purpose of improving the +! distance spectrum of the code. +! +! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are +! to be used for bad codeword detection, then the argument k should +! be set to 77+p1. +! +! Valid values for k are in the range [50,74]. +! + character*24 c24 + integer, parameter:: N=240 + integer*1 apmask(N),apmaskr(N) + integer*1, allocatable, save :: gen(:,:) + integer*1, allocatable :: genmrb(:,:),g2(:,:) + integer*1, allocatable :: temp(:),temprow(:),m0(:),me(:),mi(:) + integer indices(N),indices2(N),nxor(N) + integer*1 cw(N),ce(N),c0(N),hdec(N) + integer*1, allocatable :: decoded(:) + integer*1 message74(74) + integer*1, allocatable :: sp(:) + integer indx(N),ksave + real llr(N),rx(N),absrx(N) + + logical first + data first/.true./,ksave/64/ + save first,ksave + + allocate( genmrb(k,N), g2(N,k) ) + allocate( temp(k), temprow(n), m0(k), me(k), mi(k) ) + allocate( decoded(k) ) + + if( first .or. k.ne.ksave) then ! fill the generator matrix +! +! Create generator matrix for partial CRC cascaded with LDPC code. +! +! Let p2=74-k and p1+p2=24. +! +! The last p2 bits of the CRC24 are cascaded with the LDPC code. +! +! The first p1=k-50 CRC24 bits will be used for error detection. +! + if( allocated(gen) ) deallocate(gen) + allocate( gen(k,N) ) + gen=0 + do i=1,k + message74=0 + message74(i)=1 + if(i.le.50) then + call get_crc24(message74,74,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') message74(51:74) + message74(51:k)=0 + endif + call encode240_74(message74,cw) + gen(i,:)=cw + enddo + + first=.false. + ksave=k + endif + +! Use best k elements from the sorted list for the first basis. For the 2nd basis replace +! the nswap lowest quality symbols with the best nswap elements from the parity symbols. + nswap=20 + + do ibasis=1,2 + rx=llr + apmaskr=apmask + +! Hard decisions on the received word. + hdec=0 + where(rx .ge. 0) hdec=1 + +! Use magnitude of received symbols as a measure of reliability. + absrx=abs(llr) + call indexx(absrx,N,indx) + +! Re-order the columns of the generator matrix in order of decreasing reliability. + do i=1,N + genmrb(1:k,i)=gen(1:k,indx(N+1-i)) + indices(i)=indx(N+1-i) + enddo + + if(ibasis.eq.2) then + do i=k-nswap+1,k + temp(1:k)=genmrb(1:k,i) + genmrb(1:k,i)=genmrb(1:k,i+nswap) + genmrb(1:k,i+nswap)=temp(1:k) + itmp=indices(i) + indices(i)=indices(i+nswap) + indices(i+nswap)=itmp + enddo + endif + +! Do gaussian elimination to create a generator matrix with the most reliable +! received bits in positions 1:k in order of decreasing reliability (more or less). + + icol=1 + indices2=0 + nskipped=0 + do id=1,k + iflag=0 + do while(iflag.eq.0) + if(genmrb(id,icol).ne.1) then + do j=id+1,k + if(genmrb(j,icol).eq.1) then + temprow=genmrb(id,:) + genmrb(id,:)=genmrb(j,:) + genmrb(j,:)=temprow + iflag=1 + endif + enddo + if(iflag.eq.0) then ! skip this column + nskipped=nskipped+1 + indices2(k+nskipped)=icol ! put icol where skipped columns go + icol=icol+1 ! look at the next column + endif + else + iflag=1 + endif + enddo + indices2(id)=icol + do j=1,k + if(id.ne.j .and. genmrb(j,icol).eq.1) then + genmrb(j,:)=ieor(genmrb(id,:),genmrb(j,:)) + endif + enddo + icol=icol+1 + enddo + do i=k+nskipped+1,240 + indices2(i)=i + enddo + genmrb(1:k,:)=genmrb(1:k,indices2) + indices=indices(indices2) + +!************************************ + g2=transpose(genmrb) + +! The hard decisions for the k MRB bits define the order 0 message, m0. +! Encode m0 using the modified generator matrix to find the "order 0" codeword. +! Flip various combinations of bits in m0 and re-encode to generate a list of +! codewords. Return the member of the list that has the smallest Euclidean +! distance to the received word. + + hdec=hdec(indices) ! hard decisions from received symbols + m0=hdec(1:k) ! zero'th order message + absrx=abs(llr) + absrx=absrx(indices) + rx=rx(indices) + apmaskr=apmaskr(indices) + + call mrbencode74(m0,c0,g2,N,k) + nxor=ieor(c0,hdec) + nhardmin=sum(nxor) + dmin=sum(nxor*absrx) + np=32 + if(ibasis.eq.1) allocate(sp(np)) + + cw=c0 + ntotal=0 + nrejected=0 + + if(ndeep.eq.0) goto 998 ! norder=0 + if(ndeep.gt.4) ndeep=4 + if( ndeep.eq. 1) then + nord=1 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.2) then + nord=2 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.3) then + nord=3 + xlambda=4.0 + nsyncmax=11 + elseif(ndeep.eq.4) then + nord=4 + xlambda=3.5 + nsyndmax=11 + endif + + s1=sum(absrx(1:k)) + s2=sum(absrx(k+1:N)) + rho=s1/(s1+xlambda*s2) + rhodmin=rho*dmin + nerr64=-1 + do iorder=1,nord +!beta=0.0 +!if(iorder.ge.3) beta=0.4 +!spnc_order=sum(absrx(k-iorder+1:k))+beta*(N-k) +!if(dmin.lt.spnc_order) cycle + mi(1:k-iorder)=0 + mi(k-iorder+1:k)=1 + iflag=k-iorder+1 + do while(iflag .ge.0) + ntotal=ntotal+1 + me=ieor(m0,mi) + d1=sum(mi(1:k)*absrx(1:k)) + if(d1.gt.rhodmin) exit + call partial_syndrome(me,sp,np,g2,N,K) + nwhsp=sum(ieor(sp(1:np),hdec(k:k+np-1))) + if(nwhsp.le.nsyndmax) then + call mrbencode74(me,ce,g2,N,k) + nxor=ieor(ce,hdec) + dd=sum(nxor*absrx(1:N)) + if( dd .lt. dmin ) then + dmin=dd + rhodmin=rho*dmin + cw=ce + nhardmin=sum(nxor) + nwhspmin=nwhsp + nerr64=sum(nxor(1:K)) + endif + endif +! Get the next test error pattern, iflag will go negative +! when the last pattern with weight iorder has been generated. + call nextpat74(mi,k,iorder,iflag) + enddo + enddo + +998 continue +! Re-order the codeword to [message bits][parity bits] format. + cw(indices)=cw + hdec(indices)=hdec + message74=cw(1:74) + call get_crc24(message74,74,nbadcrc) + if(nbadcrc.eq.0) exit + nhardmin=-nhardmin + enddo ! basis loop + return +end subroutine fastosd240_74 + +subroutine mrbencode74(me,codeword,g2,N,K) + integer*1 me(K),codeword(N),g2(N,K) +! fast encoding for low-weight test patterns + codeword=0 + do i=1,K + if( me(i) .eq. 1 ) then + codeword=ieor(codeword,g2(1:N,i)) + endif + enddo + return +end subroutine mrbencode74 + +subroutine partial_syndrome(me,sp,np,g2,N,K) + integer*1 me(K),sp(np),g2(N,K) +! compute partial syndrome + sp=0 + do i=1,K + if( me(i) .eq. 1 ) then + sp=ieor(sp,g2(K:K+np-1,i)) + endif + enddo + return +end subroutine partial_syndrome + +subroutine nextpat74(mi,k,iorder,iflag) + integer*1 mi(k),ms(k) +! generate the next test error pattern + ind=-1 + do i=1,k-1 + if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i + enddo + if( ind .lt. 0 ) then ! no more patterns of this order + iflag=ind + return + endif + ms=0 + ms(1:ind-1)=mi(1:ind-1) + ms(ind)=1 + ms(ind+1)=0 + if( ind+1 .lt. k ) then + nz=iorder-sum(ms) + ms(k-nz+1:k)=1 + endif + mi=ms + do i=1,k ! iflag will point to the lowest-index 1 in mi + if(mi(i).eq.1) then + iflag=i + exit + endif + enddo + return +end subroutine nextpat74 + diff --git a/lib/fst4/ldpcsim240_74.f90 b/lib/fst4/ldpcsim240_74.f90 index b488aa6b6..78e8e6b5f 100644 --- a/lib/fst4/ldpcsim240_74.f90 +++ b/lib/fst4/ldpcsim240_74.f90 @@ -101,7 +101,7 @@ write(*,'(24i1)') msgbits(51:74) llr=2.0*rxdata/(ss*ss) apmask=0 dmin=0.0 - maxosd=0 + maxosd=2 call decode240_74(llr, Keff, maxosd, norder, apmask, message74, cw, ntype, nharderror, dmin) if(nharderror.ge.0) then n2err=0 diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index ba49fb54d..ccf6d9662 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -33,15 +33,17 @@ contains ndepth,ntrperiod,nexp_decode,ntol,emedelay,lagain,lapcqonly,mycall, & hiscall,iwspr) + use prog_args use timer_module, only: timer use packjt77 use, intrinsic :: iso_c_binding include 'fst4/fst4_params.f90' - parameter (MAXCAND=100) + parameter (MAXCAND=100,MAXWCALLS=100) class(fst4_decoder), intent(inout) :: this procedure(fst4_decode_callback) :: callback character*37 decodes(100) character*37 msg,msgsent + character*20 wcalls(MAXWCALLS), wpart character*77 c77 character*12 mycall,hiscall character*12 mycall0,hiscall0 @@ -66,7 +68,8 @@ contains integer mcq(29),mrrr(19),m73(19),mrr73(19) logical badsync,unpk77_success,single_decode - logical first,nohiscall,lwspr,ex + logical first,nohiscall,lwspr,ex,wcalls_exists,donocrcdecode + logical new_callsign integer*2 iwave(30*60*12000) @@ -80,6 +83,7 @@ contains 0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/ data first/.true./,hmod/1/ save first,apbits,nappasses,naptypes,mycall0,hiscall0 + save wcalls,nwcalls this%callback => callback dxcall13=hiscall ! initialize for use in packjt77 @@ -88,6 +92,24 @@ contains if(iwspr.ne.0.and.iwspr.ne.1) return if(first) then +! read the fst4_calls.txt file + write(*,*) 'data_dir is:',trim(data_dir) + inquire(file=trim(data_dir)//'/fst4w_calls.txt',exist=wcalls_exists) + if( wcalls_exists ) then + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + write(*,*) 'fst4w_calls.txt exists' + do i=1,MAXWCALLS + wcalls(i)='' + read(42,fmt='(a)',end=2867) wcalls(i) + wcalls(i)=adjustl(wcalls(i)) + if(len(trim(wcalls(i))).eq.0) exit + write(*,*) 'record ',i,':',wcalls(i),':',len(trim(wcalls(i))) + enddo +2867 nwcalls=i-1 + write(*,*) 'nwcalls ',nwcalls + close(42) + endif + mcq=2*mod(mcq+rvec(1:29),2)-1 mrrr=2*mod(mrrr+rvec(59:77),2)-1 m73=2*mod(m73+rvec(59:77),2)-1 @@ -216,12 +238,15 @@ contains if(ndepth.eq.3) then nblock=4 jittermax=2 + donocrcdecode=.true. elseif(ndepth.eq.2) then - nblock=3 - jittermax=0 + nblock=4 + jittermax=2 + donocrcdecode=.false. elseif(ndepth.eq.1) then - nblock=1 + nblock=4 jittermax=0 + donocrcdecode=.false. endif ndropmax=1 @@ -244,7 +269,7 @@ contains if(iwspr.eq.1) then !FST4W !300 Hz wide noise-fit window - nfa=max(100,nint(nfqso+1.5*baud-150)) + nfa=max(100,nint(nfqso+1.5*baud-150)) nfb=min(4800,nint(nfqso+1.5*baud+150)) fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window fb=min(4800,nint(nfqso+1.5*baud+ntol)) @@ -252,18 +277,19 @@ contains fa=max(100,nint(nfa+1.5*baud)) fb=min(4800,nint(nfb+1.5*baud)) ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) + nfa=max(100,nfa-100) nfb=min(4800,nfb+100) else fa=max(100,nint(nfa+1.5*baud)) fb=min(4800,nint(nfb+1.5*baud)) ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) + nfa=max(100,nfa-100) nfb=min(4800,nfb+100) endif - + ndecodes=0 decodes=' ' + new_callsign=.false. do inb=0,inb1,inb2 if(nb.lt.0) npct=inb call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) @@ -275,16 +301,16 @@ contains nsyncoh=8 minsync=1.20 if(ntrperiod.eq.15) minsync=1.15 - + ! Get first approximation of candidate frequencies call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & - minsync,ncand,candidates0) + minsync,ncand,candidates0) isbest=0 fc2=0. do icand=1,ncand fc0=candidates0(icand,1) if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & - abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle detmet=candidates0(icand,2) ! Downconvert and downsample a slice of the spectrum centered on the @@ -330,7 +356,7 @@ contains endif enddo ncand=ic - + ! If FST4 and Single Decode is not checked, then find candidates within ! 20 Hz of nfqso and put them at the top of the list if(iwspr.eq.0 .and. .not.single_decode) then @@ -373,7 +399,7 @@ contains bitmetrics=0 call timer('bitmetrc',0) call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & - s4,nsync_qual,badsync) + s4,nsync_qual,badsync) call timer('bitmetrc',1) if(badsync) cycle @@ -405,7 +431,7 @@ contains iaptype=0 endif - if(itry.gt.nblock) then ! do ap passes + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes iaptype=naptypes(nQSOProgress,itry-nblock) if(lapcqonly) iaptype=1 @@ -428,7 +454,7 @@ contains apmask(1:58)=1 llr(1:58)=apmag*apbits(1:58) endif - + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then apmask=0 apmask(1:77)=1 @@ -438,7 +464,7 @@ contains if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) endif endif - + dmin=0.0 nharderrors=-1 unpk77_success=.false. @@ -448,83 +474,133 @@ contains norder=3 call timer('d240_101',0) call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & - cw,ntype,nharderrors,dmin) + cw,ntype,nharderrors,dmin) call timer('d240_101',1) - elseif(iwspr.eq.1) then - maxosd=2 - call timer('d240_74 ',0) - Keff=64 - norder=4 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - endif - - if(nharderrors .ge.0) then if(count(cw.eq.1).eq.0) then nharderrors=-nharderrors cycle endif - if(iwspr.eq.0) then - write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then + iaptype=0 + if( donocrcdecode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) - else + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + iaptype=8 + endif + enddo + endif + endif + if(.not. unpk77_success) then + maxosd=2 + call timer('d240_74 ',0) + Keff=64 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) cycle + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) endif - if(unpk77_success) then - idupe=0 - do i=1,ndecodes - if(decodes(i).eq.msg) idupe=1 + + if(unpk77_success.and.Keff.eq.64) then + + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) + + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 enddo - if(idupe.eq.1) goto 800 - ndecodes=ndecodes+1 - decodes(ndecodes)=msg - - if(iwspr.eq.0) then - call get_fst4_tones_from_bits(message101,itone,0) - else - call get_fst4_tones_from_bits(message74,itone,1) - endif - inquire(file='plotspec',exist=ex) - fmid=-999.0 - call timer('dopsprd ',0) - if(ex) then - call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & - isbest,fc_synced,fmid,w50) - endif - call timer('dopsprd ',1) - xsig=0 - do i=1,NN - xsig=xsig+s4(itone(i),i) - enddo - base=candidates(icand,5) - arg=600.0*(xsig/base)-1.0 - if(arg.gt.0.0) then - xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) - if(ntrperiod.eq. 15) xsnr=xsnr+2 - if(ntrperiod.eq. 30) xsnr=xsnr+1 - if(ntrperiod.eq. 900) xsnr=xsnr+1 - if(ntrperiod.eq.1800) xsnr=xsnr+2 - else - xsnr=-99.9 + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif endif + endif + endif + + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) else - cycle + call get_fst4_tones_from_bits(message74,itone,1) + endif + inquire(file='plotspec',exist=ex) + fmid=-999.0 + call timer('dopsprd ',0) + if(ex) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + arg=600.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) + if(ntrperiod.eq. 15) xsnr=xsnr+2 + if(ntrperiod.eq. 30) xsnr=xsnr+1 + if(ntrperiod.eq. 900) xsnr=xsnr+1 + if(ntrperiod.eq.1800) xsnr=xsnr+2 + else + xsnr=-99.9 endif nsnr=nint(xsnr) - qual=0. + qual=0.0 + if(iaptype.eq.8) qual=1. fsig=fc_synced - 1.5*baud if(ex) then write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,nsync_qual,nharderrors,dmin, & - sync,xsnr,xdt,fsig,w50,trim(msg) + ijitter,ntype,nsync_qual,nharderrors,dmin, & + sync,xsnr,xdt,fsig,w50,trim(msg) 3021 format(i6.6,6i3,2i4,f6.1,f7.2,f6.1,f6.2,f7.1,f7.3,1x,a) flush(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & - iaptype,qual,ntrperiod,lwspr,fmid,w50) + iaptype,qual,ntrperiod,lwspr,fmid,w50) if(iwspr.eq.0 .and. nb.lt.0) go to 900 goto 800 endif @@ -532,9 +608,15 @@ contains enddo ! istart jitter 800 enddo !candidate list enddo ! noise blanker loop - + if(new_callsign) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif 900 return - end subroutine decode + end subroutine decode subroutine sync_fst4(cd0,i0,f0,hmod,ncoh,np,nss,ntr,fs,sync) @@ -902,6 +984,6 @@ contains enddo return - end subroutine dopspread + end subroutine dopspread end module fst4_decode From 65ff3ce05e554f474813666bd15a8e08a600c9d7 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sun, 13 Dec 2020 15:47:38 -0600 Subject: [PATCH 27/46] Remove some debug prints. --- lib/fst4_decode.f90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index ccf6d9662..c1ef0ed26 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -93,20 +93,16 @@ contains if(first) then ! read the fst4_calls.txt file - write(*,*) 'data_dir is:',trim(data_dir) inquire(file=trim(data_dir)//'/fst4w_calls.txt',exist=wcalls_exists) if( wcalls_exists ) then open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') - write(*,*) 'fst4w_calls.txt exists' do i=1,MAXWCALLS wcalls(i)='' read(42,fmt='(a)',end=2867) wcalls(i) wcalls(i)=adjustl(wcalls(i)) if(len(trim(wcalls(i))).eq.0) exit - write(*,*) 'record ',i,':',wcalls(i),':',len(trim(wcalls(i))) enddo 2867 nwcalls=i-1 - write(*,*) 'nwcalls ',nwcalls close(42) endif From fc3e24f696c882c8ece26fef2b85413835613f76 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 14 Dec 2020 10:19:48 -0600 Subject: [PATCH 28/46] More work on K=50 decoding. --- lib/fst4_decode.f90 | 117 +++++++++++++++++++++++--------------------- 1 file changed, 61 insertions(+), 56 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index c1ef0ed26..34f32bf9c 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -68,8 +68,9 @@ contains integer mcq(29),mrrr(19),m73(19),mrr73(19) logical badsync,unpk77_success,single_decode - logical first,nohiscall,lwspr,ex,wcalls_exists,donocrcdecode - logical new_callsign + logical first,nohiscall,lwspr + logical new_callsign,plotspec_exists,wcalls_exists,do_nocrc_decode + logical decdata_exists integer*2 iwave(30*60*12000) @@ -234,15 +235,15 @@ contains if(ndepth.eq.3) then nblock=4 jittermax=2 - donocrcdecode=.true. + do_nocrc_decode=.true. elseif(ndepth.eq.2) then nblock=4 jittermax=2 - donocrcdecode=.false. + do_nocrc_decode=.false. elseif(ndepth.eq.1) then nblock=4 jittermax=0 - donocrcdecode=.false. + do_nocrc_decode=.false. endif ndropmax=1 @@ -479,52 +480,24 @@ contains write(c77,'(77i1)') mod(message101(1:77)+rvec,2) call unpack77(c77,1,msg,unpk77_success) elseif(iwspr.eq.1) then - iaptype=0 - if( donocrcdecode ) then - maxosd=1 - call timer('d240_74 ',0) - Keff=50 - norder=4 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success) then - unpk77_success=.false. - do i=1,nwcalls - if(index(msg,trim(wcalls(i))).gt.0) then - unpk77_success=.true. - iaptype=8 - endif - enddo - endif +! First try decoding with Keff=64 + maxosd=2 + call timer('d240_74 ',0) + Keff=64 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle endif - if(.not. unpk77_success) then - maxosd=2 - call timer('d240_74 ',0) - Keff=64 - norder=3 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(nharderrors.lt.0) cycle - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) - endif - - if(unpk77_success.and.Keff.eq.64) then - + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) + if(unpk77_success) then +! If decode was obtained with Keff=64, save call/grid in fst4w_calls.txt if not there already. i1=index(msg,' ') i2=i1+index(msg(i1+1:),' ') wpart=trim(msg(1:i2)) @@ -545,6 +518,36 @@ contains endif endif endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_nocrc_decode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) +! No CRC in this mode, so only accept the decode if call/grid have been seen before + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo + endif + endif + endif if(nharderrors .ge.0 .and. unpk77_success) then @@ -561,10 +564,10 @@ contains else call get_fst4_tones_from_bits(message74,itone,1) endif - inquire(file='plotspec',exist=ex) + inquire(file='plotspec',exist=plotspec_exists) fmid=-999.0 call timer('dopsprd ',0) - if(ex) then + if(plotspec_exists) then call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & isbest,fc_synced,fmid,w50) endif @@ -586,13 +589,13 @@ contains endif nsnr=nint(xsnr) qual=0.0 - if(iaptype.eq.8) qual=1. fsig=fc_synced - 1.5*baud - if(ex) then + inquire(file='decdata',exist=decdata_exists) + if(decdata_exists) then write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,nsync_qual,nharderrors,dmin, & + ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,6i3,2i4,f6.1,f7.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6.6,6i3,3i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) flush(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & @@ -604,6 +607,7 @@ contains enddo ! istart jitter 800 enddo !candidate list enddo ! noise blanker loop + if(new_callsign) then ! re-write the fst4w_calls.txt file open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') do i=1,nwcalls @@ -611,6 +615,7 @@ contains enddo close(42) endif + 900 return end subroutine decode From 812bd29e543a33cfced0a1c7482d1363cd478d92 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 14 Dec 2020 16:25:37 -0600 Subject: [PATCH 29/46] FST4W: Use K=66 for first OSD decode attempt and for updating fst4w_calls.txt. Use K=50 for 2nd attempt. --- lib/fst4_decode.f90 | 49 ++++++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 34f32bf9c..d4cb47a8b 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -69,7 +69,7 @@ contains logical badsync,unpk77_success,single_decode logical first,nohiscall,lwspr - logical new_callsign,plotspec_exists,wcalls_exists,do_nocrc_decode + logical new_callsign,plotspec_exists,wcalls_exists,do_k50_decode logical decdata_exists integer*2 iwave(30*60*12000) @@ -232,18 +232,19 @@ contains allocate( cframe(0:160*nss-1) ) jittermax=2 + do_k50_decode=.false. if(ndepth.eq.3) then nblock=4 jittermax=2 - do_nocrc_decode=.true. + do_k50_decode=.true. elseif(ndepth.eq.2) then nblock=4 jittermax=2 - do_nocrc_decode=.false. + do_k50_decode=.false. elseif(ndepth.eq.1) then nblock=4 jittermax=0 - do_nocrc_decode=.false. + do_k50_decode=.false. endif ndropmax=1 @@ -480,10 +481,10 @@ contains write(c77,'(77i1)') mod(message101(1:77)+rvec,2) call unpack77(c77,1,msg,unpk77_success) elseif(iwspr.eq.1) then -! First try decoding with Keff=64 +! Try decoding with Keff=66 maxosd=2 call timer('d240_74 ',0) - Keff=64 + Keff=66 norder=3 call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & ntype,nharderrors,dmin) @@ -496,25 +497,27 @@ contains write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success) then -! If decode was obtained with Keff=64, save call/grid in fst4w_calls.txt if not there already. + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. i1=index(msg,' ') i2=i1+index(msg(i1+1:),' ') wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo - ifound=0 - do i=1,nwcalls - if(index(wcalls(i),wpart).ne.0) ifound=1 - enddo - - if(ifound.eq.0) then ! This is a new callsign - new_callsign=.true. - if(nwcalls.lt.MAXWCALLS) then - nwcalls=nwcalls+1 - wcalls(nwcalls)=wpart - else - wcalls(1:nwcalls-1)=wcalls(2:nwcalls) - wcalls(nwcalls)=wpart + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif endif endif endif @@ -522,7 +525,7 @@ contains ! If no decode then try Keff=50 iaptype=0 - if( .not. unpk77_success .and. do_nocrc_decode ) then + if( .not. unpk77_success .and. do_k50_decode ) then maxosd=1 call timer('d240_74 ',0) Keff=50 @@ -608,7 +611,7 @@ contains 800 enddo !candidate list enddo ! noise blanker loop - if(new_callsign) then ! re-write the fst4w_calls.txt file + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') do i=1,nwcalls write(42,'(a20)') trim(wcalls(i)) From 89cbd177dfd7419eb98e41b53dc3b4a4458d3842 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 09:46:16 -0600 Subject: [PATCH 30/46] If file decdata is present in the data directory, then write detailed decoder data to file fst4_decodes.dat in the same directory. --- lib/fst4_decode.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index d4cb47a8b..d95f6d04d 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -593,13 +593,14 @@ contains nsnr=nint(xsnr) qual=0.0 fsig=fc_synced - 1.5*baud - inquire(file='decdata',exist=decdata_exists) + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) if(decdata_exists) then + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown') write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & sync,xsnr,xdt,fsig,w50,trim(msg) 3021 format(i6.6,6i3,3i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) - flush(21) + close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & iaptype,qual,ntrperiod,lwspr,fmid,w50) From 66ddeff25e5d146110873bf1694c06ec4ba05ab3 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 09:52:50 -0600 Subject: [PATCH 31/46] Do not save c2 files in FST4W mode. --- widgets/mainwindow.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index 39cb8b479..eeb193e39 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -1600,7 +1600,7 @@ void MainWindow::dataSink(qint64 frames) m_saveWAVWatcher.setFuture (QtConcurrent::run (std::bind (&MainWindow::save_wave_file, this, m_fnameWE, &dec_data.d2[0], samples, m_config.my_callsign(), m_config.my_grid(), m_mode, m_nSubMode, m_freqNominal, m_hisCall, m_hisGrid))); - if (m_mode=="WSPR" or m_mode=="FST4W") { + if (m_mode=="WSPR") { QString c2name_string {m_fnameWE + ".c2"}; int len1=c2name_string.length(); char c2name[80]; From 8079d35561fc8cca332737520dcddeee9c1715f2 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 10:32:57 -0600 Subject: [PATCH 32/46] Append decoder data to file fst4_decodes.dat instead of overwriting. --- lib/fst4_decode.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index d95f6d04d..3407e41f2 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -595,7 +595,7 @@ contains fsig=fc_synced - 1.5*baud inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) if(decdata_exists) then - open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown') + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & sync,xsnr,xdt,fsig,w50,trim(msg) From b087328fc16b91c27d4664c212a23126c7a30e49 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 15 Dec 2020 14:31:46 -0600 Subject: [PATCH 33/46] Don't waste time on excess BP iterations when doing K=50. Decode a little deeper. --- lib/fst4/decode240_74.f90 | 5 +++++ lib/fst4/fastosd240_74.f90 | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lib/fst4/decode240_74.f90 b/lib/fst4/decode240_74.f90 index 20a83362f..f5aac2e10 100644 --- a/lib/fst4/decode240_74.f90 +++ b/lib/fst4/decode240_74.f90 @@ -25,6 +25,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder include "ldpc_240_74_parity.f90" maxiterations=30 + if(Keff.eq.50) maxiterations=1 + nosd=0 if(maxosd.gt.3) maxosd=3 if(maxosd.eq.0) then ! osd with channel llrs @@ -36,6 +38,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder nosd=0 endif + if(maxosd.eq.0) goto 73 + toc=0 tov=0 tanhtoc=0 @@ -133,6 +137,7 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder enddo ! bp iterations +73 continue do i=1,nosd zn=zsave(:,i) ! call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) diff --git a/lib/fst4/fastosd240_74.f90 b/lib/fst4/fastosd240_74.f90 index 03ae4071c..f4bb61d60 100644 --- a/lib/fst4/fastosd240_74.f90 +++ b/lib/fst4/fastosd240_74.f90 @@ -181,8 +181,8 @@ subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) nsyncmax=11 elseif(ndeep.eq.4) then nord=4 - xlambda=3.5 - nsyndmax=11 + xlambda=3.4 + nsyndmax=12 endif s1=sum(absrx(1:k)) From 701d517e6e0fb1b8c84c7a0f0598bd03f54aa7cb Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 22 Dec 2020 12:33:24 -0600 Subject: [PATCH 34/46] For fst4sim, use Lorentzian fading spectrum when fspread is negative. --- lib/fst4/fst4sim.f90 | 3 ++- lib/fst4/lorentzian_fading.f90 | 43 ++++++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 1 deletion(-) create mode 100644 lib/fst4/lorentzian_fading.f90 diff --git a/lib/fst4/fst4sim.f90 b/lib/fst4/fst4sim.f90 index 5b8f33bc3..e42bbbb02 100644 --- a/lib/fst4/fst4sim.f90 +++ b/lib/fst4/fst4sim.f90 @@ -118,7 +118,8 @@ program fst4sim do ifile=1,nfiles c=c0 - if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread) + if(fspread.gt.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread) + if(fspread.lt.0.0) call lorentzian_fading(c,nwave,fs,-fspread) c=sig*c wave=real(c) if(snrdb.lt.90) then diff --git a/lib/fst4/lorentzian_fading.f90 b/lib/fst4/lorentzian_fading.f90 new file mode 100644 index 000000000..c1bd5c325 --- /dev/null +++ b/lib/fst4/lorentzian_fading.f90 @@ -0,0 +1,43 @@ +subroutine lorentzian_fading(c,npts,fs,fspread) +! +! npts is the total length of the simulated data vector +! + complex c(0:npts-1) + complex cspread(0:npts-1) + complex z + + twopi=8.0*atan(1.0) + df=fs/npts + nh=npts/2 + cspread(0)=1.0 + cspread(nh)=0. + b=6.0 + do i=1,nh + f=i*df + x=b*f/fspread + z=0. + a=0. + if(x.lt.3.0) then + a=sqrt(1.111/(1.0+x*x)-0.1) + phi1=twopi*rran() + z=a*cmplx(cos(phi1),sin(phi1)) + endif + cspread(i)=z + z=0. + if(x.lt.3.0) then + phi2=twopi*rran() + z=a*cmplx(cos(phi2),sin(phi2)) + endif + cspread(npts-i)=z + enddo + + call four2a(cspread,npts,1,1,1) + + s=sum(abs(cspread)**2) + avep=s/npts + fac=sqrt(1.0/avep) + cspread=fac*cspread + c=cspread*c + + return +end subroutine lorentzian_fading From 34d32c78407503a38dd67dcb444457bdcea34662 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 22 Dec 2020 12:34:12 -0600 Subject: [PATCH 35/46] Forgot to commit CMakeLists.txt change. --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 1adbcd0ee..8c7b65593 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -459,6 +459,7 @@ set (wsjt_FSRCS lib/jtmsg.f90 lib/libration.f90 lib/lorentzian.f90 + lib/fst4/lorentzian_fading.f90 lib/lpf1.f90 lib/mixlpf.f90 lib/makepings.f90 From fb7b751e6d9d274ca800d7645d3926c632283b5a Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Tue, 22 Dec 2020 13:12:58 -0600 Subject: [PATCH 36/46] Remove hmod from command line parameters for fst4sim. --- lib/fst4/fst4sim.f90 | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/lib/fst4/fst4sim.f90 b/lib/fst4/fst4sim.f90 index e42bbbb02..83ac5baed 100644 --- a/lib/fst4/fst4sim.f90 +++ b/lib/fst4/fst4sim.f90 @@ -19,10 +19,10 @@ program fst4sim ! Get command-line argument(s) nargs=iargc() - if(nargs.ne.10) then - print*,'Need 10 arguments, got ',nargs - print*,'Usage: fst4sim "message" TRsec f0 DT h fdop del nfiles snr W' - print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15 F' + if(nargs.ne.9) then + print*,'Need 9 arguments, got ',nargs + print*,'Usage: fst4sim "message" TRsec f0 DT fdop del nfiles snr W' + print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 0.1 1.0 10 -15 F' print*,'W (T or F) argument is hint to encoder to use WSPR message when there is abiguity' go to 999 endif @@ -34,16 +34,14 @@ program fst4sim call getarg(4,arg) read(arg,*) xdt !Time offset from nominal (s) call getarg(5,arg) - read(arg,*) hmod !Modulation index, h - call getarg(6,arg) read(arg,*) fspread !Watterson frequency spread (Hz) - call getarg(7,arg) + call getarg(6,arg) read(arg,*) delay !Watterson delay (ms) - call getarg(8,arg) + call getarg(7,arg) read(arg,*) nfiles !Number of files - call getarg(9,arg) + call getarg(8,arg) read(arg,*) snrdb !SNR_2500 - call getarg(10,arg) + call getarg(9,arg) read(arg,*) wspr_hint !0:break ties as 77-bit 1:break ties as 50-bit nfiles=abs(nfiles) @@ -89,8 +87,8 @@ program fst4sim call genfst4(msg37,0,msgsent37,msgbits,itone,iwspr) write(*,*) write(*,'(a9,a37,a3,L2,a7,i2)') 'Message: ',msgsent37,'W:',wspr_hint,' iwspr:',iwspr - write(*,1000) f00,xdt,hmod,txt,snrdb -1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',i6,' TxT:',f6.1,' SNR:',f6.1) + write(*,1000) f00,xdt,txt,snrdb +1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1) write(*,*) if(i3.eq.1) then write(*,*) ' mycall hiscall hisgrid' @@ -106,7 +104,8 @@ program fst4sim ! call sgran() - fsample=12000.0 + fsample=12000.0 + hmod=1 icmplx=1 f0=f00+1.5*hmod*baud call gen_fst4wave(itone,NN,nsps,nwave,fsample,hmod,f0,icmplx,c0,wave) From 4081be94e1d7b629116d343cd3a02a2a59346c72 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Wed, 23 Dec 2020 11:45:13 -0600 Subject: [PATCH 37/46] Avoid a possible of bounds error. Compute some more decode diagnostic data. --- lib/fst4_decode.f90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 3407e41f2..a1b39f744 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -59,7 +59,7 @@ contains integer itone(NN) integer hmod integer ipct(0:7) - integer*1 apmask(240),cw(240) + integer*1 apmask(240),cw(240),hdec(240) integer*1 message101(101),message74(74),message77(77) integer*1 rvec(77) integer apbits(240) @@ -392,8 +392,9 @@ contains if(ijitter.eq.1) ioffset=1 if(ijitter.eq.2) ioffset=-1 is0=isbest+ioffset - if(is0.lt.0) cycle - cframe=c2(is0:is0+160*nss-1) + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) bitmetrics=0 call timer('bitmetrc',0) call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & @@ -408,10 +409,10 @@ contains llrs(181:240,il)=bitmetrics(245:304, il) enddo - apmag=maxval(abs(llrs(:,1)))*1.1 + apmag=maxval(abs(llrs(:,4)))*1.1 ntmax=nblock+nappasses(nQSOProgress) if(lapcqonly) ntmax=nblock+1 - if(ndepth.eq.1) ntmax=nblock + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 apmask=0 if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding @@ -595,11 +596,15 @@ contains fsig=fc_synced - 1.5*baud inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,Keff,nsync_qual,nharderrors,dmin, & + ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,6i3,3i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6.6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & From b51bda480674828267fe96390784d47a53ef49bb Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Fri, 25 Dec 2020 12:22:25 -0600 Subject: [PATCH 38/46] FT8: Fix jt9 crash when nagain is invoked. --- lib/ft8/get_spectrum_baseline.f90 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/lib/ft8/get_spectrum_baseline.f90 b/lib/ft8/get_spectrum_baseline.f90 index 9cf4e637c..f815eba14 100644 --- a/lib/ft8/get_spectrum_baseline.f90 +++ b/lib/ft8/get_spectrum_baseline.f90 @@ -35,8 +35,19 @@ subroutine get_spectrum_baseline(dd,nfa,nfb,sbase) savg=savg + s(1:NH1,j) !Average spectrum enddo - if(nfa.lt.100) nfa=100 - if(nfb.gt.4910) nfb=4910 + nwin=nfb-nfa + if(nfa.lt.100) then + nfa=100 + if(nwin.lt.100) then ! nagain + nfb=nfa+nwin + endif + endif + if(nfb.gt.4910) then + nfb=4910 + if(nwin.lt.100) then + nfa=nfb-nwin + endif + endif call baseline(savg,nfa,nfb,sbase) return From 41297e87614ebfcee84bfb20ed0b70f5a4984fba Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Fri, 25 Dec 2020 12:31:02 -0600 Subject: [PATCH 39/46] FT8: Commit the rest of the fix for the nagain crash. --- lib/ft8_decode.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index 26b12d6c9..a7a467a31 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -132,8 +132,8 @@ contains ifa=nfa ifb=nfb if(nagain) then - ifa=nfqso-10 - ifb=nfqso+10 + ifa=nfqso-20 + ifb=nfqso+20 endif ! For now: From a657ce29a7aa4e261281fd18252c282a42027a76 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 26 Dec 2020 09:46:19 -0600 Subject: [PATCH 40/46] FT8: Make nagain work. --- lib/ft8_decode.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index a7a467a31..73d0f8c2a 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -118,7 +118,7 @@ contains dd1=dd go to 900 endif - if(nzhsym.eq.50 .and. ndec_early.ge.1) then + if(nzhsym.eq.50 .and. ndec_early.ge.1 .and. .not.nagain) then n=47*3456 dd(1:n)=dd1(1:n) dd(n+1:)=iwave(n+1:) @@ -131,7 +131,8 @@ contains endif ifa=nfa ifb=nfb - if(nagain) then + if(nzhsym.eq.50 .and. nagain) then + dd=iwave ifa=nfqso-20 ifb=nfqso+20 endif From a38b48d13de10a8014987e5016a06197e0fd0e31 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 28 Dec 2020 09:27:48 -0600 Subject: [PATCH 41/46] Minor format change for nutc in fst4_decodes.dat. --- lib/fst4_decode.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index a1b39f744..0e306abe2 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -604,7 +604,7 @@ contains write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & From 0fef0cc6e6544744e51f4360e76c0839ca438ae5 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Mon, 28 Dec 2020 09:39:08 -0600 Subject: [PATCH 42/46] Minor formatting change in fst4_decodes.dat. --- lib/fst4_decode.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 0e306abe2..d3ecd371b 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -604,7 +604,7 @@ contains write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) +3021 format(i6.6,i4,5i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & From 41f587c240216afccd9ee5c4aa483678ee70fff5 Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 2 Jan 2021 10:09:44 -0600 Subject: [PATCH 43/46] Fix a conflict between noise baseline percentile level and noise blanker percentage. Both were using the npct variable. Add an option for an FST4 pass when in FST4W mode. --- lib/fst4_decode.f90 | 681 +++++++++++++++++++++++--------------------- 1 file changed, 354 insertions(+), 327 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index d3ecd371b..9a1aa0f16 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -43,6 +43,7 @@ contains procedure(fst4_decode_callback) :: callback character*37 decodes(100) character*37 msg,msgsent + character*8 s_nfa_nfb character*20 wcalls(MAXWCALLS), wpart character*77 c77 character*12 mycall,hiscall @@ -58,7 +59,6 @@ contains logical lagain,lapcqonly integer itone(NN) integer hmod - integer ipct(0:7) integer*1 apmask(240),cw(240),hdec(240) integer*1 message101(101),message74(74),message77(77) integer*1 rvec(77) @@ -74,7 +74,6 @@ contains integer*2 iwave(30*60*12000) - data ipct/0,8,14,4,12,2,10,6/ data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ @@ -247,6 +246,7 @@ contains do_k50_decode=.false. endif +! Noise blanker setup ndropmax=1 single_decode=iand(nexp_decode,32).ne.0 npct=0 @@ -262,278 +262,260 @@ contains inb2=1 !Try NB = 0, 1, 2,... 20% else inb1=0 !Fixed NB value, 0 to 25% - ipct(0)=npct endif - if(iwspr.eq.1) then !FST4W - !300 Hz wide noise-fit window - nfa=max(100,nint(nfqso+1.5*baud-150)) - nfb=min(4800,nint(nfqso+1.5*baud+150)) - fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window - fb=min(4800,nint(nfqso+1.5*baud+ntol)) - else if(single_decode) then - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) - else - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) +! If environment variable FST4W_ALSO_FST4 exists then, when in FST4W mode, +! do a second pass for FST4 decodes. The value of FST4W_ALSO_FST4 +! is of the form xxxxyyyy where nfa=xxxx and nfb=yyyy are the +! search limits for the FST4 decoding pass, e.g. +! FST4W_ALSO_FST4=08001700 will set FST4 search window to [800Hz,1700Hz] +! + nmode=1 + call get_environment_variable("FST4W_ALSO_FST4",s_nfa_nfb,nlength) + if(iwspr.eq.1 .and. nlength.eq.8) then + read(s_nfa_nfb,"(i4.4,i4.4)") nfa_mode2,nfb_mode2 + nmode=2 endif - ndecodes=0 - decodes=' ' - new_callsign=.false. - do inb=0,inb1,inb2 - if(nb.lt.0) npct=inb - call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) + do imode=1,nmode + if(imode.eq.1) iwspr=1 + if(imode.eq.2) then ! this is FST4 after a FST4W pass + iwspr=0 + nfa=nfa_mode2 + nfb=nfb_mode2 + endif + +! nfa,nfb: define the noise-baseline analysis window +! fa, fb: define the signal search window +! We usually make nfafb so that noise baseline analysis +! window extends outside of the [fa,fb] window where we think the signals are. +! + if(iwspr.eq.1) then !FST4W + nfa=max(100,nfqso-ntol-100) + nfb=min(4800,nfqso+ntol+100) + fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window + fb=min(4800,nint(nfqso+1.5*baud+ntol)) + else if(iwspr.eq.0) then + if(imode.eq.1 .and. single_decode) then + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + else + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + endif + endif + + ndecodes=0 + decodes=' ' + new_callsign=.false. + do inb=0,inb1,inb2 + if(nb.lt.0) npct=inb ! we are looping over blanker settings + call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) ! The big fft is done once and is used for calculating the smoothed spectrum ! and also for downconverting/downsampling each candidate. - call four2a(c_bigfft,nfft1,1,-1,0) !r2c - nhicoh=1 - nsyncoh=8 - minsync=1.20 - if(ntrperiod.eq.15) minsync=1.15 + call four2a(c_bigfft,nfft1,1,-1,0) !r2c + nhicoh=1 + nsyncoh=8 + minsync=1.20 + if(ntrperiod.eq.15) minsync=1.15 ! Get first approximation of candidate frequencies - call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & - minsync,ncand,candidates0) - isbest=0 - fc2=0. - do icand=1,ncand - fc0=candidates0(icand,1) - if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & - abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle - detmet=candidates0(icand,2) + call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & + minsync,ncand,candidates0) + isbest=0 + fc2=0. + do icand=1,ncand + fc0=candidates0(icand,1) + if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso + detmet=candidates0(icand,2) ! Downconvert and downsample a slice of the spectrum centered on the ! rough estimate of the candidates frequency. ! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. ! The size of the downsampled c2 array is nfft2=nfft1/ndown + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) + call timer('dwnsmpl ',1) - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) - call timer('dwnsmpl ',1) + call timer('sync240 ',0) + call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) + call timer('sync240 ',1) - call timer('sync240 ',0) - call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) - call timer('sync240 ',1) - - fc_synced = fc0 + fcbest - dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 - candidates0(icand,3)=fc_synced - candidates0(icand,4)=isbest - enddo + fc_synced = fc0 + fcbest + dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 + candidates0(icand,3)=fc_synced + candidates0(icand,4)=isbest + enddo ! remove duplicate candidates - do icand=1,ncand - fc=candidates0(icand,3) - isbest=nint(candidates0(icand,4)) - do ic2=icand+1,ncand - fc2=candidates0(ic2,3) - isbest2=nint(candidates0(ic2,4)) - if(fc2.gt.0.0) then - if(abs(fc2-fc).lt.0.10*baud) then ! same frequency - if(abs(isbest2-isbest).le.2) then - candidates0(ic2,3)=-1 - endif - endif - endif - enddo - enddo - ic=0 - do icand=1,ncand - if(candidates0(icand,3).gt.0) then - ic=ic+1 - candidates0(ic,:)=candidates0(icand,:) - endif - enddo - ncand=ic - -! If FST4 and Single Decode is not checked, then find candidates within -! 20 Hz of nfqso and put them at the top of the list - if(iwspr.eq.0 .and. .not.single_decode) then - nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) - k=0 - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - else - candidates=candidates0 - endif - - xsnr=0. - do icand=1,ncand - sync=candidates(icand,2) - fc_synced=candidates(icand,3) - isbest=nint(candidates(icand,4)) - xdt=(isbest-nspsec)/fs2 - if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) - call timer('dwnsmpl ',1) - - do ijitter=0,jittermax - if(ijitter.eq.0) ioffset=0 - if(ijitter.eq.1) ioffset=1 - if(ijitter.eq.2) ioffset=-1 - is0=isbest+ioffset - iend=is0+160*nss-1 - if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle - cframe=c2(is0:iend) - bitmetrics=0 - call timer('bitmetrc',0) - call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & - s4,nsync_qual,badsync) - call timer('bitmetrc',1) - if(badsync) cycle - - do il=1,4 - llrs( 1: 60,il)=bitmetrics( 17: 76, il) - llrs( 61:120,il)=bitmetrics( 93:152, il) - llrs(121:180,il)=bitmetrics(169:228, il) - llrs(181:240,il)=bitmetrics(245:304, il) - enddo - - apmag=maxval(abs(llrs(:,4)))*1.1 - ntmax=nblock+nappasses(nQSOProgress) - if(lapcqonly) ntmax=nblock+1 - if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 - apmask=0 - - if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding - nblock=4 - ntmax=nblock - endif - - do itry=1,ntmax - if(itry.eq.1) llr=llrs(:,1) - if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) - if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) - if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) - if(itry.le.nblock) then - apmask=0 - iaptype=0 - endif - - if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes - llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes - iaptype=naptypes(nQSOProgress,itry-nblock) - if(lapcqonly) iaptype=1 - if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall - if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall - if(iaptype.eq.1) then ! CQ - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*mcq(1:29) - endif - - if(iaptype.eq.2) then ! MyCall ??? ??? - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*apbits(1:29) - endif - - if(iaptype.eq.3) then ! MyCall DxCall ??? - apmask=0 - apmask(1:58)=1 - llr(1:58)=apmag*apbits(1:58) - endif - - if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then - apmask=0 - apmask(1:77)=1 - llr(1:58)=apmag*apbits(1:58) - if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) - if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) - if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) - endif - endif - - dmin=0.0 - nharderrors=-1 - unpk77_success=.false. - if(iwspr.eq.0) then - maxosd=2 - Keff=91 - norder=3 - call timer('d240_101',0) - call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & - cw,ntype,nharderrors,dmin) - call timer('d240_101',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(77i1)') mod(message101(1:77)+rvec,2) - call unpack77(c77,1,msg,unpk77_success) - elseif(iwspr.eq.1) then -! Try decoding with Keff=66 - maxosd=2 - call timer('d240_74 ',0) - Keff=66 - norder=3 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(nharderrors.lt.0) goto 3465 - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success .and. do_k50_decode) then -! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. - i1=index(msg,' ') - i2=i1+index(msg(i1+1:),' ') - wpart=trim(msg(1:i2)) -! Only save callsigns/grids from type 1 messages - if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then - ifound=0 - do i=1,nwcalls - if(index(wcalls(i),wpart).ne.0) ifound=1 - enddo - - if(ifound.eq.0) then ! This is a new callsign - new_callsign=.true. - if(nwcalls.lt.MAXWCALLS) then - nwcalls=nwcalls+1 - wcalls(nwcalls)=wpart - else - wcalls(1:nwcalls-1)=wcalls(2:nwcalls) - wcalls(nwcalls)=wpart - endif - endif + do icand=1,ncand + fc=candidates0(icand,3) + isbest=nint(candidates0(icand,4)) + do ic2=icand+1,ncand + fc2=candidates0(ic2,3) + isbest2=nint(candidates0(ic2,4)) + if(fc2.gt.0.0) then + if(abs(fc2-fc).lt.0.10*baud) then ! same frequency + if(abs(isbest2-isbest).le.2) then + candidates0(ic2,3)=-1 endif endif -3465 continue + endif + enddo + enddo + ic=0 + do icand=1,ncand + if(candidates0(icand,3).gt.0) then + ic=ic+1 + candidates0(ic,:)=candidates0(icand,:) + endif + enddo + ncand=ic -! If no decode then try Keff=50 - iaptype=0 - if( .not. unpk77_success .and. do_k50_decode ) then - maxosd=1 +! If FST4 mode and Single Decode is not checked, then find candidates +! within 20 Hz of nfqso and put them at the top of the list + if(iwspr.eq.0 .and. .not.single_decode) then + nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) + k=0 + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + else + candidates=candidates0 + endif + + xsnr=0. + do icand=1,ncand + sync=candidates(icand,2) + fc_synced=candidates(icand,3) + isbest=nint(candidates(icand,4)) + xdt=(isbest-nspsec)/fs2 + if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) + call timer('dwnsmpl ',1) + + do ijitter=0,jittermax + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=1 + if(ijitter.eq.2) ioffset=-1 + is0=isbest+ioffset + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) + bitmetrics=0 + call timer('bitmetrc',0) + call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & + s4,nsync_qual,badsync) + call timer('bitmetrc',1) + if(badsync) cycle + + do il=1,4 + llrs( 1: 60,il)=bitmetrics( 17: 76, il) + llrs( 61:120,il)=bitmetrics( 93:152, il) + llrs(121:180,il)=bitmetrics(169:228, il) + llrs(181:240,il)=bitmetrics(245:304, il) + enddo + + apmag=maxval(abs(llrs(:,4)))*1.1 + ntmax=nblock+nappasses(nQSOProgress) + if(lapcqonly) ntmax=nblock+1 + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 + apmask=0 + + if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding + nblock=4 + ntmax=nblock + endif + + do itry=1,ntmax + if(itry.eq.1) llr=llrs(:,1) + if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) + if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) + if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) + if(itry.le.nblock) then + apmask=0 + iaptype=0 + endif + + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes + llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes + iaptype=naptypes(nQSOProgress,itry-nblock) + if(lapcqonly) iaptype=1 + if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall + if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall + if(iaptype.eq.1) then ! CQ + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*mcq(1:29) + endif + + if(iaptype.eq.2) then ! MyCall ??? ??? + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*apbits(1:29) + endif + + if(iaptype.eq.3) then ! MyCall DxCall ??? + apmask=0 + apmask(1:58)=1 + llr(1:58)=apmag*apbits(1:58) + endif + + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then + apmask=0 + apmask(1:77)=1 + llr(1:58)=apmag*apbits(1:58) + if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) + if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) + if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) + endif + endif + + dmin=0.0 + nharderrors=-1 + unpk77_success=.false. + if(iwspr.eq.0) then + maxosd=2 + Keff=91 + norder=3 + call timer('d240_101',0) + call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & + cw,ntype,nharderrors,dmin) + call timer('d240_101',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then +! Try decoding with Keff=66 + maxosd=2 call timer('d240_74 ',0) - Keff=50 - norder=4 + Keff=66 + norder=3 call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & ntype,nharderrors,dmin) call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 if(count(cw.eq.1).eq.0) then nharderrors=-nharderrors cycle @@ -541,89 +523,134 @@ contains write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) -! No CRC in this mode, so only accept the decode if call/grid have been seen before - if(unpk77_success) then - unpk77_success=.false. - do i=1,nwcalls - if(index(msg,trim(wcalls(i))).gt.0) then - unpk77_success=.true. + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif endif - enddo + endif endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_k50_decode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) +! No CRC in this mode, so only accept the decode if call/grid have been seen before + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo + endif + endif + endif - endif + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg - if(nharderrors .ge.0 .and. unpk77_success) then - idupe=0 - do i=1,ndecodes - if(decodes(i).eq.msg) idupe=1 - enddo - if(idupe.eq.1) goto 800 - ndecodes=ndecodes+1 - decodes(ndecodes)=msg + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) + else + call get_fst4_tones_from_bits(message74,itone,1) + endif + inquire(file='plotspec',exist=plotspec_exists) + fmid=-999.0 + call timer('dopsprd ',0) + if(plotspec_exists) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + arg=600.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) + if(ntrperiod.eq. 15) xsnr=xsnr+2 + if(ntrperiod.eq. 30) xsnr=xsnr+1 + if(ntrperiod.eq. 900) xsnr=xsnr+1 + if(ntrperiod.eq.1800) xsnr=xsnr+2 + else + xsnr=-99.9 + endif + nsnr=nint(xsnr) + qual=0.0 + fsig=fc_synced - 1.5*baud + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) + if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') + write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & + ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & + sync,xsnr,xdt,fsig,w50,trim(msg) +3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) + close(21) + endif + call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & + iaptype,qual,ntrperiod,lwspr,fmid,w50) + if(iwspr.eq.0 .and. nb.lt.0 .and. imode.eq.1) go to 900 + goto 800 + endif + enddo ! metrics + enddo ! istart jitter +800 enddo !candidate list + enddo ! noise blanker loop - if(iwspr.eq.0) then - call get_fst4_tones_from_bits(message101,itone,0) - else - call get_fst4_tones_from_bits(message74,itone,1) - endif - inquire(file='plotspec',exist=plotspec_exists) - fmid=-999.0 - call timer('dopsprd ',0) - if(plotspec_exists) then - call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & - isbest,fc_synced,fmid,w50) - endif - call timer('dopsprd ',1) - xsig=0 - do i=1,NN - xsig=xsig+s4(itone(i),i) - enddo - base=candidates(icand,5) - arg=600.0*(xsig/base)-1.0 - if(arg.gt.0.0) then - xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) - if(ntrperiod.eq. 15) xsnr=xsnr+2 - if(ntrperiod.eq. 30) xsnr=xsnr+1 - if(ntrperiod.eq. 900) xsnr=xsnr+1 - if(ntrperiod.eq.1800) xsnr=xsnr+2 - else - xsnr=-99.9 - endif - nsnr=nint(xsnr) - qual=0.0 - fsig=fc_synced - 1.5*baud - inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) - if(decdata_exists) then - hdec=0 - where(llrs(:,1).ge.0.0) hdec=1 - nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols - hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols - open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') - write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & - sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,i4,5i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) - close(21) - endif - call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & - iaptype,qual,ntrperiod,lwspr,fmid,w50) - if(iwspr.eq.0 .and. nb.lt.0) go to 900 - goto 800 - endif - enddo ! metrics - enddo ! istart jitter -800 enddo !candidate list - enddo ! noise blanker loop + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif - if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file - open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') - do i=1,nwcalls - write(42,'(a20)') trim(wcalls(i)) - enddo - close(42) - endif + enddo ! mode loop 900 return end subroutine decode @@ -818,8 +845,8 @@ contains do i=ina,inb !Compute CCF of s() and 4 tones s2(i)=s(i-hmod*3) + s(i-hmod) +s(i+hmod) +s(i+hmod*3) enddo - npct=30 - call fst4_baseline(s2,nnw,ina+hmod*3,inb-hmod*3,npct,sbase) + npctile=30 + call fst4_baseline(s2,nnw,ina+hmod*3,inb-hmod*3,npctile,sbase) if(any(sbase(ina:inb).le.0.0)) return s2(ina:inb)=s2(ina:inb)/sbase(ina:inb) !Normalize wrt noise level From 46222c61eddb6b98e35c11d2252e59527359262f Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 2 Jan 2021 10:25:29 -0600 Subject: [PATCH 44/46] Add rudimentary sanity checks to the values parsed from FST4W_ALSO_FST4. --- lib/fst4_decode.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 9a1aa0f16..9b066e61f 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -275,6 +275,7 @@ contains if(iwspr.eq.1 .and. nlength.eq.8) then read(s_nfa_nfb,"(i4.4,i4.4)") nfa_mode2,nfb_mode2 nmode=2 + if(nfa_mode2.lt.100 .or. nfb_mode2.gt.4910 .or. nfb_mode2.le.nfa_mode2) nmode=1 endif do imode=1,nmode From 0013b151200e4f09417bcfa3ef7e27df21412d7a Mon Sep 17 00:00:00 2001 From: Steven Franke Date: Sat, 2 Jan 2021 11:37:16 -0600 Subject: [PATCH 45/46] Remove some debug code. --- lib/fst4_decode.f90 | 638 +++++++++++++++++++++----------------------- 1 file changed, 307 insertions(+), 331 deletions(-) diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index 9b066e61f..5fb591ffa 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -43,7 +43,6 @@ contains procedure(fst4_decode_callback) :: callback character*37 decodes(100) character*37 msg,msgsent - character*8 s_nfa_nfb character*20 wcalls(MAXWCALLS), wpart character*77 c77 character*12 mycall,hiscall @@ -264,259 +263,281 @@ contains inb1=0 !Fixed NB value, 0 to 25% endif -! If environment variable FST4W_ALSO_FST4 exists then, when in FST4W mode, -! do a second pass for FST4 decodes. The value of FST4W_ALSO_FST4 -! is of the form xxxxyyyy where nfa=xxxx and nfb=yyyy are the -! search limits for the FST4 decoding pass, e.g. -! FST4W_ALSO_FST4=08001700 will set FST4 search window to [800Hz,1700Hz] -! - nmode=1 - call get_environment_variable("FST4W_ALSO_FST4",s_nfa_nfb,nlength) - if(iwspr.eq.1 .and. nlength.eq.8) then - read(s_nfa_nfb,"(i4.4,i4.4)") nfa_mode2,nfb_mode2 - nmode=2 - if(nfa_mode2.lt.100 .or. nfb_mode2.gt.4910 .or. nfb_mode2.le.nfa_mode2) nmode=1 - endif - - do imode=1,nmode - if(imode.eq.1) iwspr=1 - if(imode.eq.2) then ! this is FST4 after a FST4W pass - iwspr=0 - nfa=nfa_mode2 - nfb=nfb_mode2 - endif ! nfa,nfb: define the noise-baseline analysis window ! fa, fb: define the signal search window ! We usually make nfafb so that noise baseline analysis ! window extends outside of the [fa,fb] window where we think the signals are. ! - if(iwspr.eq.1) then !FST4W - nfa=max(100,nfqso-ntol-100) - nfb=min(4800,nfqso+ntol+100) - fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window - fb=min(4800,nint(nfqso+1.5*baud+ntol)) - else if(iwspr.eq.0) then - if(imode.eq.1 .and. single_decode) then - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) - else - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) - endif + if(iwspr.eq.1) then !FST4W + nfa=max(100,nfqso-ntol-100) + nfb=min(4800,nfqso+ntol+100) + fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window + fb=min(4800,nint(nfqso+1.5*baud+ntol)) + else if(iwspr.eq.0) then + if(single_decode) then + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + else + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) endif + endif - ndecodes=0 - decodes=' ' - new_callsign=.false. - do inb=0,inb1,inb2 - if(nb.lt.0) npct=inb ! we are looping over blanker settings - call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) + ndecodes=0 + decodes=' ' + new_callsign=.false. + do inb=0,inb1,inb2 + if(nb.lt.0) npct=inb ! we are looping over blanker settings + call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) ! The big fft is done once and is used for calculating the smoothed spectrum ! and also for downconverting/downsampling each candidate. - call four2a(c_bigfft,nfft1,1,-1,0) !r2c - nhicoh=1 - nsyncoh=8 - minsync=1.20 - if(ntrperiod.eq.15) minsync=1.15 + call four2a(c_bigfft,nfft1,1,-1,0) !r2c + nhicoh=1 + nsyncoh=8 + minsync=1.20 + if(ntrperiod.eq.15) minsync=1.15 ! Get first approximation of candidate frequencies - call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & - minsync,ncand,candidates0) - isbest=0 - fc2=0. - do icand=1,ncand - fc0=candidates0(icand,1) - if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & - abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso - detmet=candidates0(icand,2) + call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & + minsync,ncand,candidates0) + isbest=0 + fc2=0. + do icand=1,ncand + fc0=candidates0(icand,1) + if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso + detmet=candidates0(icand,2) ! Downconvert and downsample a slice of the spectrum centered on the ! rough estimate of the candidates frequency. ! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. ! The size of the downsampled c2 array is nfft2=nfft1/ndown - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) - call timer('dwnsmpl ',1) + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) + call timer('dwnsmpl ',1) - call timer('sync240 ',0) - call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) - call timer('sync240 ',1) + call timer('sync240 ',0) + call fst4_sync_search(c2,nfft2,hmod,fs2,nss,ntrperiod,nsyncoh,emedelay,sbest,fcbest,isbest) + call timer('sync240 ',1) - fc_synced = fc0 + fcbest - dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 - candidates0(icand,3)=fc_synced - candidates0(icand,4)=isbest - enddo + fc_synced = fc0 + fcbest + dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2 + candidates0(icand,3)=fc_synced + candidates0(icand,4)=isbest + enddo ! remove duplicate candidates - do icand=1,ncand - fc=candidates0(icand,3) - isbest=nint(candidates0(icand,4)) - do ic2=icand+1,ncand - fc2=candidates0(ic2,3) - isbest2=nint(candidates0(ic2,4)) - if(fc2.gt.0.0) then - if(abs(fc2-fc).lt.0.10*baud) then ! same frequency - if(abs(isbest2-isbest).le.2) then - candidates0(ic2,3)=-1 - endif + do icand=1,ncand + fc=candidates0(icand,3) + isbest=nint(candidates0(icand,4)) + do ic2=icand+1,ncand + fc2=candidates0(ic2,3) + isbest2=nint(candidates0(ic2,4)) + if(fc2.gt.0.0) then + if(abs(fc2-fc).lt.0.10*baud) then ! same frequency + if(abs(isbest2-isbest).le.2) then + candidates0(ic2,3)=-1 endif endif - enddo - enddo - ic=0 - do icand=1,ncand - if(candidates0(icand,3).gt.0) then - ic=ic+1 - candidates0(ic,:)=candidates0(icand,:) endif enddo - ncand=ic - -! If FST4 mode and Single Decode is not checked, then find candidates -! within 20 Hz of nfqso and put them at the top of the list - if(iwspr.eq.0 .and. .not.single_decode) then - nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) - k=0 - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - do i=1,ncand - if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then - k=k+1 - candidates(k,:)=candidates0(i,:) - endif - enddo - else - candidates=candidates0 + enddo + ic=0 + do icand=1,ncand + if(candidates0(icand,3).gt.0) then + ic=ic+1 + candidates0(ic,:)=candidates0(icand,:) endif + enddo + ncand=ic - xsnr=0. - do icand=1,ncand - sync=candidates(icand,2) - fc_synced=candidates(icand,3) - isbest=nint(candidates(icand,4)) - xdt=(isbest-nspsec)/fs2 - if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 - call timer('dwnsmpl ',0) - call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) - call timer('dwnsmpl ',1) +! If FST4 mode and Single Decode is not checked, then find candidates +! within 20 Hz of nfqso and put them at the top of the list + if(iwspr.eq.0 .and. .not.single_decode) then + nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) + k=0 + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).le.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + do i=1,ncand + if(abs(candidates0(i,3)-(nfqso+1.5*baud)).gt.20) then + k=k+1 + candidates(k,:)=candidates0(i,:) + endif + enddo + else + candidates=candidates0 + endif - do ijitter=0,jittermax - if(ijitter.eq.0) ioffset=0 - if(ijitter.eq.1) ioffset=1 - if(ijitter.eq.2) ioffset=-1 - is0=isbest+ioffset - iend=is0+160*nss-1 - if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle - cframe=c2(is0:iend) - bitmetrics=0 - call timer('bitmetrc',0) - call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & - s4,nsync_qual,badsync) - call timer('bitmetrc',1) - if(badsync) cycle + xsnr=0. + do icand=1,ncand + sync=candidates(icand,2) + fc_synced=candidates(icand,3) + isbest=nint(candidates(icand,4)) + xdt=(isbest-nspsec)/fs2 + if(ntrperiod.eq.15) xdt=(isbest-real(nspsec)/2.0)/fs2 + call timer('dwnsmpl ',0) + call fst4_downsample(c_bigfft,nfft1,ndown,fc_synced,sigbw,c2) + call timer('dwnsmpl ',1) - do il=1,4 - llrs( 1: 60,il)=bitmetrics( 17: 76, il) - llrs( 61:120,il)=bitmetrics( 93:152, il) - llrs(121:180,il)=bitmetrics(169:228, il) - llrs(181:240,il)=bitmetrics(245:304, il) - enddo + do ijitter=0,jittermax + if(ijitter.eq.0) ioffset=0 + if(ijitter.eq.1) ioffset=1 + if(ijitter.eq.2) ioffset=-1 + is0=isbest+ioffset + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) + bitmetrics=0 + call timer('bitmetrc',0) + call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & + s4,nsync_qual,badsync) + call timer('bitmetrc',1) + if(badsync) cycle - apmag=maxval(abs(llrs(:,4)))*1.1 - ntmax=nblock+nappasses(nQSOProgress) - if(lapcqonly) ntmax=nblock+1 - if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 - apmask=0 + do il=1,4 + llrs( 1: 60,il)=bitmetrics( 17: 76, il) + llrs( 61:120,il)=bitmetrics( 93:152, il) + llrs(121:180,il)=bitmetrics(169:228, il) + llrs(181:240,il)=bitmetrics(245:304, il) + enddo - if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding - nblock=4 - ntmax=nblock + apmag=maxval(abs(llrs(:,4)))*1.1 + ntmax=nblock+nappasses(nQSOProgress) + if(lapcqonly) ntmax=nblock+1 + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 + apmask=0 + + if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding + nblock=4 + ntmax=nblock + endif + + do itry=1,ntmax + if(itry.eq.1) llr=llrs(:,1) + if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) + if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) + if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) + if(itry.le.nblock) then + apmask=0 + iaptype=0 endif - do itry=1,ntmax - if(itry.eq.1) llr=llrs(:,1) - if(itry.eq.2.and.itry.le.nblock) llr=llrs(:,2) - if(itry.eq.3.and.itry.le.nblock) llr=llrs(:,3) - if(itry.eq.4.and.itry.le.nblock) llr=llrs(:,4) - if(itry.le.nblock) then + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes + llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes + iaptype=naptypes(nQSOProgress,itry-nblock) + if(lapcqonly) iaptype=1 + if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall + if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall + if(iaptype.eq.1) then ! CQ apmask=0 - iaptype=0 + apmask(1:29)=1 + llr(1:29)=apmag*mcq(1:29) endif - if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes - llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes - iaptype=naptypes(nQSOProgress,itry-nblock) - if(lapcqonly) iaptype=1 - if(iaptype.ge.2 .and. apbits(1).gt.1) cycle ! No, or nonstandard, mycall - if(iaptype.ge.3 .and. apbits(30).gt.1) cycle ! No, or nonstandard, dxcall - if(iaptype.eq.1) then ! CQ - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*mcq(1:29) - endif - - if(iaptype.eq.2) then ! MyCall ??? ??? - apmask=0 - apmask(1:29)=1 - llr(1:29)=apmag*apbits(1:29) - endif - - if(iaptype.eq.3) then ! MyCall DxCall ??? - apmask=0 - apmask(1:58)=1 - llr(1:58)=apmag*apbits(1:58) - endif - - if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then - apmask=0 - apmask(1:77)=1 - llr(1:58)=apmag*apbits(1:58) - if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) - if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) - if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) - endif + if(iaptype.eq.2) then ! MyCall ??? ??? + apmask=0 + apmask(1:29)=1 + llr(1:29)=apmag*apbits(1:29) endif - dmin=0.0 - nharderrors=-1 - unpk77_success=.false. - if(iwspr.eq.0) then - maxosd=2 - Keff=91 - norder=3 - call timer('d240_101',0) - call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & - cw,ntype,nharderrors,dmin) - call timer('d240_101',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(77i1)') mod(message101(1:77)+rvec,2) - call unpack77(c77,1,msg,unpk77_success) - elseif(iwspr.eq.1) then + if(iaptype.eq.3) then ! MyCall DxCall ??? + apmask=0 + apmask(1:58)=1 + llr(1:58)=apmag*apbits(1:58) + endif + + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then + apmask=0 + apmask(1:77)=1 + llr(1:58)=apmag*apbits(1:58) + if(iaptype.eq.4) llr(59:77)=apmag*mrrr(1:19) + if(iaptype.eq.5) llr(59:77)=apmag*m73(1:19) + if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) + endif + endif + + dmin=0.0 + nharderrors=-1 + unpk77_success=.false. + if(iwspr.eq.0) then + maxosd=2 + Keff=91 + norder=3 + call timer('d240_101',0) + call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & + cw,ntype,nharderrors,dmin) + call timer('d240_101',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then ! Try decoding with Keff=66 - maxosd=2 + maxosd=2 + call timer('d240_74 ',0) + Keff=66 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif + endif + endif + endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_k50_decode ) then + maxosd=1 call timer('d240_74 ',0) - Keff=66 - norder=3 + Keff=50 + norder=4 call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & ntype,nharderrors,dmin) call timer('d240_74 ',1) - if(nharderrors.lt.0) goto 3465 if(count(cw.eq.1).eq.0) then nharderrors=-nharderrors cycle @@ -524,134 +545,89 @@ contains write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) - if(unpk77_success .and. do_k50_decode) then -! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. - i1=index(msg,' ') - i2=i1+index(msg(i1+1:),' ') - wpart=trim(msg(1:i2)) -! Only save callsigns/grids from type 1 messages - if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then - ifound=0 - do i=1,nwcalls - if(index(wcalls(i),wpart).ne.0) ifound=1 - enddo - - if(ifound.eq.0) then ! This is a new callsign - new_callsign=.true. - if(nwcalls.lt.MAXWCALLS) then - nwcalls=nwcalls+1 - wcalls(nwcalls)=wpart - else - wcalls(1:nwcalls-1)=wcalls(2:nwcalls) - wcalls(nwcalls)=wpart - endif - endif - endif - endif -3465 continue - -! If no decode then try Keff=50 - iaptype=0 - if( .not. unpk77_success .and. do_k50_decode ) then - maxosd=1 - call timer('d240_74 ',0) - Keff=50 - norder=4 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - if(count(cw.eq.1).eq.0) then - nharderrors=-nharderrors - cycle - endif - write(c77,'(50i1)') message74(1:50) - c77(51:77)='000000000000000000000110000' - call unpack77(c77,1,msg,unpk77_success) ! No CRC in this mode, so only accept the decode if call/grid have been seen before - if(unpk77_success) then - unpk77_success=.false. - do i=1,nwcalls - if(index(msg,trim(wcalls(i))).gt.0) then - unpk77_success=.true. - endif - enddo - endif + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo endif - endif - if(nharderrors .ge.0 .and. unpk77_success) then - idupe=0 - do i=1,ndecodes - if(decodes(i).eq.msg) idupe=1 - enddo - if(idupe.eq.1) goto 800 - ndecodes=ndecodes+1 - decodes(ndecodes)=msg + endif - if(iwspr.eq.0) then - call get_fst4_tones_from_bits(message101,itone,0) - else - call get_fst4_tones_from_bits(message74,itone,1) - endif - inquire(file='plotspec',exist=plotspec_exists) - fmid=-999.0 - call timer('dopsprd ',0) - if(plotspec_exists) then - call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & - isbest,fc_synced,fmid,w50) - endif - call timer('dopsprd ',1) - xsig=0 - do i=1,NN - xsig=xsig+s4(itone(i),i) - enddo - base=candidates(icand,5) - arg=600.0*(xsig/base)-1.0 - if(arg.gt.0.0) then - xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) - if(ntrperiod.eq. 15) xsnr=xsnr+2 - if(ntrperiod.eq. 30) xsnr=xsnr+1 - if(ntrperiod.eq. 900) xsnr=xsnr+1 - if(ntrperiod.eq.1800) xsnr=xsnr+2 - else - xsnr=-99.9 - endif - nsnr=nint(xsnr) - qual=0.0 - fsig=fc_synced - 1.5*baud - inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) - if(decdata_exists) then - hdec=0 - where(llrs(:,1).ge.0.0) hdec=1 - nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols - hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols - open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') - write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & - sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) - close(21) - endif - call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & - iaptype,qual,ntrperiod,lwspr,fmid,w50) - if(iwspr.eq.0 .and. nb.lt.0 .and. imode.eq.1) go to 900 - goto 800 + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) + else + call get_fst4_tones_from_bits(message74,itone,1) endif - enddo ! metrics - enddo ! istart jitter -800 enddo !candidate list - enddo ! noise blanker loop + inquire(file='plotspec',exist=plotspec_exists) + fmid=-999.0 + call timer('dopsprd ',0) + if(plotspec_exists) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + arg=600.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) + if(ntrperiod.eq. 15) xsnr=xsnr+2 + if(ntrperiod.eq. 30) xsnr=xsnr+1 + if(ntrperiod.eq. 900) xsnr=xsnr+1 + if(ntrperiod.eq.1800) xsnr=xsnr+2 + else + xsnr=-99.9 + endif + nsnr=nint(xsnr) + qual=0.0 + fsig=fc_synced - 1.5*baud + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) + if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') + write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & + ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & + sync,xsnr,xdt,fsig,w50,trim(msg) +3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) + close(21) + endif + call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & + iaptype,qual,ntrperiod,lwspr,fmid,w50) + if(iwspr.eq.0 .and. nb.lt.0) go to 900 + goto 800 + endif + enddo ! metrics + enddo ! istart jitter +800 enddo !candidate list + enddo ! noise blanker loop - if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file - open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') - do i=1,nwcalls - write(42,'(a20)') trim(wcalls(i)) - enddo - close(42) - endif - - enddo ! mode loop + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif 900 return end subroutine decode From 607a346cf15f6a4fe291719b5fc12e03c59b0e2b Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Mon, 4 Jan 2021 15:35:32 +0000 Subject: [PATCH 46/46] Add new function needed for FST4W decoder updates --- lib/gran.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/gran.c b/lib/gran.c index 24b986503..ac41c7fe4 100644 --- a/lib/gran.c +++ b/lib/gran.c @@ -26,3 +26,9 @@ float gran_() iset++; return v2*fac; } + +/* Generates evenly distributed numbers between 0 and 1. */ +float rran_() +{ + return (float)rand()/(float)RAND_MAX; +}