w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2025-08-03 14:42:25 -04:00
Code Issues Packages Projects Releases Wiki Activity

Extend write_ref() to compute freq offset and Doppler spread. Also some minor code cleanup.

Browse Source
This commit is contained in:
Joe Taylor 2020-07-15 15:50:17 -04:00
parent ff0d31986f
commit b3882a93c0
2 changed files with 65 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lib/decoder.f90
View File

@ -196,9 +196,8 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
call my_fst240%decode(fst240_decoded,id2,params%nutc, & call my_fst240%decode(fst240_decoded,id2,params%nutc, &
params%nQSOProgress,params%nfqso,params%nfa,params%nfb, & params%nQSOProgress,params%nfqso,params%nfa,params%nfb, &
params%nsubmode,ndepth,params%ntr,params%nexp_decode, & params%nsubmode,ndepth,params%ntr,params%nexp_decode, &
params%ntol,params%nzhsym,params%emedelay, & params%ntol,params%emedelay, &
logical(params%lapcqonly),params%napwid,mycall,hiscall, & logical(params%lapcqonly),mycall,hiscall,params%nfsplit,iwspr)
params%nfsplit,iwspr)
call timer('dec240 ',1) call timer('dec240 ',1)
go to 800 go to 800
endif endif
@ -211,9 +210,8 @@ subroutine multimode_decoder(ss,id2,params,nfsample)
call my_fst240%decode(fst240_decoded,id2,params%nutc, & call my_fst240%decode(fst240_decoded,id2,params%nutc, &
params%nQSOProgress,params%nfqso,params%nfa,params%nfb, & params%nQSOProgress,params%nfqso,params%nfa,params%nfb, &
params%nsubmode,ndepth,params%ntr,params%nexp_decode, & params%nsubmode,ndepth,params%ntr,params%nexp_decode, &
params%ntol,params%nzhsym,params%emedelay, & params%ntol,params%emedelay, &
logical(params%lapcqonly),params%napwid,mycall,hiscall, & logical(params%lapcqonly),mycall,hiscall,params%nfsplit,iwspr)
params%nfsplit,iwspr)
call timer('dec240 ',1) call timer('dec240 ',1)
go to 800 go to 800
endif endif
@ -700,7 +698,7 @@ contains
end subroutine ft4_decoded end subroutine ft4_decoded
subroutine fst240_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, & subroutine fst240_decoded (this,nutc,sync,nsnr,dt,freq,decoded,nap, &
qual,ntrperiod,lwspr) qual,ntrperiod,lwspr,fmid,w50)
use fst240_decode use fst240_decode
implicit none implicit none
@ -716,6 +714,8 @@ contains
real, intent(in) :: qual real, intent(in) :: qual
integer, intent(in) :: ntrperiod integer, intent(in) :: ntrperiod
logical, intent(in) :: lwspr logical, intent(in) :: lwspr
real, intent(in) :: fmid
real, intent(in) :: w50
character*2 annot character*2 annot
character*37 decoded0 character*37 decoded0
@ -733,8 +733,9 @@ contains
write(13,1002) 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,' FST240') 1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' FST240')
else else
if(fmid.ne.-999.0) write(decoded0(16:21),'(f6.3)') w50
write(*,1003) nutc,nsnr,dt,nint(freq),decoded0,annot write(*,1003) nutc,nsnr,dt,nint(freq),decoded0,annot
1003 format(i4.4,i4,f5.1,i5,' ` ',1x,a37,1x,a2) 1003 format(i4.4,i4,f5.1,i5,' ` ',1x,a37,1x,a2,2f7.3)
write(13,1004) nutc,nint(sync),nsnr,dt,freq,0,decoded0 write(13,1004) nutc,nint(sync),nsnr,dt,freq,0,decoded0
1004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' FST240') 1004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' FST240')
endif endif

69
lib/fst240_decode.f90
View File

@ -8,7 +8,7 @@ module fst240_decode
abstract interface abstract interface
subroutine fst240_decode_callback (this,nutc,sync,nsnr,dt,freq, & subroutine fst240_decode_callback (this,nutc,sync,nsnr,dt,freq, &
decoded,nap,qual,ntrperiod,lwspr) decoded,nap,qual,ntrperiod,lwspr,fmid,w50)
import fst240_decoder import fst240_decoder
implicit none implicit none
class(fst240_decoder), intent(inout) :: this class(fst240_decoder), intent(inout) :: this
@ -22,14 +22,16 @@ module fst240_decode
real, intent(in) :: qual real, intent(in) :: qual
integer, intent(in) :: ntrperiod integer, intent(in) :: ntrperiod
logical, intent(in) :: lwspr logical, intent(in) :: lwspr
real, intent(in) :: fmid
real, intent(in) :: w50
end subroutine fst240_decode_callback end subroutine fst240_decode_callback
end interface end interface
contains contains
subroutine decode(this,callback,iwave,nutc,nQSOProgress,nfqso, & subroutine decode(this,callback,iwave,nutc,nQSOProgress,nfqso, &
nfa,nfb,nsubmode,ndepth,ntrperiod,nexp_decode,ntol,nzhsym, & nfa,nfb,nsubmode,ndepth,ntrperiod,nexp_decode,ntol, &
emedelay,lapcqonly,napwid,mycall,hiscall,nfsplit,iwspr) emedelay,lapcqonly,mycall,hiscall,nfsplit,iwspr)
use timer_module, only: timer use timer_module, only: timer
use packjt77 use packjt77
@ -548,9 +550,10 @@ contains
call get_fst240_tones_from_bits(message74,itone,1) call get_fst240_tones_from_bits(message74,itone,1)
endif endif
inquire(file='plotspec',exist=ex) inquire(file='plotspec',exist=ex)
fmid=-999.0
if(ex) then if(ex) then
call write_ref(itone,iwave,nsps,nmax,ndown,hmod, & call write_ref(itone,iwave,nsps,nmax,ndown,hmod, &
isbest,fc_synced) isbest,fc_synced,fmid,w50)
endif endif
xsig=0 xsig=0
do i=1,NN do i=1,NN
@ -572,7 +575,7 @@ contains
! nutc,icand,itry,nsyncoh,iaptype,ijitter,ntype,nsync_qual,nharderrors,dmin,sync,xsnr,xdt,fsig,msg ! nutc,icand,itry,nsyncoh,iaptype,ijitter,ntype,nsync_qual,nharderrors,dmin,sync,xsnr,xdt,fsig,msg
! flush(21) ! flush(21)
call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, &
iaptype,qual,ntrperiod,lwspr) iaptype,qual,ntrperiod,lwspr,fmid,w50)
goto 2002 goto 2002
endif endif
enddo ! metrics enddo ! metrics
@ -807,9 +810,10 @@ contains
return return
end subroutine get_candidates_fst240 end subroutine get_candidates_fst240
subroutine write_ref(itone,iwave,nsps,nmax,ndown,hmod,i0,fc) subroutine write_ref(itone,iwave,nsps,nmax,ndown,hmod,i0,fc,fmid,w50)
complex cwave(nmax) complex cwave(nmax)
complex, allocatable :: c(:) complex, allocatable :: c(:)
real,allocatable :: ss(:)
integer itone(160) integer itone(160)
integer*2 iwave(nmax) integer*2 iwave(nmax)
integer hmod integer hmod
@ -821,6 +825,7 @@ contains
wave=0 wave=0
fsample=12000.0 fsample=12000.0
nsym=160 nsym=160
call gen_fst240wave(itone,nsym,nsps,nmax,fsample,hmod,fc, & call gen_fst240wave(itone,nsym,nsps,nmax,fsample,hmod,fc, &
1,cwave,wave) 1,cwave,wave)
cwave=cshift(cwave,-i0*ndown) cwave=cshift(cwave,-i0*ndown)
@ -832,26 +837,60 @@ contains
fac=1.0/32768 fac=1.0/32768
c=fac*float(iwave)*conjg(cwave) c=fac*float(iwave)*conjg(cwave)
call four2a(c,nmax,1,-1,1) !Forward c2c FFT call four2a(c,nmax,1,-1,1) !Forward c2c FFT
df=12000.0/nmax df=12000.0/nmax
ia=-10.1/df ia=1.0/df
ib=10.1/df
smax=0. smax=0.
do i=ia,ib do i=-ia,ia
j=i j=i
if(j.lt.0) j=i+nmax if(j.lt.0) j=i+nmax
s=real(c(j))**2 + aimag(c(j))**2 s=real(c(j))**2 + aimag(c(j))**2
smax=max(s,smax) smax=max(s,smax)
enddo enddo
do i=ia,ib ia=10.1/df
allocate(ss(-ia:ia))
sum1=0.
sum2=0.
ns=0
do i=-ia,ia
j=i j=i
if(j.lt.0) j=i+nmax if(j.lt.0) j=i+nmax
s=(real(c(j))**2 + aimag(c(j))**2)/smax ss(i)=(real(c(j))**2 + aimag(c(j))**2)/smax
s=s + ncall-1
f=i*df f=i*df
write(52,1010) f,s,db(s) if(f.ge.-4.0 .and. f.le.-2.0) then
1010 format(f12.6,f12.6,f10.3) sum1=sum1 + ss(i)
ns=ns+1
else if(f.ge.2.0 .and. f.le.4.0) then
sum2=sum2 + ss(i)
endif
enddo enddo
! close(52) avg=min(sum1/ns,sum2/ns)
sum1=0.
do i=-ia,ia
f=i*df
if(abs(f).le.1.0) sum1=sum1 + ss(i)-avg
y=0.99*ss(i) + ncall-1
write(52,1010) f,y
1010 format(f12.6,f12.6)
enddo
ia=nint(1.0/df)
sum2=0.0
i1=-999
i2=-999
i3=-999
do i=-ia,ia
sum2=sum2 + ss(i)-avg
if(sum2.ge.0.25*sum1 .and. i1.eq.-999) i1=i
if(sum2.ge.0.50*sum1 .and. i2.eq.-999) i2=i
if(sum2.ge.0.75*sum1) then
i3=i
exit
endif
enddo
fmid=i2*df
w50=(i3-i1+1)*df
return return
end subroutine write_ref end subroutine write_ref