Working toward some new, separate, Q65 subroutines.

This commit is contained in:
Joe Taylor 2021-01-12 14:34:41 -05:00
parent a75037d053
commit 60a053aa94

View File

@ -21,12 +21,11 @@ subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps, &
parameter (LN=2176*63) !LN=LL*NN; LL=64*(mode_q65+2), NN=63 parameter (LN=2176*63) !LN=LL*NN; LL=64*(mode_q65+2), NN=63
integer*2 iwave(0:12000*ntrperiod-1) !Raw data integer*2 iwave(0:12000*ntrperiod-1) !Raw data
integer isync(22) !Indices of sync symbols integer isync(22) !Indices of sync symbols
integer itone(85)
integer codewords(63,206) integer codewords(63,206)
integer dat4(13) integer dat4(13)
integer ijpk(2) integer ijpk(2)
logical lclearave
character*37 decoded character*37 decoded
logical lclearave
real, allocatable :: s1(:,:) !Symbol spectra, 1/8-symbol steps real, allocatable :: s1(:,:) !Symbol spectra, 1/8-symbol steps
real, allocatable :: s3(:,:) !Data-symbol energies s3(LL,63) real, allocatable :: s3(:,:) !Data-symbol energies s3(LL,63)
real, allocatable :: ccf(:,:) !CCF(freq,lag) real, allocatable :: ccf(:,:) !CCF(freq,lag)
@ -104,105 +103,15 @@ subroutine q65_sync(nutc,iwave,ntrperiod,mode_q65,codewords,ncw,nsps, &
!###################################################################### !######################################################################
! Try list decoding via "Deep Likelihood". ! Try list decoding via "Deep Likelihood".
call timer('list_dec',0) call timer('list_dec',0)
! call q65_dec_q3(codewords,ncw,isync,df call q65_dec_q3(codewords,ncw,isync,sync,df,s1,iz,jz,ia,ibwa,ibwb, &
nstep,nsps,mode_q65,lag1,lag2,i0,j0,ccf,ccf1,ccf2,ia2,s3,LL,snr2, &
ipk=0 dat4,idec,decoded)
jpk=0
ccf_best=0.
imsg_best=-1
do imsg=1,ncw
i=1
k=0
do j=1,85
if(j.eq.isync(i)) then
i=i+1
itone(j)=-1
else
k=k+1
itone(j)=codewords(k,imsg)
endif
enddo
! Compute 2D ccf using all 85 symbols in the list message
ccf=0.
iia=200.0/df
do lag=lag1,lag2
do k=1,85
j=j0 + NSTEP*(k-1) + 1 + lag
if(j.ge.1 .and. j.le.jz) then
do i=-ia2,ia2
ii=i0+mode_q65*itone(k)+i
if(ii.ge.iia .and. ii.le.iz) ccf(i,lag)=ccf(i,lag) + s1(ii,j)
enddo
endif
enddo
enddo
ccfmax=maxval(ccf(-ia:ia,:))
if(ccfmax.gt.ccf_best) then
ccf_best=ccfmax
ijpk=maxloc(ccf(-ia:ia,:))
ipk=ijpk(1)-ia-1
jpk=ijpk(2)-53-1
f0=nfqso + (ipk-mode_q65)*df
xdt=jpk*dtstep
imsg_best=imsg
ccf1=ccf(:,jpk)
endif
enddo ! imsg
call timer('list_dec',1) call timer('list_dec',1)
if(idec.lt.0) then
i1=i0+ipk-64 irc=-2
i2=i1+LL-1 dat4=0
j=j0+jpk-7 endif
n=0
do k=1,85
j=j+8
if(sync(k).gt.0.0) then
cycle
endif
n=n+1
if(j.ge.1 .and. j.le.jz) then
do i=0,LL-1
s3(i-64,n)=s1(i+i1,j) !Copy from s1 into s3
enddo
endif
enddo
nsubmode=0
if(mode_q65.eq.2) nsubmode=1
if(mode_q65.eq.4) nsubmode=2
if(mode_q65.eq.8) nsubmode=3
if(mode_q65.eq.16) nsubmode=4
nFadingModel=1
baud=12000.0/nsps
do ibw=ibwa,ibwb
b90=1.72**ibw
b90ts=b90/baud
call timer('dec1 ',0)
call q65_dec1(s3,nsubmode,b90ts,codewords,ncw,esnodb,irc,dat4,decoded)
call timer('dec1 ',1)
if(irc.ge.0) then
snr2=esnodb - db(2500.0/baud) + 3.0 !Empirical adjustment
idec=1
ic=ia2/4;
base=(sum(ccf1(-ia2:-ia2+ic)) + sum(ccf1(ia2-ic:ia2)))/(2.0+2.0*ic);
ccf1=ccf1-base
smax=maxval(ccf1)
if(smax.gt.10.0) ccf1=10.0*ccf1/smax
base=(sum(ccf2(-ia2:-ia2+ic)) + sum(ccf2(ia2-ic:ia2)))/(2.0+2.0*ic);
ccf2=ccf2-base
smax=maxval(ccf2)
if(smax.gt.10.0) ccf2=10.0*ccf2/smax
go to 100
endif
enddo
irc=-2
dat4=0
!###################################################################### !######################################################################
! Compute the 2D CCF using sync symbols only ! Compute the 2D CCF using sync symbols only
@ -329,6 +238,115 @@ subroutine q65_symspec(iwave,nmax,nsps,iz,jz,istep,nsmo,s1)
return return
end subroutine q65_symspec end subroutine q65_symspec
subroutine q65_dec_q3(codewords,ncw,isync,sync,df,s1,iz,jz,ia,ibwa,ibwb, &
nstep,nsps,mode_q65,lag1,lag2,i0,j0,ccf,ccf1,ccf2,ia2,s3,LL,snr2, &
dat4,idec,decoded)
character*37 decoded
integer isync(22) !Indices of sync symbols
integer itone(85)
integer ijpk(2)
integer codewords(63,206)
integer dat4(13)
real ccf(-ia2:ia2,-53:214)
real ccf1(-ia2:ia2)
real ccf2(-ia2:ia2)
real s1(iz,jz)
real s3(-64:LL-65,63)
real sync(85) !sync vector
ipk=0
jpk=0
ccf_best=0.
imsg_best=-1
do imsg=1,ncw
i=1
k=0
do j=1,85
if(j.eq.isync(i)) then
i=i+1
itone(j)=-1
else
k=k+1
itone(j)=codewords(k,imsg)
endif
enddo
! Compute 2D ccf using all 85 symbols in the list message
ccf=0.
iia=200.0/df
do lag=lag1,lag2
do k=1,85
j=j0 + NSTEP*(k-1) + 1 + lag
if(j.ge.1 .and. j.le.jz) then
do i=-ia2,ia2
ii=i0+mode_q65*itone(k)+i
if(ii.ge.iia .and. ii.le.iz) ccf(i,lag)=ccf(i,lag) + s1(ii,j)
enddo
endif
enddo
enddo
ccfmax=maxval(ccf(-ia:ia,:))
if(ccfmax.gt.ccf_best) then
ccf_best=ccfmax
ijpk=maxloc(ccf(-ia:ia,:))
ipk=ijpk(1)-ia-1
jpk=ijpk(2)-53-1
f0=nfqso + (ipk-mode_q65)*df
xdt=jpk*dtstep
imsg_best=imsg
ccf1=ccf(:,jpk)
endif
enddo ! imsg
i1=i0+ipk-64
i2=i1+LL-1
j=j0+jpk-7
n=0
do k=1,85
j=j+8
if(sync(k).gt.0.0) then
cycle
endif
n=n+1
if(j.ge.1 .and. j.le.jz) then
do i=0,LL-1
s3(i-64,n)=s1(i+i1,j) !Copy from s1 into s3
enddo
endif
enddo
nsubmode=0
if(mode_q65.eq.2) nsubmode=1
if(mode_q65.eq.4) nsubmode=2
if(mode_q65.eq.8) nsubmode=3
if(mode_q65.eq.16) nsubmode=4
nFadingModel=1
baud=12000.0/nsps
do ibw=ibwa,ibwb
b90=1.72**ibw
b90ts=b90/baud
call q65_dec1(s3,nsubmode,b90ts,codewords,ncw,esnodb,irc,dat4,decoded)
if(irc.ge.0) then
snr2=esnodb - db(2500.0/baud) + 3.0 !Empirical adjustment
idec=1
ic=ia2/4;
base=(sum(ccf1(-ia2:-ia2+ic)) + sum(ccf1(ia2-ic:ia2)))/(2.0+2.0*ic);
ccf1=ccf1-base
smax=maxval(ccf1)
if(smax.gt.10.0) ccf1=10.0*ccf1/smax
base=(sum(ccf2(-ia2:-ia2+ic)) + sum(ccf2(ia2-ic:ia2)))/(2.0+2.0*ic);
ccf2=ccf2-base
smax=maxval(ccf2)
if(smax.gt.10.0) ccf2=10.0*ccf2/smax
exit
endif
enddo
return
end subroutine q65_dec_q3
subroutine q65_dec1(s3,nsubmode,b90ts,codewords,ncw,esnodb,irc,dat4,decoded) subroutine q65_dec1(s3,nsubmode,b90ts,codewords,ncw,esnodb,irc,dat4,decoded)