mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2025-09-01 12:47:55 -04:00
Send nutc to the fst280 decoder, and use it. Also some code cleanup.
This commit is contained in:
parent
ea439f77ab
commit
5569700980
@ -190,8 +190,9 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
|
|||||||
if(params%nmode.eq.280) then
|
if(params%nmode.eq.280) then
|
||||||
! We're in FST280/FST280W mode
|
! We're in FST280/FST280W mode
|
||||||
call timer('dec280 ',0)
|
call timer('dec280 ',0)
|
||||||
call my_fst280%decode(fst280_decoded,id2,params%nQSOProgress, &
|
call my_fst280%decode(fst280_decoded,id2,params%nutc, &
|
||||||
params%nfqso,params%nfa,params%nfb,params%ndepth,params%ntr)
|
params%nQSOProgress,params%nfqso,params%nfa,params%nfb, &
|
||||||
|
params%ndepth,params%ntr)
|
||||||
call timer('dec280 ',1)
|
call timer('dec280 ',1)
|
||||||
go to 800
|
go to 800
|
||||||
endif
|
endif
|
||||||
@ -677,12 +678,13 @@ contains
|
|||||||
return
|
return
|
||||||
end subroutine ft4_decoded
|
end subroutine ft4_decoded
|
||||||
|
|
||||||
subroutine fst280_decoded (this,sync,nsnr,dt,freq,decoded,nap,qual)
|
subroutine fst280_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap,qual)
|
||||||
|
|
||||||
use fst280_decode
|
use fst280_decode
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
class(fst280_decoder), intent(inout) :: this
|
class(fst280_decoder), intent(inout) :: this
|
||||||
|
integer, intent(in) :: nutc
|
||||||
real, intent(in) :: sync
|
real, intent(in) :: sync
|
||||||
integer, intent(in) :: nsnr
|
integer, intent(in) :: nsnr
|
||||||
real, intent(in) :: dt
|
real, intent(in) :: dt
|
||||||
@ -700,9 +702,9 @@ contains
|
|||||||
if(qual.lt.0.17) decoded0(37:37)='?'
|
if(qual.lt.0.17) decoded0(37:37)='?'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
write(*,1001) params%nutc,nsnr,dt,nint(freq),decoded0,annot
|
write(*,1001) nutc,nsnr,dt,nint(freq),decoded0,annot
|
||||||
1001 format(i6.6,i4,f5.1,i5,' + ',1x,a37,1x,a2)
|
1001 format(i6.6,i4,f5.1,i5,' ` ',1x,a37,1x,a2)
|
||||||
write(13,1002) params%nutc,nint(sync),nsnr,dt,freq,0,decoded0
|
write(13,1002) nutc,nint(sync),nsnr,dt,freq,0,decoded0
|
||||||
1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FST280')
|
1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FST280')
|
||||||
|
|
||||||
call flush(6)
|
call flush(6)
|
||||||
|
@ -7,12 +7,14 @@ module fst280_decode
|
|||||||
end type fst280_decoder
|
end type fst280_decoder
|
||||||
|
|
||||||
abstract interface
|
abstract interface
|
||||||
subroutine fst280_decode_callback (this,sync,snr,dt,freq,decoded,nap,qual)
|
subroutine fst280_decode_callback (this,nutc,sync,nsnr,dt,freq, &
|
||||||
|
decoded,nap,qual)
|
||||||
import fst280_decoder
|
import fst280_decoder
|
||||||
implicit none
|
implicit none
|
||||||
class(fst280_decoder), intent(inout) :: this
|
class(fst280_decoder), intent(inout) :: this
|
||||||
|
integer, intent(in) :: nutc
|
||||||
real, intent(in) :: sync
|
real, intent(in) :: sync
|
||||||
integer, intent(in) :: snr
|
integer, intent(in) :: nsnr
|
||||||
real, intent(in) :: dt
|
real, intent(in) :: dt
|
||||||
real, intent(in) :: freq
|
real, intent(in) :: freq
|
||||||
character(len=37), intent(in) :: decoded
|
character(len=37), intent(in) :: decoded
|
||||||
@ -23,8 +25,8 @@ module fst280_decode
|
|||||||
|
|
||||||
contains
|
contains
|
||||||
|
|
||||||
subroutine decode(this,callback,iwave,nQSOProgress,nfqso, &
|
subroutine decode(this,callback,iwave,nutc,nQSOProgress,nfqso, &
|
||||||
nfa,nfb,ndepth,ntrperiod)
|
nfa,nfb,ndeep,ntrperiod)
|
||||||
|
|
||||||
use timer_module, only: timer
|
use timer_module, only: timer
|
||||||
use packjt77
|
use packjt77
|
||||||
@ -33,18 +35,15 @@ contains
|
|||||||
class(fst280_decoder), intent(inout) :: this
|
class(fst280_decoder), intent(inout) :: this
|
||||||
procedure(fst280_decode_callback) :: callback
|
procedure(fst280_decode_callback) :: callback
|
||||||
character*37 msg
|
character*37 msg
|
||||||
character*120 data_dir
|
|
||||||
character*77 c77
|
character*77 c77
|
||||||
character*1 tr_designator
|
|
||||||
complex, allocatable :: c2(:)
|
complex, allocatable :: c2(:)
|
||||||
complex, allocatable :: cframe(:)
|
complex, allocatable :: cframe(:)
|
||||||
complex, allocatable :: c_bigfft(:) !Complex waveform
|
complex, allocatable :: c_bigfft(:) !Complex waveform
|
||||||
real, allocatable :: r_data(:)
|
real, allocatable :: r_data(:)
|
||||||
real*8 fMHz
|
|
||||||
real llr(280),llra(280),llrb(280),llrc(280),llrd(280)
|
real llr(280),llra(280),llrb(280),llrc(280),llrd(280)
|
||||||
real candidates(100,3)
|
real candidates(100,3)
|
||||||
real bitmetrics(328,4)
|
real bitmetrics(328,4)
|
||||||
integer hmod,ihdr(11)
|
integer hmod
|
||||||
integer*1 apmask(280),cw(280)
|
integer*1 apmask(280),cw(280)
|
||||||
integer*1 hbits(328)
|
integer*1 hbits(328)
|
||||||
integer*1 message101(101),message74(74)
|
integer*1 message101(101),message74(74)
|
||||||
@ -53,8 +52,8 @@ contains
|
|||||||
|
|
||||||
this%callback => callback
|
this%callback => callback
|
||||||
hmod=1 !### pass as arg ###
|
hmod=1 !### pass as arg ###
|
||||||
|
if(nfqso+nqsoprogress.eq.-999) return
|
||||||
Keff=91
|
Keff=91
|
||||||
ndeep=3
|
|
||||||
iwspr=0
|
iwspr=0
|
||||||
|
|
||||||
nmax=15*12000
|
nmax=15*12000
|
||||||
@ -100,11 +99,9 @@ contains
|
|||||||
allocate( c2(0:nfft2-1) )
|
allocate( c2(0:nfft2-1) )
|
||||||
allocate( cframe(0:164*nss-1) )
|
allocate( cframe(0:164*nss-1) )
|
||||||
|
|
||||||
ngood=0
|
|
||||||
ngoodsync=0
|
|
||||||
npts=nmax
|
npts=nmax
|
||||||
fa=100.0
|
fa=nfa
|
||||||
fb=3500.0
|
fb=nfb
|
||||||
|
|
||||||
! The big fft is done once and is used for calculating the smoothed spectrum
|
! The big fft is done once and is used for calculating the smoothed spectrum
|
||||||
! and also for downconverting/downsampling each candidate.
|
! and also for downconverting/downsampling each candidate.
|
||||||
@ -120,8 +117,8 @@ contains
|
|||||||
ndecodes=0
|
ndecodes=0
|
||||||
isbest1=0
|
isbest1=0
|
||||||
isbest8=0
|
isbest8=0
|
||||||
fc21=fc0
|
fc21=0.
|
||||||
fc28=fc0
|
fc28=0.
|
||||||
do icand=1,ncand
|
do icand=1,ncand
|
||||||
fc0=candidates(icand,1)
|
fc0=candidates(icand,1)
|
||||||
xsnr=candidates(icand,2)
|
xsnr=candidates(icand,2)
|
||||||
@ -192,10 +189,6 @@ contains
|
|||||||
dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2
|
dt_synced = (isbest-fs2)*dt2 !nominal dt is 1 second so frame starts at sample fs2
|
||||||
|
|
||||||
call fst280_downsample(c_bigfft,nfft1,ndown,fc_synced,c2)
|
call fst280_downsample(c_bigfft,nfft1,ndown,fc_synced,c2)
|
||||||
|
|
||||||
if(abs((isbest-fs2)/nss) .lt. 0.2 .and. abs(fc_synced-1500.0).lt.0.4) then
|
|
||||||
ngoodsync=ngoodsync+1
|
|
||||||
endif
|
|
||||||
|
|
||||||
do ijitter=0,2
|
do ijitter=0,2
|
||||||
if(ijitter.eq.0) ioffset=0
|
if(ijitter.eq.0) ioffset=0
|
||||||
@ -265,15 +258,11 @@ contains
|
|||||||
call unpack77(c77,0,msg,unpk77_success)
|
call unpack77(c77,0,msg,unpk77_success)
|
||||||
endif
|
endif
|
||||||
if(nharderrors .ge.0 .and. unpk77_success) then
|
if(nharderrors .ge.0 .and. unpk77_success) then
|
||||||
ngood=ngood+1
|
|
||||||
! write(*,1100) 0,nint(xsnr),dt_synced,nint(fc_synced), &
|
|
||||||
! msg(1:22)
|
|
||||||
! 1100 format(i6.6,i5,f5.1,i5,' `',1x,a22)
|
|
||||||
|
|
||||||
nsnr=nint(xsnr)
|
nsnr=nint(xsnr)
|
||||||
iaptype=0
|
iaptype=0
|
||||||
qual=0.
|
qual=0.
|
||||||
call this%callback(smax1,nsnr,xdt,fc_synced,msg,iaptype,qual)
|
call this%callback(nutc,smax1,nsnr,xdt,fc_synced,msg, &
|
||||||
|
iaptype,qual)
|
||||||
goto 2002
|
goto 2002
|
||||||
else
|
else
|
||||||
cycle
|
cycle
|
||||||
@ -416,7 +405,6 @@ contains
|
|||||||
s2(i)=s(i-nh*3) + s(i-nh) +s(i+nh) +s(i+nh*3)
|
s2(i)=s(i-nh*3) + s(i-nh) +s(i+nh) +s(i+nh*3)
|
||||||
s2(i)=db(s2(i)) - 48.5
|
s2(i)=db(s2(i)) - 48.5
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
|
||||||
if(hmod.eq.1) thresh=-29.5 !### temporaray? ###
|
if(hmod.eq.1) thresh=-29.5 !### temporaray? ###
|
||||||
if(hmod.eq.2) thresh=-27.0
|
if(hmod.eq.2) thresh=-27.0
|
||||||
|
Loading…
x
Reference in New Issue
Block a user