SVN r8568
This commit is contained in:
Jordan Sherer
@@ -1,190 +0,0 @@
|
||||
subroutine ft8b(dd0,newdat,nfqso,ndepth,icand,sync0,f1,xdt,apsym,nharderrors, &
|
||||
dmin,nbadcrc,message,xsnr)
|
||||
|
||||
use timer_module, only: timer
|
||||
include 'ft8_params.f90'
|
||||
parameter(NRECENT=10,NP2=2812)
|
||||
character message*22,msgsent*22
|
||||
character*12 recent_calls(NRECENT)
|
||||
real a(5)
|
||||
real s1(0:7,ND),s2(0:7,NN)
|
||||
real ps(0:7)
|
||||
real rxdata(3*ND),llr(3*ND),llrap(3*ND) !Soft symbols
|
||||
real dd0(15*12000)
|
||||
integer*1 decoded(KK),apmask(3*ND),cw(3*ND)
|
||||
integer*1 msgbits(KK)
|
||||
integer apsym(KK),rr73(11)
|
||||
integer itone(NN)
|
||||
complex cd0(3200)
|
||||
complex ctwk(32)
|
||||
complex csymb(32)
|
||||
logical newdat
|
||||
data rr73/-1,1,1,1,1,1,1,-1,1,1,-1/
|
||||
|
||||
max_iterations=40
|
||||
norder=2
|
||||
if(ndepth.eq.3 .and. abs(nfqso-f1).lt.10.0) norder=3
|
||||
fs2=12000.0/NDOWN
|
||||
dt2=1.0/fs2
|
||||
twopi=8.0*atan(1.0)
|
||||
delfbest=0.
|
||||
ibest=0
|
||||
|
||||
call timer('ft8_down',0)
|
||||
call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample
|
||||
call timer('ft8_down',1)
|
||||
|
||||
i0=nint(xdt*fs2) !Initial guess for start of signal
|
||||
smax=0.0
|
||||
do idt=i0-16,i0+16 !Search over +/- half a symbol
|
||||
call sync8d(cd0,idt,ctwk,0,sync)
|
||||
if(sync.gt.smax) then
|
||||
smax=sync
|
||||
ibest=idt
|
||||
endif
|
||||
enddo
|
||||
xdt2=ibest*dt2 !Improved estimate for DT
|
||||
|
||||
! Now peak up in frequency
|
||||
i0=nint(xdt2*fs2)
|
||||
smax=0.0
|
||||
do ifr=-5,5 !Search over +/- 2.5 Hz
|
||||
delf=ifr*0.5
|
||||
dphi=twopi*delf*dt2
|
||||
phi=0.0
|
||||
do i=1,32
|
||||
ctwk(i)=cmplx(cos(phi),sin(phi))
|
||||
phi=mod(phi+dphi,twopi)
|
||||
enddo
|
||||
call sync8d(cd0,i0,ctwk,1,sync)
|
||||
if( sync .gt. smax ) then
|
||||
smax=sync
|
||||
delfbest=delf
|
||||
endif
|
||||
enddo
|
||||
a=0.0
|
||||
a(1)=-delfbest
|
||||
call twkfreq1(cd0,NP2,fs2,a,cd0)
|
||||
xdt=xdt2
|
||||
f1=f1+delfbest !Improved estimate of DF
|
||||
|
||||
call sync8d(cd0,i0,ctwk,2,sync)
|
||||
|
||||
j=0
|
||||
do k=1,NN
|
||||
i1=ibest+(k-1)*32
|
||||
csymb=cmplx(0.0,0.0)
|
||||
if( i1.ge.1 .and. i1+31 .le. NP2 ) csymb=cd0(i1:i1+31)
|
||||
call four2a(csymb,32,1,-1,1)
|
||||
s2(0:7,k)=abs(csymb(1:8))
|
||||
enddo
|
||||
j=0
|
||||
do k=1,NN
|
||||
if(k.le.7) cycle
|
||||
if(k.ge.37 .and. k.le.43) cycle
|
||||
if(k.gt.72) cycle
|
||||
j=j+1
|
||||
s1(0:7,j)=s2(0:7,k)
|
||||
enddo
|
||||
|
||||
do j=1,ND
|
||||
ps=s1(0:7,j)
|
||||
where (ps.gt.0.0) ps=log(ps)
|
||||
r1=max(ps(1),ps(3),ps(5),ps(7))-max(ps(0),ps(2),ps(4),ps(6))
|
||||
r2=max(ps(2),ps(3),ps(6),ps(7))-max(ps(0),ps(1),ps(4),ps(5))
|
||||
r4=max(ps(4),ps(5),ps(6),ps(7))-max(ps(0),ps(1),ps(2),ps(3))
|
||||
rxdata(3*j-2)=r4
|
||||
rxdata(3*j-1)=r2
|
||||
rxdata(3*j)=r1
|
||||
enddo
|
||||
|
||||
rxav=sum(rxdata)/(3.0*ND)
|
||||
rx2av=sum(rxdata*rxdata)/(3.0*ND)
|
||||
var=rx2av-rxav*rxav
|
||||
if( var .gt. 0.0 ) then
|
||||
rxsig=sqrt(var)
|
||||
else
|
||||
rxsig=sqrt(rx2av)
|
||||
endif
|
||||
rxdata=rxdata/rxsig
|
||||
ss=0.84
|
||||
llr=2.0*rxdata/(ss*ss)
|
||||
|
||||
! do iap=0,3
|
||||
do iap=0,0 !### Temporary ###
|
||||
if(iap.eq.0) then
|
||||
apmask=0
|
||||
apmask(160:162)=1
|
||||
llrap=llr
|
||||
llrap(160:162)=5.0*apsym(73:75)/ss
|
||||
elseif(iap.eq.1) then
|
||||
apmask=0
|
||||
apmask(88:115)=1 ! mycall
|
||||
apmask(160:162)=1 ! 3 extra bits
|
||||
llrap=0.0
|
||||
llrap(88:115)=5.0*apsym(1:28)/ss
|
||||
llrap(160:162)=5.0*apsym(73:75)/ss
|
||||
where(apmask.eq.0) llrap=llr
|
||||
elseif(iap.eq.2) then
|
||||
apmask=0
|
||||
apmask(88:115)=1 ! mycall
|
||||
apmask(116:143)=1 ! hiscall
|
||||
apmask(160:162)=1 ! 3 extra bits
|
||||
llrap=0.0
|
||||
llrap(88:143)=5.0*apsym(1:56)/ss
|
||||
llrap(160:162)=5.0*apsym(73:75)/ss
|
||||
where(apmask.eq.0) llrap=llr
|
||||
elseif(iap.eq.3) then
|
||||
apmask=0
|
||||
apmask(88:115)=1 ! mycall
|
||||
apmask(116:143)=1 ! hiscall
|
||||
apmask(144:154)=1 ! RRR or 73
|
||||
apmask(160:162)=1 ! 3 extra bits
|
||||
llrap=0.0
|
||||
llrap(88:143)=5.0*apsym(1:56)/ss
|
||||
llrap(144:154)=5.0*rr73/ss
|
||||
llrap(160:162)=5.0*apsym(73:75)/ss
|
||||
where(apmask.eq.0) llrap=llr
|
||||
endif
|
||||
cw=0
|
||||
call timer('bpd174 ',0)
|
||||
call bpdecode174(llrap,apmask,max_iterations,decoded,cw,nharderrors)
|
||||
call timer('bpd174 ',1)
|
||||
dmin=0.0
|
||||
if(nharderrors.lt.0 .and. ndepth.ge.2) then
|
||||
call timer('osd174 ',0)
|
||||
call osd174(llrap,norder,decoded,cw,nharderrors,dmin)
|
||||
call timer('osd174 ',1)
|
||||
endif
|
||||
nbadcrc=1
|
||||
message=' '
|
||||
xsnr=-99.0
|
||||
if(count(cw.eq.0).eq.174) cycle !Reject the all-zero codeword
|
||||
if( nharderrors.ge.0 .and. dmin.le.30.0 .and. nharderrors .lt. 30) then
|
||||
call chkcrc12a(decoded,nbadcrc)
|
||||
else
|
||||
nharderrors=-1
|
||||
cycle
|
||||
endif
|
||||
if(nbadcrc.eq.0) then
|
||||
call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent)
|
||||
call genft8(message,msgsent,msgbits,itone)
|
||||
! call subtractft8(dd0,itone,f1,xdt2)
|
||||
xsig=0.0
|
||||
xnoi=0.0
|
||||
do i=1,79
|
||||
xsig=xsig+s2(itone(i),i)**2
|
||||
ios=mod(itone(i)+4,7)
|
||||
xnoi=xnoi+s2(ios,i)**2
|
||||
enddo
|
||||
xsnr=0.001
|
||||
if( xnoi.gt.0 .and. xnoi.lt.xsig ) xsnr=xsig/xnoi-1.0
|
||||
xsnr=10.0*log10(xsnr)-27.0
|
||||
if( xsnr .lt. -24.0 ) xsnr=-24.0
|
||||
! write(50,3050) icand,sync0,f1,xdt,nharderrors,dmin,message,iap
|
||||
!3050 format(i3,3f10.3,i5,f10.3,2x,a22,i3)
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
return
|
||||
end subroutine ft8b
|
||||
@@ -1,238 +0,0 @@
|
||||
program ldpcsim174
|
||||
! End to end test of the (174,75)/crc12 encoder and decoder.
|
||||
use crc
|
||||
use packjt
|
||||
|
||||
parameter(NRECENT=10)
|
||||
character*12 recent_calls(NRECENT)
|
||||
character*22 msg,msgsent,msgreceived
|
||||
character*8 arg
|
||||
integer*1, allocatable :: codeword(:), decoded(:), message(:)
|
||||
integer*1, target:: i1Msg8BitBytes(11)
|
||||
integer*1 msgbits(87)
|
||||
integer*1 apmask(174), cw(174)
|
||||
integer*2 checksum
|
||||
integer*4 i4Msg6BitWords(13)
|
||||
integer colorder(174)
|
||||
integer nerrtot(174),nerrdec(174),nmpcbad(87)
|
||||
logical checksumok,fsk,bpsk
|
||||
real*8, allocatable :: rxdata(:)
|
||||
real, allocatable :: llr(:)
|
||||
|
||||
data colorder/ &
|
||||
0, 1, 2, 3, 30, 4, 5, 6, 7, 8, 9, 10, 11, 32, 12, 40, 13, 14, 15, 16,&
|
||||
17, 18, 37, 45, 29, 19, 20, 21, 41, 22, 42, 31, 33, 34, 44, 35, 47, 51, 50, 43,&
|
||||
36, 52, 63, 46, 25, 55, 27, 24, 23, 53, 39, 49, 59, 38, 48, 61, 60, 57, 28, 62,&
|
||||
56, 58, 65, 66, 26, 70, 64, 69, 68, 67, 74, 71, 54, 76, 72, 75, 78, 77, 80, 79,&
|
||||
73, 83, 84, 81, 82, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99,&
|
||||
100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,&
|
||||
120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,&
|
||||
140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,&
|
||||
160,161,162,163,164,165,166,167,168,169,170,171,172,173/
|
||||
|
||||
do i=1,NRECENT
|
||||
recent_calls(i)=' '
|
||||
enddo
|
||||
nerrtot=0
|
||||
nerrdec=0
|
||||
nmpcbad=0 ! Used to collect the number of errors in the message+crc part of the codeword
|
||||
|
||||
nargs=iargc()
|
||||
if(nargs.ne.4) then
|
||||
print*,'Usage: ldpcsim niter norder #trials s '
|
||||
print*,'eg: ldpcsim 10 2 1000 0.84'
|
||||
print*,'belief propagation iterations: niter, ordered-statistics order: norder'
|
||||
print*,'If s is negative, then value is ignored and sigma is calculated from SNR.'
|
||||
return
|
||||
endif
|
||||
call getarg(1,arg)
|
||||
read(arg,*) max_iterations
|
||||
call getarg(2,arg)
|
||||
read(arg,*) norder
|
||||
call getarg(3,arg)
|
||||
read(arg,*) ntrials
|
||||
call getarg(4,arg)
|
||||
read(arg,*) s
|
||||
|
||||
fsk=.false.
|
||||
bpsk=.true.
|
||||
|
||||
! don't count crc bits as data bits
|
||||
N=174
|
||||
K=87
|
||||
! scale Eb/No for a (174,87) code
|
||||
rate=real(K)/real(N)
|
||||
|
||||
write(*,*) "rate: ",rate
|
||||
write(*,*) "niter= ",max_iterations," s= ",s
|
||||
|
||||
allocate ( codeword(N), decoded(K), message(K) )
|
||||
allocate ( rxdata(N), llr(N) )
|
||||
|
||||
msg="K1JT K9AN EN50"
|
||||
! msg="G4WJS K9AN EN50"
|
||||
call packmsg(msg,i4Msg6BitWords,itype) !Pack into 12 6-bit bytes
|
||||
call unpackmsg(i4Msg6BitWords,msgsent) !Unpack to get msgsent
|
||||
write(*,*) "message sent ",msgsent
|
||||
|
||||
i4=0
|
||||
ik=0
|
||||
im=0
|
||||
do i=1,12
|
||||
nn=i4Msg6BitWords(i)
|
||||
do j=1, 6
|
||||
ik=ik+1
|
||||
i4=i4+i4+iand(1,ishft(nn,j-6))
|
||||
i4=iand(i4,255)
|
||||
if(ik.eq.8) then
|
||||
im=im+1
|
||||
! if(i4.gt.127) i4=i4-256
|
||||
i1Msg8BitBytes(im)=i4
|
||||
ik=0
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
i1Msg8BitBytes(10:11)=0
|
||||
checksum = crc12 (c_loc (i1Msg8BitBytes), 11)
|
||||
! For reference, the next 3 lines show how to check the CRC
|
||||
i1Msg8BitBytes(10)=checksum/256
|
||||
i1Msg8BitBytes(11)=iand (checksum,255)
|
||||
checksumok = crc12_check(c_loc (i1Msg8BitBytes), 11)
|
||||
if( checksumok ) write(*,*) 'Good checksum'
|
||||
|
||||
! K=87, For now:
|
||||
! msgbits(1:72) JT message bits
|
||||
! msgbits(73:75) 3 free message bits (set to 0)
|
||||
! msgbits(76:87) CRC12
|
||||
mbit=0
|
||||
do i=1, 9
|
||||
i1=i1Msg8BitBytes(i)
|
||||
do ibit=1,8
|
||||
mbit=mbit+1
|
||||
msgbits(mbit)=iand(1,ishft(i1,ibit-8))
|
||||
enddo
|
||||
enddo
|
||||
msgbits(73:75)=0 ! the three extra message bits go here
|
||||
i1=i1Msg8BitBytes(10) ! First 4 bits of crc12 are LSB of this byte
|
||||
do ibit=1,4
|
||||
msgbits(75+ibit)=iand(1,ishft(i1,ibit-4))
|
||||
enddo
|
||||
i1=i1Msg8BitBytes(11) ! Now shift in last 8 bits of the CRC
|
||||
do ibit=1,8
|
||||
msgbits(79+ibit)=iand(1,ishft(i1,ibit-8))
|
||||
enddo
|
||||
|
||||
write(*,*) 'message'
|
||||
write(*,'(11(8i1,1x))') msgbits
|
||||
|
||||
call encode174(msgbits,codeword)
|
||||
call init_random_seed()
|
||||
call sgran()
|
||||
|
||||
write(*,*) 'codeword'
|
||||
write(*,'(22(8i1,1x))') codeword
|
||||
|
||||
write(*,*) "Es/N0 SNR2500 ngood nundetected nbadcrc sigma"
|
||||
do idb = 20,-10,-1
|
||||
db=idb/2.0-1.0
|
||||
sigma=1/sqrt( 2*(10**(db/10.0)) )
|
||||
ngood=0
|
||||
nue=0
|
||||
nbadcrc=0
|
||||
nberr=0
|
||||
do itrial=1, ntrials
|
||||
! Create a realization of a noisy received word
|
||||
do i=1,N
|
||||
if( bpsk ) then
|
||||
rxdata(i) = 2.0*codeword(i)-1.0 + sigma*gran()
|
||||
elseif( fsk ) then
|
||||
if( codeword(i) .eq. 1 ) then
|
||||
r1=(1.0 + sigma*gran())**2 + (sigma*gran())**2
|
||||
r2=(sigma*gran())**2 + (sigma*gran())**2
|
||||
elseif( codeword(i) .eq. 0 ) then
|
||||
r2=(1.0 + sigma*gran())**2 + (sigma*gran())**2
|
||||
r1=(sigma*gran())**2 + (sigma*gran())**2
|
||||
endif
|
||||
! rxdata(i)=0.35*(sqrt(r1)-sqrt(r2))
|
||||
! rxdata(i)=0.35*(exp(r1)-exp(r2))
|
||||
rxdata(i)=0.12*(log(r1)-log(r2))
|
||||
endif
|
||||
enddo
|
||||
nerr=0
|
||||
do i=1,N
|
||||
if( rxdata(i)*(2*codeword(i)-1.0) .lt. 0 ) nerr=nerr+1
|
||||
enddo
|
||||
nerrtot(nerr)=nerrtot(nerr)+1
|
||||
nberr=nberr+nerr
|
||||
|
||||
! Correct signal normalization is important for this decoder.
|
||||
rxav=sum(rxdata)/N
|
||||
rx2av=sum(rxdata*rxdata)/N
|
||||
rxsig=sqrt(rx2av-rxav*rxav)
|
||||
rxdata=rxdata/rxsig
|
||||
! To match the metric to the channel, s should be set to the noise standard deviation.
|
||||
! For now, set s to the value that optimizes decode probability near threshold.
|
||||
! The s parameter can be tuned to trade a few tenth's dB of threshold for an order of
|
||||
! magnitude in UER
|
||||
if( s .lt. 0 ) then
|
||||
ss=sigma
|
||||
else
|
||||
ss=s
|
||||
endif
|
||||
|
||||
llr=2.0*rxdata/(ss*ss)
|
||||
nap=0 ! number of AP bits
|
||||
llr(colorder(174-87+1:174-87+nap)+1)=5*(2.0*msgbits(1:nap)-1.0)
|
||||
apmask=0
|
||||
apmask(colorder(174-87+1:174-87+nap)+1)=1
|
||||
|
||||
! max_iterations is max number of belief propagation iterations
|
||||
call bpdecode174(llr, apmask, max_iterations, decoded, cw, nharderrors,niterations)
|
||||
if( norder .ge. 0 .and. nharderrors .lt. 0 ) call osd174(llr, apmask, norder, decoded, cw, nharderrors, dmin)
|
||||
! If the decoder finds a valid codeword, nharderrors will be .ge. 0.
|
||||
if( nharderrors .ge. 0 ) then
|
||||
call extractmessage174(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
|
||||
if( ncrcflag .ne. 1 ) then
|
||||
nbadcrc=nbadcrc+1
|
||||
endif
|
||||
|
||||
nueflag=0
|
||||
nerrmpc=0
|
||||
do i=1,K ! find number of errors in message+crc part of codeword
|
||||
if( msgbits(i) .ne. decoded(i) ) then
|
||||
nueflag=1
|
||||
nerrmpc=nerrmpc+1
|
||||
endif
|
||||
enddo
|
||||
nmpcbad(nerrmpc)=nmpcbad(nerrmpc)+1
|
||||
|
||||
if( ncrcflag .eq. 1 ) then
|
||||
if( nueflag .eq. 0 ) then
|
||||
ngood=ngood+1
|
||||
nerrdec(nerr)=nerrdec(nerr)+1
|
||||
else if( nueflag .eq. 1 ) then
|
||||
nue=nue+1;
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
baud=12000/1920
|
||||
snr2500=db+10.0*log10((baud/2500.0))
|
||||
pberr=real(nberr)/(real(ntrials*N))
|
||||
write(*,"(f4.1,4x,f5.1,1x,i8,1x,i8,1x,i8,8x,f5.2,8x,e10.3)") db,snr2500,ngood,nue,nbadcrc,ss,pberr
|
||||
|
||||
enddo
|
||||
|
||||
open(unit=23,file='nerrhisto.dat',status='unknown')
|
||||
do i=1,174
|
||||
write(23,'(i4,2x,i10,i10,f10.2)') i,nerrdec(i),nerrtot(i),real(nerrdec(i))/real(nerrtot(i)+1e-10)
|
||||
enddo
|
||||
close(23)
|
||||
open(unit=25,file='nmpcbad.dat',status='unknown')
|
||||
do i=1,87
|
||||
write(25,'(i4,2x,i10)') i,nmpcbad(i)
|
||||
enddo
|
||||
close(25)
|
||||
|
||||
end program ldpcsim174
|
||||
@@ -1,494 +0,0 @@
|
||||
module jt65_decode
|
||||
|
||||
integer, parameter :: NSZ=3413, NZMAX=60*12000
|
||||
|
||||
type :: jt65_decoder
|
||||
procedure(jt65_decode_callback), pointer :: callback => null()
|
||||
contains
|
||||
procedure :: decode
|
||||
end type jt65_decoder
|
||||
|
||||
! Callback function to be called with each decode
|
||||
abstract interface
|
||||
subroutine jt65_decode_callback(this,sync,snr,dt,freq,drift, &
|
||||
nflip,width,decoded,ft,qual,nsmo,nsum,minsync)
|
||||
|
||||
import jt65_decoder
|
||||
implicit none
|
||||
class(jt65_decoder), intent(inout) :: this
|
||||
real, intent(in) :: sync
|
||||
integer, intent(in) :: snr
|
||||
real, intent(in) :: dt
|
||||
integer, intent(in) :: freq
|
||||
integer, intent(in) :: drift
|
||||
integer, intent(in) :: nflip
|
||||
real, intent(in) :: width
|
||||
character(len=22), intent(in) :: decoded
|
||||
integer, intent(in) :: ft
|
||||
integer, intent(in) :: qual
|
||||
integer, intent(in) :: nsmo
|
||||
integer, intent(in) :: nsum
|
||||
integer, intent(in) :: minsync
|
||||
|
||||
end subroutine jt65_decode_callback
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine decode(this,callback,dd0,npts,newdat,nutc,nf1,nf2,nfqso, &
|
||||
ntol,nsubmode,minsync,nagain,n2pass,nrobust,ntrials,naggressive, &
|
||||
ndepth,emedelay,clearave,mycall,hiscall,hisgrid,nexp_decode)
|
||||
|
||||
! Process dd0() data to find and decode JT65 signals.
|
||||
|
||||
use jt65_mod
|
||||
use timer_module, only: timer
|
||||
|
||||
include 'constants.f90'
|
||||
|
||||
class(jt65_decoder), intent(inout) :: this
|
||||
procedure(jt65_decode_callback) :: callback
|
||||
real, intent(in) :: dd0(NZMAX),emedelay
|
||||
integer, intent(in) :: npts, nutc, nf1, nf2, nfqso, ntol &
|
||||
, nsubmode, minsync, n2pass, ntrials, naggressive, ndepth &
|
||||
, nexp_decode
|
||||
logical, intent(in) :: newdat, nagain, nrobust, clearave
|
||||
character(len=12), intent(in) :: mycall, hiscall
|
||||
character(len=6), intent(in) :: hisgrid
|
||||
|
||||
real dd(NZMAX)
|
||||
real ss(322,NSZ)
|
||||
real savg(NSZ)
|
||||
real a(5)
|
||||
character*22 decoded,decoded0,avemsg,deepave
|
||||
type candidate
|
||||
real freq
|
||||
real dt
|
||||
real sync
|
||||
real flip
|
||||
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,prtavg,single_decode,bVHF
|
||||
|
||||
integer h0(0:11),d0(0:11)
|
||||
real r0(0:11)
|
||||
common/decstats/ntry65a,ntry65b,n65a,n65b,num9,numfano
|
||||
common/steve/thresh0
|
||||
|
||||
! 0 1 2 3 4 5 6 7 8 9 10 11
|
||||
data h0/41,42,43,43,44,45,46,47,48,48,49,49/
|
||||
data d0/71,72,73,74,76,77,78,80,81,82,83,83/
|
||||
|
||||
! 0 1 2 3 4 5 6 7 8 9 10 11
|
||||
data r0/0.70,0.72,0.74,0.76,0.78,0.80,0.82,0.84,0.86,0.88,0.90,0.90/
|
||||
data nutc0/-999/,nfreq0/-999/,nsave/0/
|
||||
save
|
||||
|
||||
this%callback => callback
|
||||
first_time=newdat
|
||||
dd=dd0
|
||||
ndecoded=0
|
||||
|
||||
if(nsubmode.ge.100) then
|
||||
! This is QRA64 mode
|
||||
mode64=2**(nsubmode-100)
|
||||
!###
|
||||
! open(60,file='qra64_data.bin',access='stream',position='append')
|
||||
! write(60) dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, &
|
||||
! mycall,hiscall,hisgrid
|
||||
! close(60)
|
||||
!###
|
||||
call qra64a(dd,npts,nutc,nf1,nf2,nfqso,ntol,mode64,minsync,ndepth, &
|
||||
emedelay,mycall,hiscall,hisgrid,sync,nsnr,dtx,nfreq,decoded,nft)
|
||||
if (associated(this%callback)) then
|
||||
ndrift=0
|
||||
nflip=1
|
||||
width=1.0
|
||||
nsmo=0
|
||||
nqual=0
|
||||
call this%callback(sync,nsnr,dtx,nfreq,ndrift, &
|
||||
nflip,width,decoded,nft,nqual,nsmo,1,minsync)
|
||||
end if
|
||||
go to 900
|
||||
endif
|
||||
|
||||
do ipass=1,n2pass !Two-pass decoding loop
|
||||
first_time=.true.
|
||||
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) then
|
||||
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
|
||||
single_decode=iand(nexp_decode,32).ne.0 .or. nagain
|
||||
bVHF=iand(nexp_decode,64).ne.0
|
||||
|
||||
!### Q: should either of the next two uses of "single_decode" be "bVHF" instead?
|
||||
if(single_decode .or. (bVHF .and. ntol.lt.1000)) then
|
||||
nfa=max(200,nfqso-ntol)
|
||||
nfb=min(4000,nfqso+ntol)
|
||||
thresh0=1.0
|
||||
endif
|
||||
df=12000.0/8192.0 !df = 1.465 Hz
|
||||
if(bVHF) then
|
||||
ia=max(1,nint(nfa/df)-ntol)
|
||||
ib=min(NSZ,nint(nfb/df)+ntol)
|
||||
nz=ib-ia+1
|
||||
call lorentzian(savg(ia),nz,a)
|
||||
baseline=a(1)
|
||||
amp=a(2)
|
||||
f0=(a(3)+ia-1)*df
|
||||
width=a(4)*df
|
||||
endif
|
||||
|
||||
ncand=0
|
||||
call timer('sync65 ',0)
|
||||
call sync65(ss,nfa,nfb,naggressive,ntol,nhsym,ca,ncand,0,bVHF)
|
||||
call timer('sync65 ',1)
|
||||
|
||||
! If a candidate was found within +/- ntol of nfqso, move it into ca(1).
|
||||
call fqso_first(nfqso,ntol,ca,ncand)
|
||||
if(single_decode) then
|
||||
if(ncand.eq.0) ncand=1
|
||||
if(abs(ca(1)%freq - f0).gt.width) width=2*df !### ??? ###
|
||||
endif
|
||||
nvec=ntrials
|
||||
if(ncand.gt.75) then
|
||||
nvec=100
|
||||
endif
|
||||
|
||||
mode65=2**nsubmode
|
||||
nflip=1
|
||||
nqd=0
|
||||
decoded=' '
|
||||
decoded0=""
|
||||
freq0=0.
|
||||
prtavg=.false.
|
||||
if(.not.nagain) nsum=0
|
||||
if(clearave) then
|
||||
nsum=0
|
||||
nsave=0
|
||||
endif
|
||||
|
||||
if(bVHF) then
|
||||
! Be sure to search for shorthand message at nfqso +/- ntol
|
||||
if(ncand.lt.300) ncand=ncand+1
|
||||
ca(ncand)%sync=5.0
|
||||
ca(ncand)%dt=2.5
|
||||
ca(ncand)%freq=nfqso
|
||||
endif
|
||||
|
||||
do icand=1,ncand
|
||||
sync1=ca(icand)%sync
|
||||
dtx=ca(icand)%dt
|
||||
freq=ca(icand)%freq
|
||||
if(bVHF) then
|
||||
flip=ca(icand)%flip
|
||||
nflip=flip
|
||||
endif
|
||||
if(sync1.lt.float(minsync)) nflip=0
|
||||
if(ipass.eq.1) ntry65a=ntry65a + 1
|
||||
if(ipass.eq.2) ntry65b=ntry65b + 1
|
||||
call timer('decod65a',0)
|
||||
nft=0
|
||||
nspecial=0
|
||||
call decode65a(dd,npts,first_time,nqd,freq,nflip,mode65,nvec, &
|
||||
naggressive,ndepth,ntol,mycall,hiscall,hisgrid, &
|
||||
nexp_decode,bVHF,sync2,a,dtx,nft,nspecial,qual, &
|
||||
nhist,nsmo,decoded)
|
||||
if(nspecial.eq.2) decoded='RO'
|
||||
if(nspecial.eq.3) decoded='RRR'
|
||||
if(nspecial.eq.4) decoded='73'
|
||||
call timer('decod65a',1)
|
||||
if(sync1.lt.float(minsync) .and. &
|
||||
decoded.eq.' ') nflip=0
|
||||
if(nft.ne.0) nsum=1
|
||||
|
||||
nhard_min=param(1)
|
||||
nrtt1000=param(4)
|
||||
ntotal_min=param(5)
|
||||
nsmo=param(9)
|
||||
|
||||
nfreq=nint(freq+a(1))
|
||||
ndrift=nint(2.0*a(2))
|
||||
if(bVHF) then
|
||||
s2db=sync1 - 30.0 + db(width/3.3) !### VHF/UHF/microwave
|
||||
if(nspecial.gt.0) s2db=sync2
|
||||
else
|
||||
s2db=10.0*log10(sync2) - 35 !### Empirical (HF)
|
||||
endif
|
||||
nsnr=nint(s2db)
|
||||
if(nsnr.lt.-30) nsnr=-30
|
||||
if(nsnr.gt.-1) nsnr=-1
|
||||
nftt=0
|
||||
|
||||
if(nft.ne.1 .and. iand(ndepth,16).eq.16 .and. (.not.prtavg)) then
|
||||
! Single-sequence FT decode failed, so try for an average FT decode.
|
||||
if(nutc.ne.nutc0 .or. abs(nfreq-nfreq0).gt.ntol) then
|
||||
! This is a new minute or a new frequency, so call avg65.
|
||||
nutc0=nutc
|
||||
nfreq0=nfreq
|
||||
nsave=nsave+1
|
||||
nsave=mod(nsave-1,64)+1
|
||||
call avg65(nutc,nsave,sync1,dtx,nflip,nfreq,mode65,ntol, &
|
||||
ndepth,nagain,ntrials,naggressive,clearave,neme,mycall, &
|
||||
hiscall,hisgrid,nftt,avemsg,qave,deepave,nsum,ndeepave)
|
||||
nsmo=param(9)
|
||||
nqave=qave
|
||||
|
||||
if (associated(this%callback) .and. nsum.ge.2) then
|
||||
call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, &
|
||||
nflip,width,avemsg,nftt,nqave,nsmo,nsum,minsync)
|
||||
prtavg=.true.
|
||||
end if
|
||||
|
||||
endif
|
||||
endif
|
||||
|
||||
if(nftt.eq.1) then
|
||||
! nft=1
|
||||
decoded=avemsg
|
||||
go to 5
|
||||
endif
|
||||
n=naggressive
|
||||
rtt=0.001*nrtt1000
|
||||
if(nft.lt.2 .and. minsync.ge.0 .and. nspecial.eq.0) then
|
||||
if(nhard_min.gt.50) cycle
|
||||
if(nhard_min.gt.h0(n)) cycle
|
||||
if(ntotal_min.gt.d0(n)) cycle
|
||||
if(rtt.gt.r0(n)) cycle
|
||||
endif
|
||||
|
||||
5 continue
|
||||
if(decoded.eq.decoded0 .and. abs(freq-freq0).lt. 3.0 .and. &
|
||||
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
|
||||
|
||||
ndupe=0 ! de-dedupe
|
||||
do i=1, ndecoded
|
||||
if(decoded==dec(i)%decoded) then
|
||||
ndupe=1
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if(ndupe.ne.1 .and. sync1.ge.float(minsync)) then
|
||||
if(ipass.eq.1) n65a=n65a + 1
|
||||
if(ipass.eq.2) n65b=n65b + 1
|
||||
if(ndecoded.lt.50) 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 (associated(this%callback)) then
|
||||
call this%callback(sync1,nsnr,dtx-1.0,nfreq,ndrift, &
|
||||
nflip,width,decoded,nft,nqual,nsmo,1,minsync)
|
||||
end if
|
||||
endif
|
||||
decoded0=decoded
|
||||
freq0=freq
|
||||
if(decoded0.eq.' ') decoded0='*'
|
||||
endif
|
||||
enddo !Candidate loop
|
||||
if(ndecoded.lt.1) exit
|
||||
enddo !Two-pass loop
|
||||
|
||||
900 return
|
||||
end subroutine decode
|
||||
|
||||
subroutine avg65(nutc,nsave,snrsync,dtxx,nflip,nfreq,mode65,ntol,ndepth, &
|
||||
nagain, ntrials,naggressive,clearave,neme,mycall,hiscall,hisgrid,nftt, &
|
||||
avemsg,qave,deepave,nsum,ndeepave)
|
||||
|
||||
! Decodes averaged JT65 data
|
||||
|
||||
use jt65_mod
|
||||
parameter (MAXAVE=64)
|
||||
character*22 avemsg,deepave,deepbest
|
||||
character mycall*12,hiscall*12,hisgrid*6
|
||||
character*1 csync,cused(64)
|
||||
logical nagain
|
||||
integer iused(64)
|
||||
! Accumulated data for message averaging
|
||||
integer iutc(MAXAVE)
|
||||
integer nfsave(MAXAVE)
|
||||
integer nflipsave(MAXAVE)
|
||||
real s1b(-255:256,126)
|
||||
real s1save(-255:256,126,MAXAVE)
|
||||
real s2(66,126)
|
||||
real s3save(64,63,MAXAVE)
|
||||
real s3b(64,63)
|
||||
real s3c(64,63)
|
||||
real dtsave(MAXAVE)
|
||||
real syncsave(MAXAVE)
|
||||
logical first,clearave
|
||||
data first/.true./
|
||||
save
|
||||
|
||||
if(first .or. clearave) then
|
||||
iutc=-1
|
||||
nfsave=0
|
||||
dtdiff=0.2
|
||||
first=.false.
|
||||
s3save=0.
|
||||
s1save=0.
|
||||
nsave=1 !### ???
|
||||
! Silence compiler warnings
|
||||
if(nagain .and. ndeepave.eq.-99 .and. neme.eq.-99) stop
|
||||
endif
|
||||
|
||||
do i=1,64
|
||||
if(iutc(i).lt.0) exit
|
||||
if(nutc.eq.iutc(i) .and. abs(nfreq-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
|
||||
nflipsave(nsave)=nflip
|
||||
s1save(-255:256,1:126,nsave)=s1
|
||||
s3save(1:64,1:63,nsave)=s3a
|
||||
|
||||
10 syncsum=0.
|
||||
dtsum=0.
|
||||
nfsum=0
|
||||
nsum=0
|
||||
s1b=0.
|
||||
s3b=0.
|
||||
s3c=0.
|
||||
|
||||
do i=1,MAXAVE !Consider all saved spectra
|
||||
cused(i)='.'
|
||||
if(iutc(i).lt.0) cycle
|
||||
if(mod(iutc(i),2).ne.mod(nutc,2)) cycle !Use only same (odd/even) seq
|
||||
if(abs(dtxx-dtsave(i)).gt.dtdiff) cycle !DT must match
|
||||
if(abs(nfreq-nfsave(i)).gt.ntol) cycle !Freq must match
|
||||
if(nflip.ne.nflipsave(i)) cycle !Sync type (*/#) must match
|
||||
s3b=s3b + s3save(1:64,1:63,i)
|
||||
s1b=s1b + s1save(-255:256,1:126,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
|
||||
syncave=syncsum/nsum
|
||||
dtave=dtsum/nsum
|
||||
fave=float(nfsum)/nsum
|
||||
endif
|
||||
|
||||
do i=1,nsave
|
||||
csync='*'
|
||||
if(nflipsave(i).lt.0.0) csync='#'
|
||||
write(14,1000) cused(i),iutc(i),syncsave(i),dtsave(i)-1.0,nfsave(i),csync
|
||||
1000 format(a1,i5.4,f6.1,f6.2,i6,1x,a1)
|
||||
enddo
|
||||
if(nsum.lt.2) go to 900
|
||||
|
||||
nftt=0
|
||||
df=1378.125/512.0
|
||||
|
||||
! Do the smoothing loop
|
||||
qualbest=0.
|
||||
minsmo=0
|
||||
maxsmo=0
|
||||
if(mode65.ge.2) then
|
||||
minsmo=nint(width/df)
|
||||
maxsmo=2*minsmo
|
||||
endif
|
||||
nn=0
|
||||
do ismo=minsmo,maxsmo
|
||||
if(ismo.gt.0) then
|
||||
do j=1,126
|
||||
call smo121(s1b(-255,j),512)
|
||||
if(j.eq.1) nn=nn+1
|
||||
if(nn.ge.4) then
|
||||
call smo121(s1b(-255,j),512)
|
||||
if(j.eq.1) nn=nn+1
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
do i=1,66
|
||||
jj=i
|
||||
if(mode65.eq.2) jj=2*i-1
|
||||
if(mode65.eq.4) then
|
||||
ff=4*(i-1)*df - 355.297852
|
||||
jj=nint(ff/df)+1
|
||||
endif
|
||||
s2(i,1:126)=s1b(jj,1:126)
|
||||
enddo
|
||||
|
||||
do j=1,63
|
||||
k=mdat(j) !Points to data symbol
|
||||
if(nflip.lt.0) k=mdat2(j)
|
||||
do i=1,64
|
||||
s3c(i,j)=4.e-5*s2(i+2,k)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
nadd=nsum*ismo
|
||||
call extract(s3c,nadd,mode65,ntrials,naggressive,ndepth,nflip,mycall, &
|
||||
hiscall,hisgrid,nexp_decode,ncount,nhist,avemsg,ltext,nftt,qual)
|
||||
if(nftt.eq.1) then
|
||||
nsmo=ismo
|
||||
param(9)=nsmo
|
||||
go to 900
|
||||
else if(nftt.eq.2) then
|
||||
if(qual.gt.qualbest) then
|
||||
deepbest=avemsg
|
||||
qualbest=qual
|
||||
nnbest=nn
|
||||
nsmobest=ismo
|
||||
nfttbest=nftt
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
|
||||
if(nfttbest.eq.2) then
|
||||
avemsg=deepbest !### ???
|
||||
deepave=deepbest
|
||||
qave=qualbest
|
||||
nsmo=nsmobest
|
||||
param(9)=nsmo
|
||||
nftt=nfttbest
|
||||
endif
|
||||
900 continue
|
||||
|
||||
return
|
||||
end subroutine avg65
|
||||
|
||||
end module jt65_decode
|
||||
Reference in New Issue
Block a user