Working toward 'q3list' decoding for NA VHF Contest mode. More still needed!

This commit is contained in:
Joe Taylor 2023-02-07 15:17:09 -05:00
parent 8db7c2c128
commit 88798f1ca3
6 changed files with 181 additions and 13 deletions

View File

@ -509,6 +509,7 @@ set (wsjt_FSRCS
lib/qra/q65/q65_ap.f90
lib/qra/q65/q65_loops.f90
lib/qra/q65/q65_set_list.f90
lib/qra/q65/q65_set_list2.f90
lib/refspectrum.f90
lib/savec2.f90
lib/save_dxbase.f90

View File

@ -55,9 +55,13 @@ contains
use, intrinsic :: iso_c_binding
use q65 !Shared variables
use prog_args
use types
parameter (NMAX=300*12000) !Max TRperiod is 300 s
parameter (NMAX=300*12000) !Max TRperiod is 300 s
parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode
class(q65_decoder), intent(inout) :: this
procedure(q65_decode_callback) :: callback
character(len=12) :: mycall, hiscall !Used for AP decoding
character(len=6) :: hisgrid
@ -74,15 +78,17 @@ contains
integer dat4(13) !Decoded message as 12 6-bit integers
integer dgen(13)
integer nq65param(3)
integer stageno !Added by W3SZ
integer time
logical lclearave,lnewdat0,lapcqonly,unpk77_success
logical single_decode,lagain,ex
complex, allocatable :: c00(:) !Analytic signal, 6000 Sa/s
complex, allocatable :: c0(:) !Analytic signal, 6000 Sa/s
integer stageno !Added by W3SZ
stageno=0
type(q3list) callers(MAX_CALLERS)
! Start by setting some parameters and allocating storage for large arrays
call sec0(0,tdecode)
stageno=0
ndecodes=0
decodes=' '
f0decodes=0.
@ -103,9 +109,25 @@ contains
if(lagain) ndepth=ior(ndepth,3) !Use 'Deep' for manual Q65 decodes
dxcall13=hiscall ! initialize for use in packjt77
mycall13=mycall
nhist2=0
if(ncontest.eq.1) then
! NA VHF Contest or ARRL Digi Contest
open(24,file=trim(data_dir)//'/q3list.bin',status='unknown', &
form='unformatted')
read(24,end=2) nhist2,callers(1:nhist2)
now=time()
do i=1,nhist2
hours=(now - callers(i)%nsec)/3600.0
if(hours.gt.18.0) then
callers(i:nhist2-1)=callers(i+1:nhist2)
nhist2=nhist2-1
endif
enddo
! print*,'a nhist2:',nhist2
endif
! Determine the T/R sequence: iseq=0 (even), or iseq=1 (odd)
n=nutc
2 n=nutc
if(ntrperiod.ge.60 .and. nutc.le.2359) n=100*n
write(cutc,'(i6.6)') n
read(cutc,'(3i2)') ih,im,is
@ -151,7 +173,11 @@ contains
if(ichar(hisgrid(1:1)).eq.0) hisgrid=' '
ncw=0
if(nqd.eq.1 .or. lagain) then
call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
if(ncontest.eq.1) then
call q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2,codewords,ncw)
else
call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
endif
endif
dgen=0
call q65_enc(dgen,codewords) !Initialize the Q65 codec
@ -284,7 +310,11 @@ contains
nsnr=nint(snr2)
call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded, &
idec,nused,ntrperiod)
call q65_hist(nint(f0dec),msg0=decoded)
if(ncontest.eq.1) then
call q65_hist2(decoded,callers,nhist2)
else
call q65_hist(nint(f0dec),msg0=decoded)
endif
if(iand(ndepth,128).ne.0 .and. .not.lagain .and. &
int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg !AutoClrAvg
call sec0(1,tdecode)
@ -374,7 +404,11 @@ contains
nsnr=nint(snr2)
call this%callback(nutc,snr1,nsnr,dtdec,f0dec,decoded, &
idec,nused,ntrperiod)
call q65_hist(nint(f0dec),msg0=decoded)
if(ncontest.eq.1) then
call q65_hist2(decoded,callers,nhist2)
else
call q65_hist(nint(f0dec),msg0=decoded)
endif
if(iand(ndepth,128).ne.0 .and. .not.lagain .and. &
int(abs(f0dec-nfqso)).le.ntol ) call q65_clravg !AutoClrAvg
call sec0(1,tdecode)
@ -403,7 +437,9 @@ contains
800 continue
enddo ! icand
if(iavg.eq.0 .and.navg(iseq).ge.2 .and. iand(ndepth,16).ne.0) go to 50
900 return
900 close(24)
return
end subroutine decode
end module q65_decode

View File

@ -397,7 +397,6 @@ subroutine q65_dec_q012(s3,LL,snr2,dat4,idec,decoded)
read(c78,1060) apsymbols
endif
! print*,'a',ibwa,ibwb,maxiters,iimax
do ibw=ibwa,ibwb
b90=1.72**ibw
b90ts=b90/baud
@ -853,4 +852,55 @@ subroutine q65_hist(if0,msg0,dxcall,dxgrid)
900 return
end subroutine q65_hist
subroutine q65_hist2(msg0,callers,nhist2)
use types
parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode
character*37 msg0,msg
type(q3list) callers(MAX_CALLERS)
character*6 c6
character*4 g4
logical newcall,isgrid
isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. &
g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and. &
g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73'
msg=msg0
if(index(msg,'/').gt.0) goto 900 !Ignore messages withcompound calls
i0=index(msg,' R ')
if(i0.ge.7) msg=msg(1:i0)//msg(i0+3:)
i1=index(msg,' ')
c6=' '
g4=' '
if(i1.ge.4 .and. i1.le.13) then
i2=index(msg(i1+1:),' ') + i1
c6=msg(i1+1:i2-1) !Extract DX call
g4=msg(i2+1:i2+4) !Extract DX grid
endif
newcall=.true.
do i=1,nhist2
if(callers(i)%call .eq. c6) then
newcall=.false.
callers(i)%nsec=time()
exit
endif
enddo
if(newcall .and. isgrid(g4)) then
nhist2=nhist2+1
callers(nhist2)%call=c6
callers(nhist2)%grid=g4
callers(nhist2)%nsec=time()
rewind(24)
write(24) nhist2,callers(1:nhist2)
rewind(24)
endif
! print*,'c',nhist2,trim(msg),' ',c6,' ',g4
900 return
end subroutine q65_hist2
end module q65

View File

@ -0,0 +1,73 @@
subroutine q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2,codewords,ncw)
use types
parameter (MAX_NCW=206)
parameter (MAX_CALLERS=40) !For multiple q3 decodes in NA VHf Contest mode
character*12 mycall,hiscall
character*6 hisgrid
character*37 msg,msgsent
logical my_std,his_std
integer codewords(63,MAX_NCW)
integer itone(85)
integer isync(22)
integer time
type(q3list) callers(MAX_CALLERS)
data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/
! print*,'b nhist2:',nhist2
if(nhist2.ne.-99) return
ncw=0
if(hiscall(1:1).eq. ' ') return
call stdcall(mycall,my_std)
call stdcall(hiscall,his_std)
ncw=MAX_NCW
do i=1,ncw
msg=trim(mycall)//' '//trim(hiscall)
if(.not.my_std) then
if(i.eq.1 .or. i.ge.6) msg='<'//trim(mycall)//'> '//trim(hiscall)
if(i.ge.2 .and. i.le.4) msg=trim(mycall)//' <'//trim(hiscall)//'>'
else if(.not.his_std) then
if(i.le.4 .or. i.eq.6) msg='<'//trim(mycall)//'> '//trim(hiscall)
if(i.ge.7) msg=trim(mycall)//' <'//trim(hiscall)//'>'
endif
j0=len(trim(msg))+2
if(i.eq.2) msg(j0:j0+2)='RRR'
if(i.eq.3) msg(j0:j0+3)='RR73'
if(i.eq.4) msg(j0:j0+1)='73'
if(i.eq.5) then
if(his_std) msg='CQ '//trim(hiscall)//' '//hisgrid(1:4)
if(.not.his_std) msg='CQ '//trim(hiscall)
endif
if(i.eq.6 .and. his_std) msg(j0:j0+3)=hisgrid(1:4)
if(i.ge.7 .and. i.le.206) then
isnr = -50 + (i-7)/2
if(iand(i,1).eq.1) then
write(msg(j0:j0+2),'(i3.2)') isnr
if(msg(j0:j0).eq.' ') msg(j0:j0)='+'
else
write(msg(j0:j0+3),'("R",i3.2)') isnr
if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+'
endif
endif
call genq65(msg,0,msgsent,itone,i3,n3)
i0=1
j=0
do k=1,85
if(k.eq.isync(i0)) then
i0=i0+1
cycle
endif
j=j+1
codewords(j,i)=itone(k) - 1
enddo
! write(71,3001) i,isnr,codewords(1:13,i),trim(msg)
!3001 format(i3,2x,i3.2,2x,13i3,2x,a)
enddo
! print*,'aa',ncontest,ncw,1970.0 + time()/(365.25*86400.0)
return
end subroutine q65_set_list2

View File

@ -7,4 +7,10 @@ module types
integer, parameter :: dp = REAL64
integer, parameter :: qp = REAL128
type q3list
character*6 call
character*4 grid
integer nsec
end type q3list
end module types

View File

@ -3314,7 +3314,9 @@ void MainWindow::decode() //decode()
dec_data.params.ndiskdat=0;
if(m_diskData) dec_data.params.ndiskdat=1;
dec_data.params.nfa=m_wideGraph->nStartFreq();
dec_data.params.nfSplit=m_wideGraph->Fmin();
dec_data.params.nfSplit=m_wideGraph->Fmin(); // Not used any more?
if(dec_data.params.nfSplit==8) dec_data.params.nfSplit=1;
dec_data.params.nfb=m_wideGraph->Fmax();
if(m_mode=="FT8" and SpecOp::HOUND == m_specOp and !ui->cbRxAll->isChecked()) dec_data.params.nfb=1000;
if(m_mode=="FT8" and SpecOp::FOX == m_specOp ) dec_data.params.nfqso=200;
@ -3370,7 +3372,8 @@ void MainWindow::decode() //decode()
dec_data.params.emedelay=0.0;
if(m_config.decode_at_52s()) dec_data.params.emedelay=2.5;
dec_data.params.minSync=ui->syncSpinBox->isVisible () ? m_minSync : 0;
dec_data.params.nexp_decode = static_cast<int> (m_specOp);
dec_data.params.nexp_decode=int(m_specOp);
if(dec_data.params.nexp_decode==8) dec_data.params.nexp_decode=1; //NA VHF and ARRL Digi are same
if(m_config.single_decode()) dec_data.params.nexp_decode += 32;
if(m_config.enable_VHF_features()) dec_data.params.nexp_decode += 64;
if(m_mode.startsWith("FST4")) dec_data.params.nexp_decode += 256*(ui->sbNB->value()+3);
@ -4874,8 +4877,7 @@ void MainWindow::guiUpdate()
//Once per second (onesec)
if(nsec != m_sec0) {
// qDebug() << "AAA" << nsec%60 << ipc_qmap[0] << ipc_qmap[1] << ipc_qmap[2]
// << ipc_qmap[3] << ipc_qmap[4] << m_fetched;
// qDebug() << "AAA" << nsec%60 << int(m_specOp);
if(m_mode=="FST4") chk_FST4_freq_range();
m_currentBand=m_config.bands()->find(m_freqNominal);