mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2025-03-21 03:28:59 -04:00
Working toward 'q3list' decoding for NA VHF Contest mode. More still needed!
This commit is contained in:
parent
8db7c2c128
commit
88798f1ca3
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
73
lib/qra/q65/q65_set_list2.f90
Normal file
73
lib/qra/q65/q65_set_list2.f90
Normal 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
|
@ -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
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user