2017-06-18 08:26:41 -04:00
|
|
|
module ft8_decode
|
|
|
|
|
|
|
|
type :: ft8_decoder
|
|
|
|
procedure(ft8_decode_callback), pointer :: callback
|
|
|
|
contains
|
|
|
|
procedure :: decode
|
|
|
|
end type ft8_decoder
|
|
|
|
|
|
|
|
abstract interface
|
2017-06-27 15:44:12 -04:00
|
|
|
subroutine ft8_decode_callback (this,sync,snr,dt,freq,nbadcrc,decoded)
|
2017-06-18 08:26:41 -04:00
|
|
|
import ft8_decoder
|
|
|
|
implicit none
|
|
|
|
class(ft8_decoder), intent(inout) :: this
|
|
|
|
real, intent(in) :: sync
|
|
|
|
integer, intent(in) :: snr
|
|
|
|
real, intent(in) :: dt
|
|
|
|
real, intent(in) :: freq
|
2017-06-27 15:44:12 -04:00
|
|
|
integer, intent(in) :: nbadcrc
|
2017-06-18 08:26:41 -04:00
|
|
|
character(len=22), intent(in) :: decoded
|
|
|
|
end subroutine ft8_decode_callback
|
|
|
|
end interface
|
|
|
|
|
|
|
|
contains
|
|
|
|
|
2017-07-01 14:46:14 -04:00
|
|
|
subroutine decode(this,callback,iwave,nfqso,newdat,nutc,nfa, &
|
|
|
|
nfb,nagain,ndepth,nsubmode)
|
2017-07-06 10:44:17 -04:00
|
|
|
!use wavhdr
|
2017-06-27 15:44:12 -04:00
|
|
|
use timer_module, only: timer
|
2017-06-19 16:15:43 -04:00
|
|
|
include 'fsk4hf/ft8_params.f90'
|
2017-07-06 10:44:17 -04:00
|
|
|
!type(hdr) h
|
2017-06-19 16:15:43 -04:00
|
|
|
|
2017-06-18 08:26:41 -04:00
|
|
|
class(ft8_decoder), intent(inout) :: this
|
|
|
|
procedure(ft8_decode_callback) :: callback
|
2017-06-19 16:15:43 -04:00
|
|
|
real s(NH1,NHSYM)
|
|
|
|
real candidate(3,100)
|
2017-07-01 09:08:30 -04:00
|
|
|
real dd(15*12000)
|
2017-06-18 08:26:41 -04:00
|
|
|
logical, intent(in) :: newdat, nagain
|
2017-06-19 16:15:43 -04:00
|
|
|
integer*2 iwave(15*12000)
|
2017-06-27 15:44:12 -04:00
|
|
|
character datetime*13,message*22
|
2017-07-01 14:46:14 -04:00
|
|
|
save s,dd
|
|
|
|
|
2017-06-27 15:44:12 -04:00
|
|
|
this%callback => callback
|
2017-06-26 11:24:56 -04:00
|
|
|
write(datetime,1001) nutc !### TEMPORARY ###
|
|
|
|
1001 format("000000_",i6.6)
|
2017-06-18 08:26:41 -04:00
|
|
|
|
2017-06-27 15:44:12 -04:00
|
|
|
call timer('sync8 ',0)
|
2017-06-28 10:38:06 -04:00
|
|
|
call sync8(iwave,nfa,nfb,nfqso,s,candidate,ncand)
|
2017-06-27 15:44:12 -04:00
|
|
|
call timer('sync8 ',1)
|
|
|
|
|
2017-07-01 09:08:30 -04:00
|
|
|
dd=iwave
|
|
|
|
syncmin=2.0
|
2017-06-27 16:50:17 -04:00
|
|
|
! rewind 51
|
2017-06-27 15:44:12 -04:00
|
|
|
do icand=1,ncand
|
2017-06-28 10:38:06 -04:00
|
|
|
sync=candidate(3,icand)
|
|
|
|
if(sync.lt.syncmin) cycle
|
2017-06-27 15:44:12 -04:00
|
|
|
f1=candidate(1,icand)
|
|
|
|
xdt=candidate(2,icand)
|
|
|
|
nsnr=min(99,nint(10.0*log10(sync) - 25.5)) !### empirical ###
|
|
|
|
call timer('ft8b ',0)
|
2017-07-03 15:52:36 -04:00
|
|
|
call ft8b(dd,newdat,nfqso,f1,xdt,nharderrors,dmin,nbadcrc,message,xsnr)
|
2017-07-01 09:08:30 -04:00
|
|
|
nsnr=xsnr
|
2017-06-28 14:23:56 -04:00
|
|
|
xdt=xdt-0.6
|
2017-06-27 15:44:12 -04:00
|
|
|
call timer('ft8b ',1)
|
|
|
|
if (associated(this%callback)) call this%callback(sync,nsnr,xdt, &
|
2017-06-27 16:50:17 -04:00
|
|
|
f1,nbadcrc,message)
|
2017-07-01 09:08:30 -04:00
|
|
|
! write(*,'(f7.2,i5,f7.2,f9.1,i5,f7.2,2x,a22)') sync,nsnr,xdt,f1,nharderrors,dmin,message
|
2017-06-27 15:44:12 -04:00
|
|
|
! write(13,1110) datetime,0,nsnr,xdt,f1,nharderrors,dmin,message
|
2017-07-06 09:38:06 -04:00
|
|
|
!1110 format(a13,2i4,f6.2,f7.1,i4,' ~ ',f6.2,2x,a22,' FT8')
|
2017-06-29 09:42:24 -04:00
|
|
|
! write(51,3051) xdt,f1,sync,dmin,nsnr,nharderrors,nbadcrc,message
|
|
|
|
!3051 format(4f9.1,3i5,2x,a22)
|
|
|
|
! flush(51)
|
2017-06-27 15:44:12 -04:00
|
|
|
enddo
|
2017-07-06 10:44:17 -04:00
|
|
|
!h=default_header(12000,NMAX)
|
|
|
|
!open(10,file='subtract.wav',status='unknown',access='stream')
|
|
|
|
!iwave=nint(dd)
|
|
|
|
!write(10) h,iwave
|
|
|
|
!close(10)
|
2017-06-18 08:26:41 -04:00
|
|
|
return
|
|
|
|
end subroutine decode
|
2017-06-19 16:15:43 -04:00
|
|
|
|
2017-06-18 08:26:41 -04:00
|
|
|
end module ft8_decode
|