Restructuring in preparation for direct decoder invocation from wsjtx

Re-factor the JT4, JT65 and JT9 decoders as Fortran modules using type
bound  procedures, the  decoder types  implement a  callback procedure
such that he client of the decoder can interpret the decode results as
they need.

The JT4 decoder has a  second callback that delivers message averaging
status.  Also the  previously separate  source files  lib/jt4a.f90 and
lib/avg4.f90 have been merged  into lib/jt4_decode.f90 as private type
bound procedures of the new jt4_decoder type.

Re-factored the lib/decoder.f90 subroutine  to utilize the new decoder
types. Added local procedures to process decodes and averaging results
including the necessary OpenMP synchronization directives for parallel
JT9+JT65 decoding.

Added the  jt65_test module  which is  a basic  test harness  for JT65
decoding. Re-factored  the jt65 utility  to utilize the  new jt65_test
module.

Changed a  few integers  to logical variables  where their  meaning is
clearly binary.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@6324 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Bill Somerville 2015-12-29 23:52:55 +00:00
parent d6457af36e
commit d431e2cecd
15 changed files with 1040 additions and 737 deletions

View File

@ -275,7 +275,6 @@ set (wsjt_FSRCS
lib/astrosub.f90 lib/astrosub.f90
lib/astro0.f90 lib/astro0.f90
lib/avecho.f90 lib/avecho.f90
lib/avg4.f90
lib/azdist.f90 lib/azdist.f90
lib/baddata.f90 lib/baddata.f90
lib/ccf2.f90 lib/ccf2.f90
@ -350,7 +349,6 @@ set (wsjt_FSRCS
lib/jplsubs.f lib/jplsubs.f
lib/jt4.f90 lib/jt4.f90
lib/jt4_decode.f90 lib/jt4_decode.f90
lib/jt4a.f90
lib/jt65_decode.f90 lib/jt65_decode.f90
lib/jt9_decode.f90 lib/jt9_decode.f90
lib/jt9fano.f90 lib/jt9fano.f90
@ -942,7 +940,7 @@ add_executable (wsprsim ${wsprsim_CSRCS})
add_executable (jt4code lib/jt4code.f90 wsjtx.rc) add_executable (jt4code lib/jt4code.f90 wsjtx.rc)
target_link_libraries (jt4code wsjt_fort wsjt_cxx) target_link_libraries (jt4code wsjt_fort wsjt_cxx)
add_executable (jt65 lib/jt65.f90 ${jt65_CXXSRCS} wsjtx.rc) add_executable (jt65 lib/jt65.f90 lib/jt65_test.f90 wsjtx.rc)
target_link_libraries (jt65 wsjt_fort wsjt_cxx ${FFTW3_LIBRARIES}) target_link_libraries (jt65 wsjt_fort wsjt_cxx ${FFTW3_LIBRARIES})
add_executable (jt9 lib/jt9.f90 lib/jt9a.f90 ${jt9_CXXSRCS} wsjtx.rc) add_executable (jt9 lib/jt9.f90 lib/jt9a.f90 ${jt9_CXXSRCS} wsjtx.rc)

View File

@ -6,7 +6,10 @@
#define RX_SAMPLE_RATE 12000 #define RX_SAMPLE_RATE 12000
#ifdef __cplusplus #ifdef __cplusplus
#include <cstdbool>
extern "C" { extern "C" {
#else
#include <stdbool.h>
#endif #endif
/* /*
@ -20,10 +23,10 @@ extern struct dec_data {
struct struct
{ {
int nutc; //UTC as integer, HHMM int nutc; //UTC as integer, HHMM
int ndiskdat; //1 ==> data read from *.wav file bool ndiskdat; //true ==> data read from *.wav file
int ntrperiod; //TR period (seconds) int ntrperiod; //TR period (seconds)
int nfqso; //User-selected QSO freq (kHz) int nfqso; //User-selected QSO freq (kHz)
int newdat; //1 ==> new data, must do long FFT bool newdat; //true ==> new data, must do long FFT
int npts8; //npts for c0() array int npts8; //npts for c0() array
int nfa; //Low decode limit (Hz) int nfa; //Low decode limit (Hz)
int nfSplit; //JT65 | JT9 split frequency int nfSplit; //JT65 | JT9 split frequency
@ -32,7 +35,7 @@ extern struct dec_data {
int kin; int kin;
int nzhsym; int nzhsym;
int nsubmode; int nsubmode;
int nagain; bool nagain;
int ndepth; int ndepth;
int ntxmode; int ntxmode;
int nmode; int nmode;
@ -46,7 +49,7 @@ extern struct dec_data {
int n2pass; int n2pass;
int nranera; int nranera;
int naggressive; int naggressive;
int nrobust; bool nrobust;
int nexp_decode; int nexp_decode;
char datetime[20]; char datetime[20];
char mycall[12]; char mycall[12];

View File

@ -1,140 +1,2 @@
subroutine avg4(nutc,snrsync,dtxx,flip,nfreq,mode4,ntol,ndepth,neme, & ! The contents of this file have been migrated to lib/jt4_decode.f90
mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ichbest,ndeepave)
! Decodes averaged JT4 data
use jt4
character*22 avemsg,deepave,deepbest
character mycall*12,hiscall*12,hisgrid*6
character*1 csync,cused(64)
real sym(207,7)
integer iused(64)
logical first
data first/.true./
save
if(first) then
iutc=-1
nfsave=0
dtdiff=0.2
first=.false.
endif
do i=1,64
if(nutc.eq.iutc(i) .and. abs(nhz-nfsave(i)).le.ntol) go to 10
enddo
! Save data for message averaging
iutc(nsave)=nutc
syncsave(nsave)=snrsync
dtsave(nsave)=dtxx
nfsave(nsave)=nfreq
flipsave(nsave)=flip
ppsave(1:207,1:7,nsave)=rsymbol(1:207,1:7)
10 sym=0.
syncsum=0.
dtsum=0.
nfsum=0
nsum=0
do i=1,64
cused(i)='.'
if(iutc(i).lt.0) cycle
if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same (odd/even) sequence
if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match
if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match
if(flip.ne.flipsave(i)) cycle !Sync (*/#) must match
sym(1:207,1:7)=sym(1:207,1:7) + ppsave(1:207,1:7,i)
syncsum=syncsum + syncsave(i)
dtsum=dtsum + dtsave(i)
nfsum=nfsum + nfsave(i)
cused(i)='$'
nsum=nsum+1
iused(nsum)=i
enddo
if(nsum.lt.64) iused(nsum+1)=0
syncave=0.
dtave=0.
fave=0.
if(nsum.gt.0) then
sym=sym/nsum
syncave=syncsum/nsum
dtave=dtsum/nsum
fave=float(nfsum)/nsum
endif
! rewind 80
do i=1,nsave
csync='*'
if(flipsave(i).lt.0.0) csync='#'
write(14,1000) cused(i),iutc(i),syncsave(i)-5.0,dtsave(i),nfsave(i),csync
1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1)
enddo
sqt=0.
sqf=0.
do j=1,64
i=iused(j)
if(i.eq.0) exit
csync='*'
if(flipsave(i).lt.0.0) csync='#'
! write(80,3001) i,iutc(i),syncsave(i),dtsave(i),nfsave(i),csync
!3001 format(i3,i6.4,f6.1,f6.2,i6,1x,a1)
sqt=sqt + (dtsave(i)-dtave)**2
sqf=sqf + (nfsave(i)-fave)**2
enddo
rmst=0.
rmsf=0.
if(nsum.ge.2) then
rmst=sqrt(sqt/(nsum-1))
rmsf=sqrt(sqf/(nsum-1))
endif
! write(80,3002)
!3002 format(16x,'----- -----')
! write(80,3003) dtave,nint(fave)
! write(80,3003) rmst,nint(rmsf)
!3003 format(15x,f6.2,i6)
! flush(80)
! nadd=nused*mode4
kbest=ich1
do k=ich1,ich2
call extract4(sym(1,k),ncount,avemsg) !Do the Fano decode
nfanoave=0
if(ncount.ge.0) then
ichbest=k
nfanoave=nsum
go to 900
endif
if(nch(k).ge.mode4) exit
enddo
deepave=' '
qave=0.
! Possibly should pass nadd=nused, also ?
if(ndepth.ge.3) then
flipx=1.0 !Normal flip not relevant for ave msg
qbest=0.
do k=ich1,ich2
call deep4(sym(2,k),neme,flipx,mycall,hiscall,hisgrid,deepave,qave)
! write(82,3101) nutc,sym(51:53,k),flipx,k,qave,deepave
!3101 format(i4.4,4f8.1,i3,f7.2,2x,a22)
if(qave.gt.qbest) then
qbest=qave
deepbest=deepave
kbest=k
ndeepave=nsum
endif
if(nch(k).ge.mode4) exit
enddo
deepave=deepbest
qave=qbest
ichbest=kbest
endif
900 return
end subroutine avg4

View File

@ -1,46 +1,64 @@
subroutine decoder(ss,id2,params,nfsample) subroutine multimode_decoder(ss,id2,params,nfsample)
!$ use omp_lib !$ use omp_lib
use prog_args use prog_args
use timer_module, only: timer use timer_module, only: timer
use jt4_decode
use jt65_decode
use jt9_decode
include 'jt9com.f90' include 'jt9com.f90'
include 'timer_common.inc' include 'timer_common.inc'
type, extends(jt4_decoder) :: counting_jt4_decoder
integer :: decoded
end type counting_jt4_decoder
type, extends(jt65_decoder) :: counting_jt65_decoder
integer :: decoded
end type counting_jt65_decoder
type, extends(jt9_decoder) :: counting_jt9_decoder
integer :: decoded
end type counting_jt9_decoder
real ss(184,NSMAX) real ss(184,NSMAX)
logical baddata logical baddata,newdat65,newdat9
integer*2 id2(NTMAX*12000) integer*2 id2(NTMAX*12000)
type(params_block) :: params type(params_block) :: params
real*4 dd(NTMAX*12000) real*4 dd(NTMAX*12000)
save save
type(counting_jt4_decoder) :: my_jt4
type(counting_jt65_decoder) :: my_jt65
type(counting_jt9_decoder) :: my_jt9
if(mod(params%nranera,2).eq.0) ntrials=10**(params%nranera/2) if(mod(params%nranera,2).eq.0) ntrials=10**(params%nranera/2)
if(mod(params%nranera,2).eq.1) ntrials=3*10**(params%nranera/2) if(mod(params%nranera,2).eq.1) ntrials=3*10**(params%nranera/2)
if(params%nranera.eq.0) ntrials=0 if(params%nranera.eq.0) ntrials=0
rms=sqrt(dot_product(float(id2(300000:310000)), & rms=sqrt(dot_product(float(id2(300000:310000)), &
float(id2(300000:310000)))/10000.0) float(id2(300000:310000)))/10000.0)
if(rms.lt.2.0) go to 800 if(rms.lt.2.0) go to 800
if (params%nagain .eq. 0) then if (params%nagain) then
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown') open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown', &
else
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown', &
position='append') position='append')
else
open(13,file=trim(temp_dir)//'/decoded.txt',status='unknown')
end if end if
if(params%nmode.eq.4 .or. params%nmode.eq.65) open(14,file=trim(temp_dir)//'/avemsg.txt', & if(params%nmode.eq.4 .or. params%nmode.eq.65) open(14,file=trim(temp_dir)//'/avemsg.txt', &
status='unknown') status='unknown')
if(params%nmode.eq.4) then if(params%nmode.eq.4) then
jz=52*nfsample jz=52*nfsample
if(params%newdat.ne.0) then if(params%newdat) then
if(nfsample.eq.12000) call wav11(id2,jz,dd) if(nfsample.eq.12000) call wav11(id2,jz,dd)
if(nfsample.eq.11025) dd(1:jz)=id2(1:jz) if(nfsample.eq.11025) dd(1:jz)=id2(1:jz)
endif endif
call jt4a(dd,jz,params%nutc,params%nfqso,params%ntol,params%emedelay,params%dttol, & call my_jt4%decode(jt4_decoded,dd,jz,params%nutc,params%nfqso,params%ntol, &
params%nagain,params%ndepth,params%nclearave,params%minsync,params%minw, & params%emedelay,params%dttol,logical(params%nagain),params%ndepth, &
params%nsubmode,params%mycall,params%hiscall,params%hisgrid, & params%nclearave,params%minsync,params%minw,params%nsubmode,params%mycall, &
params%nlist,params%listutc) params%hiscall,params%hisgrid,params%nlist,params%listutc,jt4_average)
go to 800 go to 800
endif endif
@ -55,52 +73,56 @@ subroutine decoder(ss,id2,params,nfsample)
newdat65=params%newdat newdat65=params%newdat
newdat9=params%newdat newdat9=params%newdat
!$ call omp_set_dynamic(.true.) !$call omp_set_dynamic(.true.)
!$omp parallel sections num_threads(2) copyin(/timer_private/) shared(ndecoded) if(.true.) !iif() needed on Mac !$omp parallel sections num_threads(2) copyin(/timer_private/) shared(ndecoded) if(.true.) !iif() needed on Mac
!$omp section !$omp section
if(params%nmode.eq.65 .or. (params%nmode.eq.(65+9) .and. params%ntxmode.eq.65)) then if(params%nmode.eq.65 .or. (params%nmode.eq.(65+9) .and. params%ntxmode.eq.65)) then
! We're in JT65 mode, or should do JT65 first ! We're in JT65 mode, or should do JT65 first
if(newdat65.ne.0) dd(1:npts65)=id2(1:npts65) if(newdat65) dd(1:npts65)=id2(1:npts65)
nf1=params%nfa nf1=params%nfa
nf2=params%nfb nf2=params%nfb
call timer('jt65a ',0) call timer('jt65a ',0)
call jt65a(dd,npts65,newdat65,params%nutc,nf1,nf2,params%nfqso,ntol65,params%nsubmode, & call my_jt65%decode(jt65_decoded,dd,npts65,newdat65,params%nutc,nf1,nf2,params%nfqso, &
params%minsync,params%nagain,params%n2pass,params%nrobust,ntrials,params%naggressive, & ntol65,params%nsubmode,params%minsync,logical(params%nagain),params%n2pass, &
params%ndepth,params%mycall,params%hiscall,params%hisgrid,params%nexp_decode,ndecoded) logical(params%nrobust),ntrials,params%naggressive,params%ndepth,params%mycall, &
params%hiscall,params%hisgrid,params%nexp_decode)
call timer('jt65a ',1) call timer('jt65a ',1)
else if(params%nmode.eq.9 .or. (params%nmode.eq.(65+9) .and. params%ntxmode.eq.9)) then else if(params%nmode.eq.9 .or. (params%nmode.eq.(65+9) .and. params%ntxmode.eq.9)) then
! We're in JT9 mode, or should do JT9 first ! We're in JT9 mode, or should do JT9 first
call timer('decjt9 ',0) call timer('decjt9 ',0)
call decjt9(ss,id2,params%nutc,params%nfqso,newdat9,params%npts8,params%nfa,params%nfsplit, & call my_jt9%decode(jt9_decoded,ss,id2,params%nutc,params%nfqso,newdat9,params%npts8, &
params%nfb,params%ntol,params%nzhsym,params%nagain,params%ndepth,params%nmode) params%nfa,params%nfsplit,params%nfb,params%ntol,params%nzhsym, &
logical(params%nagain),params%ndepth,params%nmode)
call timer('decjt9 ',1) call timer('decjt9 ',1)
endif endif
!$omp section !$omp section
if(params%nmode.eq.(65+9)) then !Do the other mode (we're in dual mode) if(params%nmode.eq.(65+9)) then !Do the other mode (we're in dual mode)
if (params%ntxmode.eq.9) then if (params%ntxmode.eq.9) then
if(newdat65.ne.0) dd(1:npts65)=id2(1:npts65) if(newdat65) dd(1:npts65)=id2(1:npts65)
nf1=params%nfa nf1=params%nfa
nf2=params%nfb nf2=params%nfb
call timer('jt65a ',0) call timer('jt65a ',0)
call jt65a(dd,npts65,newdat65,params%nutc,nf1,nf2,params%nfqso,ntol65,params%nsubmode, & call my_jt65%decode(jt65_decoded,dd,npts65,newdat65,params%nutc,nf1,nf2, &
params%minsync,params%nagain,params%n2pass,params%nrobust,ntrials, & params%nfqso,ntol65,params%nsubmode,params%minsync,logical(params%nagain), &
params%naggressive,params%ndepth,params%mycall,params%hiscall,params%hisgrid, & params%n2pass,logical(params%nrobust),ntrials,params%naggressive,params%ndepth,&
params%nexp_decode,ndecoded) params%mycall,params%hiscall,params%hisgrid,params%nexp_decode)
call timer('jt65a ',1) call timer('jt65a ',1)
else else
call timer('decjt9 ',0) call timer('decjt9 ',0)
call decjt9(ss,id2,params%nutc,params%nfqso,newdat9,params%npts8,params%nfa,params%nfsplit, & call my_jt9%decode(jt9_decoded,ss,id2,params%nutc,params%nfqso,newdat9,params%npts8,&
params%nfb,params%ntol,params%nzhsym,params%nagain,params%ndepth,params%nmode) params%nfa,params%nfsplit,params%nfb,params%ntol,params%nzhsym, &
logical(params%nagain),params%ndepth,params%nmode)
call timer('decjt9 ',1) call timer('decjt9 ',1)
end if end if
endif endif
!$omp end parallel sections !$omp end parallel sections
! JT65 is not yet producing info for nsynced, ndecoded. ! JT65 is not yet producing info for nsynced, ndecoded.
ndecoded = my_jt4%decoded + my_jt65%decoded + my_jt9%decoded
800 write(*,1010) nsynced,ndecoded 800 write(*,1010) nsynced,ndecoded
1010 format('<DecodeFinished>',2i4) 1010 format('<DecodeFinished>',2i4)
call flush(6) call flush(6)
@ -108,4 +130,130 @@ subroutine decoder(ss,id2,params,nfsample)
if(params%nmode.eq.4 .or. params%nmode.eq.65) close(14) if(params%nmode.eq.4 .or. params%nmode.eq.65) close(14)
return return
end subroutine decoder
contains
subroutine jt4_decoded (this, utc, snr, dt, freq, have_sync, sync, is_deep, decoded, qual,&
ich, is_average, ave)
implicit none
class(jt4_decoder), intent(inout) :: this
integer, intent(in) :: utc
integer, intent(in) :: snr
real, intent(in) :: dt
integer, intent(in) :: freq
logical, intent(in) :: have_sync
logical, intent(in) :: is_deep
character(len=1), intent(in) :: sync
character(len=22), intent(in) :: decoded
real, intent(in) :: qual
integer, intent(in) :: ich
logical, intent(in) :: is_average
integer, intent(in) :: ave
character*2 :: cqual
if (have_sync) then
if (int(qual).gt.0) then
write(cqual, '(i2)') int(qual)
if (ave.gt.0) then
write(*,1000) utc ,snr, dt, freq, sync, decoded, cqual, &
char(ichar('A')+ich-1), ave
else
write(*,1000) utc ,snr, dt, freq, sync, decoded, cqual, char(ichar('A')+ich-1)
end if
else
write(*,1000) utc ,snr, dt, freq, sync, decoded, ' *', char(ichar('A')+ich-1)
end if
else
write(*,1000) utc ,snr, dt, freq
end if
1000 format(i4.4,i4,f5.2,i5,1x,a1,1x,a22,a2,1x,a1,i3)
select type(this)
type is (counting_jt4_decoder)
this%decoded = this%decoded + 1
end select
end subroutine jt4_decoded
subroutine jt4_average (this, used, utc, sync, dt, freq, flip)
implicit none
class(jt4_decoder), intent(inout) :: this
logical, intent(in) :: used
integer, intent(in) :: utc
real, intent(in) :: sync
real, intent(in) :: dt
integer, intent(in) :: freq
logical, intent(in) :: flip
character(len=1) :: cused='.', csync='*'
if (used) cused = '$'
if (flip) csync = '$'
write(14,1000) cused,utc,sync,dt,freq,csync
1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1)
end subroutine jt4_average
subroutine jt65_decoded (this, utc, sync, snr, dt, freq, drift, decoded, ft, qual, &
candidates, tries, total_min, hard_min, aggression)
use jt65_decode
implicit none
class(jt65_decoder), intent(inout) :: this
integer, intent(in) :: utc
real, intent(in) :: sync
integer, intent(in) :: snr
real, intent(in) :: dt
integer, intent(in) :: freq
integer, intent(in) :: drift
character(len=22), intent(in) :: decoded
integer, intent(in) :: ft
integer, intent(in) :: qual
integer, intent(in) :: candidates
integer, intent(in) :: tries
integer, intent(in) :: total_min
integer, intent(in) :: hard_min
integer, intent(in) :: aggression
!$omp critical(decode_results)
write(*,1010) utc,snr,dt,freq,decoded
1010 format(i4.4,i4,f5.1,i5,1x,'#',1x,a22)
write(13,1012) utc,nint(sync),snr,dt,float(freq),drift,decoded,ft
1012 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT65',i4)
call flush(6)
! write(79,3001) utc,nint(sync),snr,dt,freq,candidates, &
write(79,3001) utc,sync,snr,dt,freq,candidates, &
hard_min,total_min,tries,aggression,ft,qual,decoded
3001 format(i4.4,f6.2,i4,f6.2,i5,i7,i3,i4,i8,i3,i2,i5,1x,a22)
!$omp end critical(decode_results)
select type(this)
type is (counting_jt65_decoder)
this%decoded = this%decoded + 1
end select
end subroutine jt65_decoded
subroutine jt9_decoded (this, utc, sync, snr, dt, freq, drift, decoded)
use jt9_decode
implicit none
class(jt9_decoder), intent(inout) :: this
integer, intent(in) :: utc
real, intent(in) :: sync
integer, intent(in) :: snr
real, intent(in) :: dt
real, intent(in) :: freq
integer, intent(in) :: drift
character(len=22), intent(in) :: decoded
!$omp critical(decode_results)
write(*,1000) utc,snr,dt,nint(freq),decoded
1000 format(i4.4,i4,f5.1,i5,1x,'@',1x,a22)
write(13,1002) utc,nint(sync),snr,dt,freq,drift,decoded
1002 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT9')
call flush(6)
!$omp end critical(decode_results)
select type(this)
type is (counting_jt9_decoder)
this%decoded = this%decoded + 1
end select
end subroutine jt9_decoded
end subroutine multimode_decoder

View File

@ -13,6 +13,7 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2)
parameter (NFFT1=653184,NFFT2=1512) parameter (NFFT1=653184,NFFT2=1512)
type(C_PTR) :: plan !Pointers plan for big FFT type(C_PTR) :: plan !Pointers plan for big FFT
integer*2 id2(0:8*npts8-1) integer*2 id2(0:8*npts8-1)
logical, intent(inout) :: newdat
real*4, pointer :: x1(:) real*4, pointer :: x1(:)
complex c1(0:NFFT1/2) complex c1(0:NFFT1/2)
complex c2(0:NFFT2-1) complex c2(0:NFFT2-1)
@ -46,7 +47,7 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2)
first=.false. first=.false.
endif endif
if(newdat.eq.1) then if(newdat) then
x1(0:npts-1)=id2(0:npts-1) x1(0:npts-1)=id2(0:npts-1)
x1(npts:NFFT1-1)=0. !Zero the rest of x1 x1(npts:NFFT1-1)=0. !Zero the rest of x1
call timer('FFTbig9 ',0) call timer('FFTbig9 ',0)
@ -62,7 +63,7 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2)
s(i)=s(i)+real(c1(j))**2 + aimag(c1(j))**2 s(i)=s(i)+real(c1(j))**2 + aimag(c1(j))**2
enddo enddo
enddo enddo
newdat=0 newdat=.false.
endif endif
ndown=8*nsps8/nspsd !Downsample factor = 432 ndown=8*nsps8/nspsd !Downsample factor = 432

View File

@ -1,182 +1,451 @@
subroutine wsjt4(dat,npts,nutc,NClearAve,minsync,ntol,emedelay,dttol, & module jt4_decode
mode4,minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme) type :: jt4_decoder
procedure(jt4_decode_callback), pointer :: decode_callback => null ()
procedure(jt4_average_callback), pointer :: average_callback => null ()
contains
procedure :: decode
procedure, private :: wsjt4, avg4
end type jt4_decoder
! Orchestrates the process of decoding JT4 messages, using data that !
! have been 2x downsampled. ! Callback function to be called with each decode
!
abstract interface
subroutine jt4_decode_callback (this, utc, snr, dt, freq, have_sync, &
sync, is_deep, decoded, qual, ich, is_average, ave)
import jt4_decoder
implicit none
class(jt4_decoder), intent(inout) :: this
integer, intent(in) :: utc
integer, intent(in) :: snr
real, intent(in) :: dt
integer, intent(in) :: freq
logical, intent(in) :: have_sync
logical, intent(in) :: is_deep
character(len=1), intent(in) :: sync
character(len=22), intent(in) :: decoded
real, intent(in) :: qual
integer, intent(in) :: ich
logical, intent(in) :: is_average
integer, intent(in) :: ave
end subroutine jt4_decode_callback
end interface
! NB: JT4 presently looks for only one decodable signal in the FTol !
! range -- analogous to the nqd=1 step in JT9 and JT65. ! Callback function to be called with each average result
!
abstract interface
subroutine jt4_average_callback (this, used, utc, sync, dt, freq, flip)
import jt4_decoder
implicit none
class(jt4_decoder), intent(inout) :: this
logical, intent(in) :: used
integer, intent(in) :: utc
real, intent(in) :: sync
real, intent(in) :: dt
integer, intent(in) :: freq
logical, intent(in) :: flip
end subroutine jt4_average_callback
end interface
use jt4 contains
use timer_module, only: timer
real dat(npts) !Raw data subroutine decode(this,decode_callback,dd,jz,nutc,nfqso,ntol0,emedelay, &
real z(458,65) dttol,nagain,ndepth,nclearave,minsync,minw,nsubmode,mycall,hiscall, &
logical first,prtavg hisgrid,nlist0,listutc0,average_callback)
character decoded*22,special*5
character*22 avemsg,deepmsg,deepave,blank,deepmsg0,deepave1
character csync*1,cqual*2
character*12 mycall
character*12 hiscall
character*6 hisgrid
data first/.true./,nutc0/-999/,nfreq0/-999999/
save
if(first) then use jt4
nsave=0 use timer_module, only: timer
first=.false.
blank=' '
ccfblue=0.
ccfred=0.
nagain=0
endif
zz=0. class(jt4_decoder), intent(inout) :: this
syncmin=3.0 + minsync procedure(jt4_decode_callback) :: decode_callback
naggressive=0 integer, intent(in) :: jz,nutc,nfqso,ntol0,ndepth,nclearave, &
if(ndepth.ge.2) naggressive=1 minsync,minw,nsubmode,nlist0,listutc0(10)
nq1=3 real, intent(in) :: dd(jz),emedelay,dttol
nq2=6 logical, intent(in) :: nagain
if(naggressive.eq.1) nq1=1 character(len=12), intent(in) :: mycall,hiscall
if(NClearAve.ne.0) then character(len=6), intent(in) :: hisgrid
nsave=0 procedure(jt4_average_callback), optional :: average_callback
iutc=-1
nfsave=0.
listutc=0
ppsave=0.
rsymbol=0.
dtsave=0.
syncsave=0.
nfanoave=0
ndeepave=0
endif
! Attempt to synchronize: look for sync pattern, get DF and DT. real*4 dat(30*12000)
call timer('sync4 ',0) character*6 cfile6
call sync4(dat,npts,mode4,minw)
call timer('sync4 ',1)
call timer('zplt ',0) this%decode_callback => decode_callback
do ich=4,7 if (present (average_callback)) then
z(1:458,1:65)=zz(274:731,1:65,ich) this%average_callback => average_callback
call zplt(z,ich-4,syncz,dtxz,nfreqz,flipz,sync2z,0,emedelay,dttol, & end if
nfqso,ntol) mode4=nch(nsubmode+1)
if(ich.eq.5) then ntol=ntol0
dtxzz=dtxz neme=0
nfreqzz=nfreqz lumsg=6 !### temp ? ###
endif ndiag=1
enddo nlist=nlist0
call timer('zplt ',1) listutc=listutc0
! Use results from zplt ! Lowpass filter and decimate by 2
flip=flipz call timer('lpf1 ',0)
sync=syncz call lpf1(dd,jz,dat,jz2)
snrx=db(sync) - 26. call timer('lpf1 ',1)
nsnr=nint(snrx)
if(sync.lt.syncmin) then
write(*,1010) nutc,nsnr,dtxz,nfreqz
go to 990
endif
! We have achieved sync !i=index(MyCall,char(0))
decoded=blank !if(i.le.0) i=index(MyCall,' ')
deepmsg=blank !mycall=MyCall(1:i-1)//' '
special=' ' !i=index(HisCall,char(0))
nsync=sync !if(i.le.0) i=index(HisCall,' ')
nsnrlim=-33 !hiscall=HisCall(1:i-1)//' '
csync='*'
if(flip.lt.0.0) csync='#'
qbest=0.
qabest=0.
prtavg=.false.
do idt=-2,2 write(cfile6(1:4),1000) nutc
dtx=dtxz + 0.03*idt 1000 format(i4.4)
nfreq=nfreqz + 2*idf cfile6(5:6)=' '
call timer('wsjt4 ',0)
call this%wsjt4(dat,jz2,nutc,NClearAve,minsync,ntol,emedelay,dttol,mode4, &
minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme)
call timer('wsjt4 ',1)
return
end subroutine decode
subroutine wsjt4(this,dat,npts,nutc,NClearAve,minsync,ntol,emedelay,dttol, &
mode4,minw,mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme)
! Orchestrates the process of decoding JT4 messages, using data that
! have been 2x downsampled.
! NB: JT4 presently looks for only one decodable signal in the FTol
! range -- analogous to the nqd=1 step in JT9 and JT65.
use jt4
use timer_module, only: timer
class(jt4_decoder), intent(inout) :: this
integer, intent(in) :: npts,nutc,NClearAve,minsync,ntol,mode4,minw, &
nfqso,ndepth,neme
logical, intent(in) :: NAgain
character(len=12), intent(in) :: mycall,hiscall
character(len=6), intent(in) :: hisgrid
real, intent(in) :: dat(npts) !Raw data
real z(458,65)
logical first,prtavg
character decoded*22,special*5
character*22 avemsg,deepmsg,deepave,blank,deepmsg0,deepave1
character csync*1
data first/.true./,nutc0/-999/,nfreq0/-999999/
save
if(first) then
nsave=0
first=.false.
blank=' '
ccfblue=0.
ccfred=0.
!nagain=.false.
endif
zz=0.
syncmin=3.0 + minsync
naggressive=0
if(ndepth.ge.2) naggressive=1
nq1=3
nq2=6
if(naggressive.eq.1) nq1=1
if(NClearAve.ne.0) then
nsave=0
iutc=-1
nfsave=0.
listutc=0
ppsave=0.
rsymbol=0.
dtsave=0.
syncsave=0.
nfanoave=0
ndeepave=0
endif
! Attempt to synchronize: look for sync pattern, get DF and DT.
call timer('sync4 ',0)
call sync4(dat,npts,mode4,minw)
call timer('sync4 ',1)
call timer('zplt ',0)
do ich=4,7
z(1:458,1:65)=zz(274:731,1:65,ich)
call zplt(z,ich-4,syncz,dtxz,nfreqz,flipz,sync2z,0,emedelay,dttol, &
nfqso,ntol)
if(ich.eq.5) then
dtxzz=dtxz
nfreqzz=nfreqz
endif
enddo
call timer('zplt ',1)
! Use results from zplt
flip=flipz
sync=syncz
snrx=db(sync) - 26.
nsnr=nint(snrx)
if(sync.lt.syncmin) then
if (associated (this%decode_callback)) then
call this%decode_callback(nutc,nsnr,dtxz,nfreqz,.false.,csync, &
.false.,decoded,0.,ich,.false.,0)
end if
go to 990
endif
! We have achieved sync
decoded=blank
deepmsg=blank
special=' '
nsync=sync
nsnrlim=-33
csync='*'
if(flip.lt.0.0) csync='#'
qbest=0.
qabest=0.
prtavg=.false.
do idt=-2,2
dtx=dtxz + 0.03*idt
nfreq=nfreqz + 2*idf
! Attempt a single-sequence decode, including deep4 if Fano fails. ! Attempt a single-sequence decode, including deep4 if Fano fails.
call timer('decode4 ',0) call timer('decode4 ',0)
call decode4(dat,npts,dtx,nfreq,flip,mode4,ndepth,neme,minw, & call decode4(dat,npts,dtx,nfreq,flip,mode4,ndepth,neme,minw, &
mycall,hiscall,hisgrid,decoded,nfano,deepmsg,qual,ich) mycall,hiscall,hisgrid,decoded,nfano,deepmsg,qual,ich)
call timer('decode4 ',1) call timer('decode4 ',1)
if(nfano.gt.0) then if(nfano.gt.0) then
! Fano succeeded: display the message and return FANO OK ! Fano succeeded: report the message and return FANO OK
write(*,1010) nutc,nsnr,dtx,nfreq,csync,decoded,' *', & if (associated (this%decode_callback)) then
char(ichar('A')+ich-1) call this%decode_callback(nutc,nsnr,dtx,nfreq,.true.,csync, &
1010 format(i4.4,i4,f5.2,i5,1x,a1,1x,a22,a2,1x,a1,i3) .false.,decoded,0.,ich,.false.,0)
nsave=0 end if
go to 990 nsave=0
go to 990
else ! NO FANO else ! NO FANO
if(qual.gt.qbest) then if(qual.gt.qbest) then
dtx0=dtx dtx0=dtx
nfreq0=nfreq nfreq0=nfreq
deepmsg0=deepmsg deepmsg0=deepmsg
ich0=ich ich0=ich
qbest=qual qbest=qual
endif endif
endif endif
if(idt.ne.0) cycle if(idt.ne.0) cycle
! Single-sequence Fano decode failed, so try for an average Fano decode: ! Single-sequence Fano decode failed, so try for an average Fano decode:
qave=0. qave=0.
! If this is a new minute or a new frequency, call avg4 ! If this is a new minute or a new frequency, call avg4
if(.not. prtavg) then if(.not. prtavg) then
if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then
nutc0=nutc ! TRY AVG nutc0=nutc ! TRY AVG
nfreq0=nfreq nfreq0=nfreq
nsave=nsave+1 nsave=nsave+1
nsave=mod(nsave-1,64)+1 nsave=mod(nsave-1,64)+1
call timer('avg4 ',0) call timer('avg4 ',0)
call avg4(nutc,sync,dtx,flip,nfreq,mode4,ntol,ndepth,neme, & call this%avg4(nutc,sync,dtx,flip,nfreq,mode4,ntol,ndepth,neme, &
mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ich, & mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ich, &
ndeepave) ndeepave)
call timer('avg4 ',1) call timer('avg4 ',1)
endif endif
if(nfanoave.gt.0) then if(nfanoave.gt.0) then
! Fano succeeded: display the message AVG FANO OK ! Fano succeeded: report the mess AVG FANO OK
write(*,1010) nutc,nsnr,dtx,nfreq,csync,avemsg,' *', & if (associated (this%decode_callback)) then
char(ichar('A')+ich-1),nfanoave call this%decode_callback(nutc,nsnr,dtx,nfreq,.true.,csync, &
prtavg=.true. .false.,avemsg,0.,ich,.true.,nfanoave)
cycle end if
else prtavg=.true.
if(qave.gt.qabest) then cycle
dtx1=dtx else
nfreq1=nfreq if(qave.gt.qabest) then
deepave1=deepave dtx1=dtx
ich1=ich nfreq1=nfreq
qabest=qave deepave1=deepave
endif ich1=ich
endif qabest=qave
endif endif
enddo endif
endif
enddo
dtx=dtx0 dtx=dtx0
nfreq=nfreq0 nfreq=nfreq0
deepmsg=deepmsg0 deepmsg=deepmsg0
ich=ich0 ich=ich0
qual=qbest qual=qbest
if(int(qual).ge.nq1) then if (associated (this%decode_callback)) then
write(cqual,'(i2)') int(qual) if(int(qual).ge.nq1) then
write(*,1010) nutc,nsnr,dtx,nfreq,csync, & call this%decode_callback(nutc,nsnr,dtx,nfreqz,.true.,csync,.true., &
deepmsg,cqual,char(ichar('A')+ich-1) deepmsg,qual,ich,.false.,0)
else else
write(*,1010) nutc,nsnr,dtxz,nfreqz,csync call this%decode_callback(nutc,nsnr,dtxz,nfreqz,.true.,csync, &
endif .false.,blank,0.,ich,.false.,0)
endif
end if
dtx=dtx1 dtx=dtx1
nfreq=nfreq1 nfreq=nfreq1
deepave=deepave1 deepave=deepave1
ich=ich1 ich=ich1
qave=qabest qave=qabest
if(int(qave).ge.nq1) then if (associated (this%decode_callback)) then
write(cqual,'(i2)') nint(qave) if(int(qave).ge.nq1) then
write(*,1010) nutc,nsnr,dtx,nfreq,csync, & call this%decode_callback(nutc,nsnr,dtx,nfreq,.true.,csync,.true., &
deepave,cqual,char(ichar('A')+ich-1),ndeepave deepave,qave,ich,.true.,ndeepave)
endif endif
end if
990 return 990 return
end subroutine wsjt4 end subroutine wsjt4
subroutine avg4(this,nutc,snrsync,dtxx,flip,nfreq,mode4,ntol,ndepth,neme, &
mycall,hiscall,hisgrid,nfanoave,avemsg,qave,deepave,ichbest,ndeepave)
! Decodes averaged JT4 data
use jt4
class(jt4_decoder), intent(inout) :: this
character*22 avemsg,deepave,deepbest
character mycall*12,hiscall*12,hisgrid*6
character*1 csync,cused(64)
real sym(207,7)
integer iused(64)
logical first
data first/.true./
save
if(first) then
iutc=-1
nfsave=0
dtdiff=0.2
first=.false.
endif
do i=1,64
if(nutc.eq.iutc(i) .and. abs(nhz-nfsave(i)).le.ntol) go to 10
enddo
! Save data for message averaging
iutc(nsave)=nutc
syncsave(nsave)=snrsync
dtsave(nsave)=dtxx
nfsave(nsave)=nfreq
flipsave(nsave)=flip
ppsave(1:207,1:7,nsave)=rsymbol(1:207,1:7)
10 sym=0.
syncsum=0.
dtsum=0.
nfsum=0
nsum=0
do i=1,64
cused(i)='.'
if(iutc(i).lt.0) cycle
if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same (odd/even) sequence
if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match
if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match
if(flip.ne.flipsave(i)) cycle !Sync (*/#) must match
sym(1:207,1:7)=sym(1:207,1:7) + ppsave(1:207,1:7,i)
syncsum=syncsum + syncsave(i)
dtsum=dtsum + dtsave(i)
nfsum=nfsum + nfsave(i)
cused(i)='$'
nsum=nsum+1
iused(nsum)=i
enddo
if(nsum.lt.64) iused(nsum+1)=0
syncave=0.
dtave=0.
fave=0.
if(nsum.gt.0) then
sym=sym/nsum
syncave=syncsum/nsum
dtave=dtsum/nsum
fave=float(nfsum)/nsum
endif
! rewind 80
do i=1,nsave
csync='*'
if(flipsave(i).lt.0.0) csync='#'
if (associated (this%average_callback)) then
call this%average_callback(cused(i) .eq. '$',iutc(i), &
syncsave(i) - 5.,dtsave(i),nfsave(i),flipsave(i) .lt.0.)
end if
! write(14,1000) cused(i),iutc(i),syncsave(i)-5.0,dtsave(i),nfsave(i),csync
!1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1)
enddo
sqt=0.
sqf=0.
do j=1,64
i=iused(j)
if(i.eq.0) exit
csync='*'
if(flipsave(i).lt.0.0) csync='#'
! write(80,3001) i,iutc(i),syncsave(i),dtsave(i),nfsave(i),csync
!3001 format(i3,i6.4,f6.1,f6.2,i6,1x,a1)
sqt=sqt + (dtsave(i)-dtave)**2
sqf=sqf + (nfsave(i)-fave)**2
enddo
rmst=0.
rmsf=0.
if(nsum.ge.2) then
rmst=sqrt(sqt/(nsum-1))
rmsf=sqrt(sqf/(nsum-1))
endif
! write(80,3002)
!3002 format(16x,'----- -----')
! write(80,3003) dtave,nint(fave)
! write(80,3003) rmst,nint(rmsf)
!3003 format(15x,f6.2,i6)
! flush(80)
! nadd=nused*mode4
kbest=ich1
do k=ich1,ich2
call extract4(sym(1,k),ncount,avemsg) !Do the Fano decode
nfanoave=0
if(ncount.ge.0) then
ichbest=k
nfanoave=nsum
go to 900
endif
if(nch(k).ge.mode4) exit
enddo
deepave=' '
qave=0.
! Possibly should pass nadd=nused, also ?
if(ndepth.ge.3) then
flipx=1.0 !Normal flip not relevant for ave msg
qbest=0.
do k=ich1,ich2
call deep4(sym(2,k),neme,flipx,mycall,hiscall,hisgrid,deepave,qave)
! write(82,3101) nutc,sym(51:53,k),flipx,k,qave,deepave
!3101 format(i4.4,4f8.1,i3,f7.2,2x,a22)
if(qave.gt.qbest) then
qbest=qave
deepbest=deepave
kbest=k
ndeepave=nsum
endif
if(nch(k).ge.mode4) exit
enddo
deepave=deepbest
qave=qbest
ichbest=kbest
endif
900 return
end subroutine avg4
end module jt4_decode

View File

@ -1,44 +1,2 @@
subroutine jt4a(dd,jz,nutc,nfqso,ntol0,emedelay,dttol,nagain,ndepth, & ! The contents of this file have been migrated to lib/jt4_decode.f90
nclearave,minsync,minw,nsubmode,mycall,hiscall,hisgrid,nlist0,listutc0)
use jt4
use timer_module, only: timer
integer listutc0(10)
real*4 dd(jz)
real*4 dat(30*12000)
character*6 cfile6
character*12 mycall,hiscall
character*6 hisgrid
mode4=nch(nsubmode+1)
ntol=ntol0
neme=0
lumsg=6 !### temp ? ###
ndiag=1
nlist=nlist0
listutc=listutc0
! Lowpass filter and decimate by 2
call timer('lpf1 ',0)
call lpf1(dd,jz,dat,jz2)
call timer('lpf1 ',1)
i=index(MyCall,char(0))
if(i.le.0) i=index(MyCall,' ')
mycall=MyCall(1:i-1)//' '
i=index(HisCall,char(0))
if(i.le.0) i=index(HisCall,' ')
hiscall=HisCall(1:i-1)//' '
write(cfile6(1:4),1000) nutc
1000 format(i4.4)
cfile6(5:6)=' '
call timer('wsjt4 ',0)
call wsjt4(dat,jz2,nutc,NClearAve,minsync,ntol,emedelay,dttol,mode4,minw, &
mycall,hiscall,hisgrid,nfqso,NAgain,ndepth,neme)
call timer('wsjt4 ',1)
return
end subroutine jt4a

View File

@ -1,14 +1,14 @@
program jt65 program jt65
! Test the JT65 decoder for WSJT-X ! Test the JT65 decoder for WSJT-X
use options use options
use timer_module, only: timer use timer_module, only: timer
use timer_impl, only: init_timer use timer_impl, only: init_timer
use jt65_test
character c character c
logical :: display_help=.false. logical :: display_help=.false.,nrobust=.false.
parameter (NZMAX=60*12000)
integer*4 ihdr(11) integer*4 ihdr(11)
integer*2 id2(NZMAX) integer*2 id2(NZMAX)
real*4 dd(NZMAX) real*4 dd(NZMAX)
@ -18,56 +18,54 @@ program jt65
character*6 hisgrid character*6 hisgrid
equivalence (lenfile,ihdr(2)) equivalence (lenfile,ihdr(2))
type (option) :: long_options(9) = [ & type (option) :: long_options(9) = [ &
option ('freq',.true.,'f','signal frequency, default FREQ=1270','FREQ'), & option ('freq',.true.,'f','signal frequency, default FREQ=1270','FREQ'), &
option ('help',.false.,'h','Display this help message',''), & option ('help',.false.,'h','Display this help message',''), &
option ('ntrials',.true.,'n','number of trials, default TRIALS=10000','TRIALS'), & option ('ntrials',.true.,'n','number of trials, default TRIALS=10000','TRIALS'), &
option ('robust-sync',.false.,'r','robust sync',''), & option ('robust-sync',.false.,'r','robust sync',''), &
option ('my-call',.true.,'c','my callsign',''), & option ('my-call',.true.,'c','my callsign',''), &
option ('his-call',.true.,'x','his callsign',''), & option ('his-call',.true.,'x','his callsign',''), &
option ('his-grid',.true.,'g','his grid locator',''), & option ('his-grid',.true.,'g','his grid locator',''), &
option ('experience-decoding',.true.,'X' & option ('experience-decoding',.true.,'X' &
,'experience decoding options (1..n), default FLAGS=0','FLAGS'), & ,'experience decoding options (1..n), default FLAGS=0','FLAGS'), &
option ('single-signal-mode',.false.,'s','decode at signal frequency only','') ] option ('single-signal-mode',.false.,'s','decode at signal frequency only','') ]
ntol=10 ntol=10
nfqso=1270 nfqso=1270
nagain=0 nsubmode=0
nsubmode=0 ntrials=10000
ntrials=10000 nlow=200
nlow=200 nhigh=4000
nhigh=4000 n2pass=2
n2pass=2 nexp_decoded=0
nrobust=0 naggressive=0
nexp_decoded=0
naggressive=1
do do
call getopt('f:hn:rc:x:g:X:s',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.) call getopt('f:hn:rc:x:g:X:s',long_options,c,optarg,narglen,nstat,noffset,nremain,.true.)
if( nstat .ne. 0 ) then if( nstat .ne. 0 ) then
exit exit
end if end if
select case (c) select case (c)
case ('f') case ('f')
read (optarg(:narglen), *) nfqso read (optarg(:narglen), *) nfqso
case ('h') case ('h')
display_help = .true. display_help = .true.
case ('n') case ('n')
read (optarg(:narglen), *) ntrials read (optarg(:narglen), *) ntrials
case ('r') case ('r')
nrobust=1 nrobust=.true.
case ('c') case ('c')
read (optarg(:narglen), *) mycall read (optarg(:narglen), *) mycall
case ('x') case ('x')
read (optarg(:narglen), *) hiscall read (optarg(:narglen), *) hiscall
case ('g') case ('g')
read (optarg(:narglen), *) hisgrid read (optarg(:narglen), *) hisgrid
case ('X') case ('X')
read (optarg(:narglen), *) nexp_decoded read (optarg(:narglen), *) nexp_decoded
case ('s') case ('s')
nlow=nfqso-ntol nlow=nfqso-ntol
nhigh=nfqso+ntol nhigh=nfqso+ntol
n2pass=1 n2pass=1
end select end select
end do end do
if(display_help .or. nstat.lt.0 .or. nremain.lt.1) then if(display_help .or. nstat.lt.0 .or. nremain.lt.1) then
@ -79,17 +77,16 @@ naggressive=1
print *, 'OPTIONS:' print *, 'OPTIONS:'
print *, '' print *, ''
do i = 1, size (long_options) do i = 1, size (long_options)
call long_options(i) % print (6) call long_options(i) % print (6)
end do end do
go to 999 go to 999
endif endif
call init_timer() call init_timer ('timer.out')
call timer('jt65 ',0) call timer('jt65 ',0)
ndecoded=0 ndecoded=0
do ifile=noffset+1,noffset+nremain do ifile=noffset+1,noffset+nremain
newdat=1
nfa=nlow nfa=nlow
nfb=nhigh nfb=nhigh
minsync=0 minsync=0
@ -106,24 +103,23 @@ naggressive=1
call timer('read ',1) call timer('read ',1)
dd(1:npts)=id2(1:npts) dd(1:npts)=id2(1:npts)
dd(npts+1:)=0. dd(npts+1:)=0.
call timer('jt65a ',0)
! open(56,file='subtracted.wav',access='stream',status='unknown') ! open(56,file='subtracted.wav',access='stream',status='unknown')
! write(56) ihdr(1:11) ! write(56) ihdr(1:11)
call jt65a(dd,npts,newdat,nutc,nfa,nfb,nfqso,ntol,nsubmode, & call test(dd,nutc,nfa,nfb,nfqso,ntol,nsubmode, &
minsync,nagain,n2pass,nrobust,ntrials,naggressive,ndepth, & n2pass,nrobust,ntrials,naggressive, &
mycall,hiscall,hisgrid,nexp_decoded,ndecoded) mycall,hiscall,hisgrid,nexp_decoded)
call timer('jt65a ',1)
enddo enddo
call timer('jt65 ',1) call timer('jt65 ',1)
call timer('jt65 ',101) call timer('jt65 ',101)
! call four2a(a,-1,1,1,1) !Free the memory used for plans ! call four2a(a,-1,1,1,1) !Free the memory used for plans
! call filbig(a,-1,1,0.0,0,0,0,0,0) ! (ditto) ! call filbig(a,-1,1,0.0,0,0,0,0,0) ! (ditto)
go to 999 go to 999
998 print*,'Cannot read from file:' 998 print*,'Cannot read from file:'
print*,infile print*,infile
999 end program jt65 999 continue
end program jt65

View File

@ -1,171 +1,212 @@
subroutine jt65a(dd0,npts,newdat,nutc,nf1,nf2,nfqso,ntol,nsubmode, & module jt65_decode
minsync,nagain,n2pass,nrobust,ntrials,naggressive,ndepth, &
mycall,hiscall,hisgrid,nexp_decode,ndecoded)
! Process dd0() data to find and decode JT65 signals. type :: jt65_decoder
procedure(jt65_decode_callback), pointer :: callback => null()
contains
procedure :: decode
end type jt65_decoder
use timer_module, only: timer !
! Callback function to be called with each decode
!
abstract interface
subroutine jt65_decode_callback (this, utc, sync, snr, dt, freq, drift, &
decoded, ft, qual, candidates, tries, total_min, hard_min, aggression)
import jt65_decoder
implicit none
class(jt65_decoder), intent(inout) :: this
integer, intent(in) :: utc
real, intent(in) :: sync
integer, intent(in) :: snr
real, intent(in) :: dt
integer, intent(in) :: freq
integer, intent(in) :: drift
character(len=22), intent(in) :: decoded
integer, intent(in) :: ft
integer, intent(in) :: qual
integer, intent(in) :: candidates
integer, intent(in) :: tries
integer, intent(in) :: total_min
integer, intent(in) :: hard_min
integer, intent(in) :: aggression
end subroutine jt65_decode_callback
end interface
parameter (NSZ=3413,NZMAX=60*12000) contains
parameter (NFFT=1000)
real dd0(NZMAX)
real dd(NZMAX)
real ss(322,NSZ)
real savg(NSZ)
real a(5)
character*22 decoded,decoded0
character mycall*12,hiscall*12,hisgrid*6
type candidate
real freq
real dt
real sync
end type candidate
type(candidate) ca(300)
type decode
real freq
real dt
real sync
character*22 decoded
end type decode
type(decode) dec(50)
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
common/steve/thresh0
common/test000/ncandidates,nhard_min,nsoft_min,nera_best,nsofter_min, &
ntotal_min,ntry,nq1000,ntot !### TEST ONLY ###
save
dd=dd0 subroutine decode(this,callback,dd0,npts,newdat,nutc,nf1,nf2,nfqso,ntol,nsubmode, &
ndecoded=0 minsync,nagain,n2pass,nrobust,ntrials,naggressive,ndepth, &
do ipass=1,n2pass ! 2-pass decoding loop mycall,hiscall,hisgrid,nexp_decode)
newdat=1
if(ipass.eq.1) then !first-pass parameters
thresh0=2.5
nsubtract=1
elseif( ipass.eq.2 ) then !second-pass parameters
thresh0=2.5
nsubtract=0
endif
if(n2pass.lt.2) nsubtract=0
! if(newdat.ne.0) then ! Process dd0() data to find and decode JT65 signals.
call timer('symsp65 ',0)
ss=0.
call symspec65(dd,npts,ss,nhsym,savg) !Get normalized symbol spectra
call timer('symsp65 ',1)
! endif
nfa=nf1
nfb=nf2
if(naggressive.gt.0 .and. ntol.lt.1000) then
nfa=max(200,nfqso-ntol)
nfb=min(4000,nfqso+ntol)
thresh0=1.0
endif
! nrobust = 0: use float ccf. Only if ncand>50 fall back to robust (1-bit) ccf use timer_module, only: timer
! nrobust = 1: use only robust (1-bit) ccf
ncand=0
if(nrobust.eq.0) then
call timer('sync65 ',0)
call sync65(ss,nfa,nfb,naggressive,ntol,nhsym,ca,ncand,0)
call timer('sync65 ',1)
endif
if(ncand.gt.50) nrobust=1
if(nrobust.eq.1) then
ncand=0
call timer('sync65 ',0)
call sync65(ss,nfa,nfb,naggressive,ntol,nhsym,ca,ncand,1)
call timer('sync65 ',1)
endif
call fqso_first(nfqso,ntol,ca,ncand) include 'constants.f90'
parameter (NSZ=3413,NZMAX=60*12000)
parameter (NFFT=1000)
nvec=ntrials class(jt65_decoder), intent(inout) :: this
if(ncand.gt.75) then procedure(jt65_decode_callback) :: callback
! write(*,*) 'Pass ',ipass,' ncandidates too large ',ncand real, intent(in) :: dd0(NZMAX)
nvec=100 integer, intent(in) :: npts, nutc, nf1, nf2, nfqso, ntol &
endif , nsubmode, minsync, n2pass, ntrials, naggressive, ndepth &
, nexp_decode
logical, intent(in) :: newdat, nagain, nrobust
character(len=12), intent(in) :: mycall, hiscall
character(len=6), intent(in) :: hisgrid
df=12000.0/NFFT !df = 12000.0/8192 = 1.465 Hz real dd(NZMAX)
mode65=2**nsubmode real ss(322,NSZ)
nflip=1 !### temporary ### real savg(NSZ)
nqd=0 real a(5)
decoded0="" character*22 decoded,decoded0
freq0=0. type candidate
real freq
real dt
real sync
end type candidate
type(candidate) ca(300)
type accepted_decode
real freq
real dt
real sync
character*22 decoded
end type accepted_decode
type(accepted_decode) dec(50)
logical :: first_time, robust
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
common/steve/thresh0
common/test000/ncandidates,nhard_min,nsoft_min,nera_best,nsofter_min, &
ntotal_min,ntry,nq1000,ntot !### TEST ONLY ###
save
do icand=1,ncand this%callback => callback
freq=ca(icand)%freq first_time=newdat
dtx=ca(icand)%dt robust=nrobust
sync1=ca(icand)%sync dd=dd0
if(ipass.eq.1) ntry65a=ntry65a + 1 ndecoded=0
if(ipass.eq.2) ntry65b=ntry65b + 1 do ipass=1,n2pass ! 2-pass decoding loop
call timer('decod65a',0) first_time=.true.
call decode65a(dd,npts,newdat,nqd,freq,nflip,mode65,nvec, & if(ipass.eq.1) then !first-pass parameters
naggressive,ndepth,mycall,hiscall,hisgrid,nexp_decode, & thresh0=2.5
sync2,a,dtx,nft,qual,nhist,decoded) nsubtract=1
call timer('decod65a',1) elseif( ipass.eq.2 ) then !second-pass parameters
thresh0=2.5
nsubtract=0
endif
if(n2pass.lt.2) nsubtract=0
!### Suppress false decodes in crowded HF bands ### ! if(newdat) then
if(naggressive.eq.0 .and. ntrials.le.10000) then call timer('symsp65 ',0)
if(ntry.eq.ntrials .or. ncandidates.eq.100) then ss=0.
if(nhard_min.ge.42 .or. ntotal_min.ge.71) cycle call symspec65(dd,npts,ss,nhsym,savg) !Get normalized symbol spectra
endif call timer('symsp65 ',1)
endif ! endif
nfa=nf1
nfb=nf2
if(naggressive.gt.0 .and. ntol.lt.1000) then
nfa=max(200,nfqso-ntol)
nfb=min(4000,nfqso+ntol)
thresh0=1.0
endif
if(decoded.eq.decoded0 .and. abs(freq-freq0).lt. 3.0 .and. & ! robust = .false.: use float ccf. Only if ncand>50 fall back to robust (1-bit) ccf
minsync.ge.0) cycle !Don't display dupes ! robust = .true. : use only robust (1-bit) ccf
if(decoded.ne.' ' .or. minsync.lt.0) then ncand=0
if( nsubtract .eq. 1 ) then if(.not.robust) then
call timer('subtr65 ',0) call timer('sync65 ',0)
call subtract65(dd,npts,freq,dtx) call sync65(ss,nfa,nfb,naggressive,ntol,nhsym,ca,ncand,0)
call timer('subtr65 ',1) call timer('sync65 ',1)
endif endif
nfreq=nint(freq+a(1)) if(ncand.gt.50) robust=.true.
ndrift=nint(2.0*a(2)) if(robust) then
s2db=10.0*log10(sync2) - 35 !### empirical ### ncand=0
nsnr=nint(s2db) call timer('sync65 ',0)
if(nsnr.lt.-30) nsnr=-30 call sync65(ss,nfa,nfb,naggressive,ntol,nhsym,ca,ncand,1)
if(nsnr.gt.-1) nsnr=-1 call timer('sync65 ',1)
endif
! Serialize writes - see also decjt9.f90 call fqso_first(nfqso,ntol,ca,ncand)
!$omp critical(decode_results)
ndupe=0 ! de-dedupe nvec=ntrials
do i=1, ndecoded if(ncand.gt.75) then
if(decoded==dec(i)%decoded) then ! write(*,*) 'Pass ',ipass,' ncandidates too large ',ncand
ndupe=1 nvec=100
exit endif
df=12000.0/NFFT !df = 12000.0/8192 = 1.465 Hz
mode65=2**nsubmode
nflip=1 !### temporary ###
nqd=0
decoded0=""
freq0=0.
do icand=1,ncand
freq=ca(icand)%freq
dtx=ca(icand)%dt
sync1=ca(icand)%sync
if(ipass.eq.1) ntry65a=ntry65a + 1
if(ipass.eq.2) ntry65b=ntry65b + 1
call timer('decod65a',0)
call decode65a(dd,npts,first_time,nqd,freq,nflip,mode65,nvec, &
naggressive,ndepth,mycall,hiscall,hisgrid,nexp_decode, &
sync2,a,dtx,nft,qual,nhist,decoded)
call timer('decod65a',1)
!### Suppress false decodes in crowded HF bands ###
if(naggressive.eq.0 .and. ntrials.le.10000) then
if(ntry.eq.ntrials .or. ncandidates.eq.100) then
if(nhard_min.ge.42 .or. ntotal_min.ge.71) cycle
endif
endif endif
enddo
if(ndupe.ne.1 .or. minsync.lt.0) then
if(ipass.eq.1) n65a=n65a + 1
if(ipass.eq.2) n65b=n65b + 1
ndecoded=ndecoded+1
dec(ndecoded)%freq=freq+a(1)
dec(ndecoded)%dt=dtx
dec(ndecoded)%sync=sync2
dec(ndecoded)%decoded=decoded
nqual=min(qual,9999.0)
! if(nqual.gt.10) nqual=10
write(*,1010) nutc,nsnr,dtx-1.0,nfreq,decoded
1010 format(i4.4,i4,f5.1,i5,1x,'#',1x,a22)
write(13,1012) nutc,nint(sync1),nsnr,dtx-1.0,float(nfreq),ndrift, &
decoded,nft
1012 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT65',i4)
call flush(6)
call flush(13)
! write(79,3001) nutc,nint(sync1),nsnr,dtx-1.0,nfreq,ncandidates, &
write(79,3001) nutc,sync1,nsnr,dtx-1.0,nfreq,ncandidates, &
nhard_min,ntotal_min,ntry,naggressive,nft,nqual,decoded
3001 format(i4.4,f6.2,i4,f6.2,i5,i7,i3,i4,i8,i3,i2,i5,1x,a22)
flush(79)
endif
decoded0=decoded
freq0=freq
if(decoded0.eq.' ') decoded0='*'
!$omp end critical(decode_results)
endif
enddo !candidate loop
if(ndecoded.lt.1) exit
enddo !two-pass loop
return if(decoded.eq.decoded0 .and. abs(freq-freq0).lt. 3.0 .and. &
end subroutine jt65a minsync.ge.0) cycle !Don't display dupes
if(decoded.ne.' ' .or. minsync.lt.0) then
if( nsubtract .eq. 1 ) then
call timer('subtr65 ',0)
call subtract65(dd,npts,freq,dtx)
call timer('subtr65 ',1)
endif
nfreq=nint(freq+a(1))
ndrift=nint(2.0*a(2))
s2db=10.0*log10(sync2) - 35 !### empirical ###
nsnr=nint(s2db)
if(nsnr.lt.-30) nsnr=-30
if(nsnr.gt.-1) nsnr=-1
ndupe=0 ! de-dedupe
do i=1, ndecoded
if(decoded==dec(i)%decoded) then
ndupe=1
exit
endif
enddo
if(ndupe.ne.1 .or. minsync.lt.0) then
if(ipass.eq.1) n65a=n65a + 1
if(ipass.eq.2) n65b=n65b + 1
ndecoded=ndecoded+1
dec(ndecoded)%freq=freq+a(1)
dec(ndecoded)%dt=dtx
dec(ndecoded)%sync=sync2
dec(ndecoded)%decoded=decoded
nqual=min(qual,9999.0)
! if(nqual.gt.10) nqual=10
if (associated(this%callback)) then
call this%callback(nutc,sync1,nsnr,dtx-1.0,nfreq,ndrift,decoded &
,nft,nqual,ncandidates,ntry,ntotal_min,nhard_min,naggressive)
end if
endif
decoded0=decoded
freq0=freq
if(decoded0.eq.' ') decoded0='*'
endif
enddo !candidate loop
if(ndecoded.lt.1) exit
enddo !two-pass loop
return
end subroutine decode
end module jt65_decode

View File

@ -21,7 +21,7 @@ program jt9
integer :: arglen,stat,offset,remain,mode=0,flow=200,fsplit=2700, & integer :: arglen,stat,offset,remain,mode=0,flow=200,fsplit=2700, &
fhigh=4000,nrxfreq=1500,ntrperiod=1,ndepth=60001,nexp_decode=0 fhigh=4000,nrxfreq=1500,ntrperiod=1,ndepth=60001,nexp_decode=0
logical :: read_files = .true., tx9 = .false., display_help = .false. logical :: read_files = .true., tx9 = .false., display_help = .false.
type (option) :: long_options(22) = [ & type (option) :: long_options(23) = [ &
option ('help', .false., 'h', 'Display this help message', ''), & option ('help', .false., 'h', 'Display this help message', ''), &
option ('shmem',.true.,'s','Use shared memory for sample data','KEY'), & option ('shmem',.true.,'s','Use shared memory for sample data','KEY'), &
option ('tr-period', .true., 'p', 'Tx/Rx period, default MINUTES=1', & option ('tr-period', .true., 'p', 'Tx/Rx period, default MINUTES=1', &
@ -49,6 +49,7 @@ program jt9
option ('jt65', .false., '6', 'JT65 mode', ''), & option ('jt65', .false., '6', 'JT65 mode', ''), &
option ('jt9', .false., '9', 'JT9 mode', ''), & option ('jt9', .false., '9', 'JT9 mode', ''), &
option ('jt4', .false., '4', 'JT4 mode', ''), & option ('jt4', .false., '4', 'JT4 mode', ''), &
option ('sub-mode', .true., 'b', 'Sub mode, default SUBMODE=A', 'A'), &
option ('depth', .true., 'd', & option ('depth', .true., 'd', &
'JT9 decoding depth (1-3), default DEPTH=1', 'DEPTH'), & 'JT9 decoding depth (1-3), default DEPTH=1', 'DEPTH'), &
option ('tx-jt9', .false., 'T', 'Tx mode is JT9', ''), & option ('tx-jt9', .false., 'T', 'Tx mode is JT9', ''), &
@ -67,8 +68,10 @@ program jt9
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
data npatience/1/,nthreads/1/ data npatience/1/,nthreads/1/
nsubmode = 0
do do
call getopt('hs:e:a:r:m:p:d:f:w:t:964TL:S:H:c:G:x:g:X:',long_options,c, & call getopt('hs:e:a:b:r:m:p:d:f:w:t:964TL:S:H:c:G:x:g:X:',long_options,c, &
optarg,arglen,stat,offset,remain,.true.) optarg,arglen,stat,offset,remain,.true.)
if (stat .ne. 0) then if (stat .ne. 0) then
exit exit
@ -83,6 +86,8 @@ program jt9
exe_dir = optarg(:arglen) exe_dir = optarg(:arglen)
case ('a') case ('a')
data_dir = optarg(:arglen) data_dir = optarg(:arglen)
case ('b')
nsubmode = ichar (optarg(:1)) - ichar ('A')
case ('t') case ('t')
temp_dir = optarg(:arglen) temp_dir = optarg(:arglen)
case ('m') case ('m')
@ -236,10 +241,10 @@ program jt9
enddo enddo
close(10) close(10)
shared_data%params%nutc=nutc shared_data%params%nutc=nutc
shared_data%params%ndiskdat=1 shared_data%params%ndiskdat=.true.
shared_data%params%ntr=60 shared_data%params%ntr=60
shared_data%params%nfqso=nrxfreq shared_data%params%nfqso=nrxfreq
shared_data%params%newdat=1 shared_data%params%newdat=.true.
shared_data%params%npts8=74736 shared_data%params%npts8=74736
shared_data%params%nfa=flow shared_data%params%nfa=flow
shared_data%params%nfsplit=fsplit shared_data%params%nfsplit=fsplit
@ -250,12 +255,11 @@ program jt9
shared_data%params%ndepth=ndepth shared_data%params%ndepth=ndepth
shared_data%params%dttol=3. shared_data%params%dttol=3.
shared_data%params%minsync=-1 !### TEST ONLY shared_data%params%minsync=-1 !### TEST ONLY
shared_data%params%nfqso=1500 !### TEST ONLY !mycall="K1ABC " !### TEST ONLY
mycall="K1ABC " !### TEST ONLY
shared_data%params%naggressive=10 shared_data%params%naggressive=10
shared_data%params%n2pass=1 shared_data%params%n2pass=1
shared_data%params%nranera=8 ! ntrials=10000 shared_data%params%nranera=8 ! ntrials=10000
shared_data%params%nrobust=0 shared_data%params%nrobust=.false.
shared_data%params%nexp_decode=nexp_decode shared_data%params%nexp_decode=nexp_decode
shared_data%params%mycall=mycall shared_data%params%mycall=mycall
shared_data%params%mygrid=mygrid shared_data%params%mygrid=mygrid
@ -274,9 +278,10 @@ program jt9
else else
shared_data%params%nmode=mode shared_data%params%nmode=mode
end if end if
shared_data%params%nsubmode=nsubmode
shared_data%params%datetime="2013-Apr-16 15:13" !### Temp shared_data%params%datetime="2013-Apr-16 15:13" !### Temp
if(mode.eq.9 .and. fsplit.ne.2700) shared_data%params%nfa=fsplit if(mode.eq.9 .and. fsplit.ne.2700) shared_data%params%nfa=fsplit
call decoder(shared_data%ss,shared_data%id2,shared_data%params,nfsample) call multimode_decoder(shared_data%ss,shared_data%id2,shared_data%params,nfsample)
enddo enddo
call timer('jt9 ',1) call timer('jt9 ',1)
@ -300,5 +305,4 @@ program jt9
call filbig(a,-1,1,0.0,0,0,0,0,0) !used for FFT plans call filbig(a,-1,1,0.0,0,0,0,0,0) !used for FFT plans
call fftwf_cleanup_threads() call fftwf_cleanup_threads()
call fftwf_cleanup() call fftwf_cleanup()
end program jt9 end program jt9

View File

@ -1,140 +1,162 @@
subroutine decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, & module jt9_decode
nzhsym,nagain,ndepth,nmode)
use timer_module, only: timer type :: jt9_decoder
procedure(jt9_decode_callback), pointer :: callback
contains
procedure :: decode
end type jt9_decoder
include 'constants.f90' abstract interface
real ss(184,NSMAX) subroutine jt9_decode_callback (this, utc, sync, snr, dt, freq, drift, decoded)
character*22 msg import jt9_decoder
real*4 ccfred(NSMAX) implicit none
real*4 red2(NSMAX) class(jt9_decoder), intent(inout) :: this
logical ccfok(NSMAX) integer, intent(in) :: utc
logical done(NSMAX) real, intent(in) :: sync
integer*2 id2(NTMAX*12000) integer, intent(in) :: snr
integer*1 i1SoftSymbols(207) real, intent(in) :: dt
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano real, intent(in) :: freq
save ccfred,red2 integer, intent(in) :: drift
character(len=22), intent(in) :: decoded
end subroutine jt9_decode_callback
end interface
nsynced=0 contains
ndecoded=0
nsps=6912 !Params for JT9-1
df3=1500.0/2048.0
tstep=0.5*nsps/12000.0 !Half-symbol step (seconds) subroutine decode(this,callback,ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, &
done=.false. nzhsym,nagain,ndepth,nmode)
use timer_module, only: timer
nf0=0 include 'constants.f90'
nf1=nfa class(jt9_decoder), intent(inout) :: this
if(nmode.eq.65+9) nf1=nfsplit procedure(jt9_decode_callback) :: callback
ia=max(1,nint((nf1-nf0)/df3)) real ss(184,NSMAX)
ib=min(NSMAX,nint((nfb-nf0)/df3)) logical, intent(in) :: newdat, nagain
lag1=-int(2.5/tstep + 0.9999) character*22 msg
lag2=int(5.0/tstep + 0.9999) real*4 ccfred(NSMAX)
if(newdat.ne.0) then real*4 red2(NSMAX)
call timer('sync9 ',0) logical ccfok(NSMAX)
call sync9(ss,nzhsym,lag1,lag2,ia,ib,ccfred,red2,ipk) logical done(NSMAX)
call timer('sync9 ',1) integer*2 id2(NTMAX*12000)
endif integer*1 i1SoftSymbols(207)
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
save ccfred,red2
nsps8=nsps/8 this%callback => callback
df8=1500.0/nsps8 nsynced=0
dblim=db(864.0/nsps8) - 26.2 ndecoded=0
nsps=6912 !Params for JT9-1
df3=1500.0/2048.0
ia1=1 !quel compiler gripe tstep=0.5*nsps/12000.0 !Half-symbol step (seconds)
ib1=1 !quel compiler gripe done=.false.
do nqd=1,0,-1
limit=5000
ccflim=3.0
red2lim=1.6
schklim=2.2
if(ndepth.eq.2) then
limit=10000
ccflim=2.7
endif
if(ndepth.ge.3 .or. nqd.eq.1) then
limit=30000
ccflim=2.5
schklim=2.0
endif
if(nagain.ne.0) then
limit=100000
ccflim=2.4
schklim=1.8
endif
ccfok=.false.
if(nqd.eq.1) then nf0=0
nfa1=nfqso-ntol nf1=nfa
nfb1=nfqso+ntol if(nmode.eq.65+9) nf1=nfsplit
ia=max(1,nint((nfa1-nf0)/df3)) ia=max(1,nint((nf1-nf0)/df3))
ib=min(NSMAX,nint((nfb1-nf0)/df3)) ib=min(NSMAX,nint((nfb-nf0)/df3))
ccfok(ia:ib)=(ccfred(ia:ib).gt.(ccflim-2.0)) .and. & lag1=-int(2.5/tstep + 0.9999)
(red2(ia:ib).gt.(red2lim-1.0)) lag2=int(5.0/tstep + 0.9999)
ia1=ia if(newdat) then
ib1=ib call timer('sync9 ',0)
else call sync9(ss,nzhsym,lag1,lag2,ia,ib,ccfred,red2,ipk)
nfa1=nf1 call timer('sync9 ',1)
nfb1=nfb endif
ia=max(1,nint((nfa1-nf0)/df3))
ib=min(NSMAX,nint((nfb1-nf0)/df3))
do i=ia,ib
ccfok(i)=ccfred(i).gt.ccflim .and. red2(i).gt.red2lim
enddo
ccfok(ia1:ib1)=.false.
endif
fgood=0. nsps8=nsps/8
do i=ia,ib df8=1500.0/nsps8
if(done(i) .or. (.not.ccfok(i))) cycle dblim=db(864.0/nsps8) - 26.2
f=(i-1)*df3
if(nqd.eq.1 .or. &
(ccfred(i).ge.ccflim .and. abs(f-fgood).gt.10.0*df8)) then
call timer('softsym ',0) ia1=1 !quel compiler gripe
fpk=nf0 + df3*(i-1) ib1=1 !quel compiler gripe
call softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, & do nqd=1,0,-1
freq,drift,a3,schk,i1SoftSymbols) limit=5000
call timer('softsym ',1) ccflim=3.0
red2lim=1.6
schklim=2.2
if(ndepth.eq.2) then
limit=10000
ccflim=2.7
endif
if(ndepth.ge.3 .or. nqd.eq.1) then
limit=30000
ccflim=2.5
schklim=2.0
endif
if(nagain) then
limit=100000
ccflim=2.4
schklim=1.8
endif
ccfok=.false.
sync=(syncpk+1)/4.0 if(nqd.eq.1) then
if(nqd.eq.1 .and. ((sync.lt.0.5) .or. (schk.lt.1.0))) cycle nfa1=nfqso-ntol
if(nqd.ne.1 .and. ((sync.lt.1.0) .or. (schk.lt.1.5))) cycle nfb1=nfqso+ntol
ia=max(1,nint((nfa1-nf0)/df3))
ib=min(NSMAX,nint((nfb1-nf0)/df3))
ccfok(ia:ib)=(ccfred(ia:ib).gt.(ccflim-2.0)) .and. &
(red2(ia:ib).gt.(red2lim-1.0))
ia1=ia
ib1=ib
else
nfa1=nf1
nfb1=nfb
ia=max(1,nint((nfa1-nf0)/df3))
ib=min(NSMAX,nint((nfb1-nf0)/df3))
do i=ia,ib
ccfok(i)=ccfred(i).gt.ccflim .and. red2(i).gt.red2lim
enddo
ccfok(ia1:ib1)=.false.
endif
call timer('jt9fano ',0) fgood=0.
call jt9fano(i1SoftSymbols,limit,nlim,msg) do i=ia,ib
call timer('jt9fano ',1) if(done(i) .or. (.not.ccfok(i))) cycle
f=(i-1)*df3
if(nqd.eq.1 .or. &
(ccfred(i).ge.ccflim .and. abs(f-fgood).gt.10.0*df8)) then
if(sync.lt.0.0 .or. snrdb.lt.dblim-2.0) sync=0.0 call timer('softsym ',0)
nsync=int(sync) fpk=nf0 + df3*(i-1)
if(nsync.gt.10) nsync=10 call softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, &
nsnr=nint(snrdb) freq,drift,a3,schk,i1SoftSymbols)
ndrift=nint(drift/df3) call timer('softsym ',1)
num9=num9+1
if(msg.ne.' ') then sync=(syncpk+1)/4.0
numfano=numfano+1 if(nqd.eq.1 .and. ((sync.lt.0.5) .or. (schk.lt.1.0))) cycle
if(nqd.ne.1 .and. ((sync.lt.1.0) .or. (schk.lt.1.5))) cycle
!$omp critical(decode_results) ! serialize writes - see also jt65a.f90 call timer('jt9fano ',0)
write(*,1000) nutc,nsnr,xdt,nint(freq),msg call jt9fano(i1SoftSymbols,limit,nlim,msg)
1000 format(i4.4,i4,f5.1,i5,1x,'@',1x,a22) call timer('jt9fano ',1)
write(13,1002) nutc,nsync,nsnr,xdt,freq,ndrift,msg
1002 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT9')
call flush(6)
call flush(13)
!$omp end critical(decode_results)
iaa=max(1,i-1) if(sync.lt.0.0 .or. snrdb.lt.dblim-2.0) sync=0.0
ibb=min(NSMAX,i+22) nsync=int(sync)
fgood=f if(nsync.gt.10) nsync=10
nsynced=1 nsnr=nint(snrdb)
ndecoded=1 ndrift=nint(drift/df3)
ccfok(iaa:ibb)=.false. num9=num9+1
done(iaa:ibb)=.true.
endif
endif
enddo
if(nagain.ne.0) exit
enddo
return if(msg.ne.' ') then
end subroutine decjt9 numfano=numfano+1
if (associated(this%callback)) then
call this%callback(nutc,sync,nsnr,xdt,freq,ndrift,msg)
end if
iaa=max(1,i-1)
ibb=min(NSMAX,i+22)
fgood=f
nsynced=1
ndecoded=1
ccfok(iaa:ibb)=.false.
done(iaa:ibb)=.true.
endif
endif
enddo
if(nagain) exit
enddo
return
end subroutine decode
end module jt9_decode

View File

@ -61,7 +61,7 @@ subroutine jt9a()
local_params=shared_data%params !save a copy because wsjtx carries on accessing local_params=shared_data%params !save a copy because wsjtx carries on accessing
call flush(6) call flush(6)
call timer('decoder ',0) call timer('decoder ',0)
call decoder(shared_data%ss,shared_data%id2,local_params,12000) call multimode_decoder(shared_data%ss,shared_data%id2,local_params,12000)
call timer('decoder ',1) call timer('decoder ',1)
100 inquire(file=trim(temp_dir)//'/.lock',exist=fileExists) 100 inquire(file=trim(temp_dir)//'/.lock',exist=fileExists)

View File

@ -1,4 +1,4 @@
use, intrinsic :: iso_c_binding, only: c_int, c_short, c_float, c_char use, intrinsic :: iso_c_binding, only: c_int, c_short, c_float, c_char, c_bool
include 'constants.f90' include 'constants.f90'
@ -7,10 +7,10 @@
! !
type, bind(C) :: params_block type, bind(C) :: params_block
integer(c_int) :: nutc integer(c_int) :: nutc
integer(c_int) :: ndiskdat logical(c_bool) :: ndiskdat
integer(c_int) :: ntr integer(c_int) :: ntr
integer(c_int) :: nfqso integer(c_int) :: nfqso
integer(c_int) :: newdat logical(c_bool) :: newdat
integer(c_int) :: npts8 integer(c_int) :: npts8
integer(c_int) :: nfa integer(c_int) :: nfa
integer(c_int) :: nfsplit integer(c_int) :: nfsplit
@ -19,7 +19,7 @@
integer(c_int) :: kin integer(c_int) :: kin
integer(c_int) :: nzhsym integer(c_int) :: nzhsym
integer(c_int) :: nsubmode integer(c_int) :: nsubmode
integer(c_int) :: nagain logical(c_bool) :: nagain
integer(c_int) :: ndepth integer(c_int) :: ndepth
integer(c_int) :: ntxmode integer(c_int) :: ntxmode
integer(c_int) :: nmode integer(c_int) :: nmode
@ -33,7 +33,7 @@
integer(c_int) :: n2pass integer(c_int) :: n2pass
integer(c_int) :: nranera integer(c_int) :: nranera
integer(c_int) :: naggressive integer(c_int) :: naggressive
integer(c_int) :: nrobust logical(c_bool) :: nrobust
integer(c_int) :: nexp_decode integer(c_int) :: nexp_decode
character(kind=c_char, len=20) :: datetime character(kind=c_char, len=20) :: datetime
character(kind=c_char, len=12) :: mycall character(kind=c_char, len=12) :: mycall

View File

@ -6,6 +6,7 @@ subroutine softsym(id2,npts8,nsps8,newdat,fpk,syncpk,snrdb,xdt, &
use timer_module, only: timer use timer_module, only: timer
parameter (NZ2=1512,NZ3=1360) parameter (NZ2=1512,NZ3=1360)
logical, intent(inout) :: newdat
complex c2(0:NZ2-1) complex c2(0:NZ2-1)
complex c3(0:NZ3-1) complex c3(0:NZ3-1)
complex c5(0:NZ3-1) complex c5(0:NZ3-1)

View File

@ -60,7 +60,7 @@ subroutine symspec(shared_data,k,ntrperiod,nsps,ingain,nminw,pxdb,s, &
ja=0 ja=0
ssum=0. ssum=0.
ihsym=0 ihsym=0
if(shared_data%params%ndiskdat.eq.0) shared_data%id2(k+1:)=0 !Needed to prevent "ghosts". Not sure why. if(.not. shared_data%params%ndiskdat) shared_data%id2(k+1:)=0 !Needed to prevent "ghosts". Not sure why.
endif endif
gain=10.0**(0.1*ingain) gain=10.0**(0.1*ingain)
sq=0. sq=0.