Q65 code cleanup. Use 3-digit format for the end-of-line flag.

This commit is contained in:
Joe Taylor 2020-11-30 13:14:18 -05:00
parent 8285fd28a8
commit de6f5e4975
4 changed files with 33 additions and 41 deletions

View File

@ -777,8 +777,7 @@ contains
return
end subroutine fst4_decoded
subroutine q65_decoded (this,nutc,sync,nsnr,dt,freq,decoded,irc, &
qual,ntrperiod,fmid,w50)
subroutine q65_decoded (this,nutc,sync,nsnr,dt,freq,decoded,idec,ntrperiod)
use q65_decode
implicit none
@ -790,22 +789,17 @@ contains
real, intent(in) :: dt
real, intent(in) :: freq
character(len=37), intent(in) :: decoded
integer, intent(in) :: irc
real, intent(in) :: qual
integer, intent(in) :: idec
integer, intent(in) :: ntrperiod
real, intent(in) :: fmid
real, intent(in) :: w50
integer navg
navg=irc/100
if(ntrperiod.lt.60) then
write(*,1001) nutc,nsnr,dt,nint(freq),decoded,mod(irc,100),navg
1001 format(i6.6,i4,f5.1,i5,' + ',1x,a37,1x,i2,i4)
write(*,1001) nutc,nsnr,dt,nint(freq),decoded,idec
1001 format(i6.6,i4,f5.1,i5,' + ',1x,a37,1x,i3.3)
write(13,1002) nutc,nint(sync),nsnr,dt,freq,0,decoded
1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a37,' Q65')
else
write(*,1003) nutc,nsnr,dt,nint(freq),decoded,mod(irc,100),navg
1003 format(i4.4,i4,f5.1,i5,' + ',1x,a37,1x,i2,i4)
write(*,1003) nutc,nsnr,dt,nint(freq),decoded,idec
1003 format(i4.4,i4,f5.1,i5,' + ',1x,a37,1x,i3.3)
write(13,1004) nutc,nint(sync),nsnr,dt,freq,0,decoded
1004 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a37,' Q65')

View File

@ -8,7 +8,7 @@ module q65_decode
abstract interface
subroutine q65_decode_callback (this,nutc,sync,nsnr,dt,freq, &
decoded,nap,qual,ntrperiod,fmid,w50)
decoded,nap,ntrperiod)
import q65_decoder
implicit none
class(q65_decoder), intent(inout) :: this
@ -19,10 +19,7 @@ module q65_decode
real, intent(in) :: freq
character(len=37), intent(in) :: decoded
integer, intent(in) :: nap
real, intent(in) :: qual
integer, intent(in) :: ntrperiod
real, intent(in) :: fmid
real, intent(in) :: w50
end subroutine q65_decode_callback
end interface
@ -64,6 +61,9 @@ contains
complex, allocatable :: c00(:) !Analytic signal, 6000 Sa/s
complex, allocatable :: c0(:) !Analytic signal, 6000 Sa/s
id1=0
id2=0
id3=0
mode65=2**nsubmode
npts=ntrperiod*12000
nfft1=ntrperiod*12000
@ -93,21 +93,16 @@ contains
call q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
dgen=0
call q65_enc(dgen,codewords) !Initialize Q65
! nQSOprogress=3 !###
dat4=0
call timer('sync_q65',0)
call q65_sync(iwave,ntrperiod*12000,mode65,codewords,ncw,nsps, &
nfqso,ntol,xdt,f0,snr1,dat4,snr2,irc)
call q65_sync(nutc,iwave,ntrperiod*12000,mode65,codewords,ncw,nsps, &
nfqso,ntol,xdt,f0,snr1,dat4,snr2,id1)
call timer('sync_q65',1)
! write(55,3055) nutc,xdt,f0,snr1,snr2,irc
!3055 format(i4.4,4f9.2,i5)
if(irc.ge.0) then
if(id1.eq.1) then
xdt1=xdt
f1=f0
go to 100
endif
irc=-9
if(snr1.lt.2.8) go to 100
jpk0=(xdt+1.0)*6000 !### Is this OK?
if(ntrperiod.le.30) jpk0=(xdt+0.5)*6000 !###
@ -116,7 +111,6 @@ contains
dd=fac*iwave(1:npts)
nmode=65
call ana64(dd,npts,c00)
call ft8apset(mycall,hiscall,ncontest,apsym0,aph10)
where(apsym0.eq.-1) apsym0=0
@ -148,31 +142,28 @@ contains
call timer('q65loops',0)
call q65_loops(c00,nutc,npts/2,nsps/2,nmode,mode65,nsubmode, &
nFadingModel,ndepth,jpk0,xdt,f0,iaptype,apmask,apsymbols, &
codewords,snr1,xdt1,f1,snr2,irc,dat4)
codewords,snr1,xdt1,f1,snr2,dat4,id2,id3)
call timer('q65loops',1)
snr2=snr2 + db(6912.0/nsps)
if(irc.ge.0) exit
if(id2+id3.gt.0) exit
enddo
100 decoded=' '
! if(irc.lt.0 .and.iaptype.eq.4) print*,'AAA',irc,iaptype
if(irc.ge.0) then
!###
navg=irc/100
! irc=100*navg + ipass
irc=100*navg + iaptype
!###
idec=100*id1 + 10*id2 + id3
write(71,3071) nutc,id1,id2,id3,irc
3071 format(5i6)
if(idec.gt.0) then
write(c77,1000) dat4(1:12),dat4(13)/2
1000 format(12b6.6,b5.5)
call unpack77(c77,0,decoded,unpk77_success) !Unpack to get msgsent
nsnr=nint(snr2)
call this%callback(nutc,sync,nsnr,xdt1,f1,decoded, &
irc,qual,ntrperiod,fmid,w50)
idec,ntrperiod)
else
! Report sync, even if no decode.
nsnr=db(snr1) - 35.0
call this%callback(nutc,sync,nsnr,xdt1,f1,decoded, &
irc,qual,ntrperiod,fmid,w50)
idec,ntrperiod)
endif
return

View File

@ -1,5 +1,5 @@
subroutine q65_sync(iwave,nmax,mode_q65,codewords,ncw,nsps,nfqso,ntol, &
xdt,f0,snr1,dat4,snr2,irc)
subroutine q65_sync(nutc,iwave,nmax,mode_q65,codewords,ncw,nsps,nfqso,ntol, &
xdt,f0,snr1,dat4,snr2,id1)
! Detect and align with the Q65 sync vector, returning time and frequency
! offsets and SNR estimate.
@ -32,6 +32,8 @@ subroutine q65_sync(iwave,nmax,mode_q65,codewords,ncw,nsps,nfqso,ntol, &
data sync(1)/99.0/
save sync
id1=0
dat4=0
LL=64*(2+mode_q65)
nfft=nsps
df=12000.0/nfft !Freq resolution = baud
@ -157,14 +159,15 @@ subroutine q65_sync(iwave,nmax,mode_q65,codewords,ncw,nsps,nfqso,ntol, &
nsubmode=0
nFadingModel=1
baud=12000.0/nsps
dat4=0
irc=-2
do ibw=0,10
b90=1.72**ibw
call q65_intrinsics_ff(s3,nsubmode,b90/baud,nFadingModel,s3prob)
call q65_dec_fullaplist(s3,s3prob,codewords,ncw,esnodb,dat4,plog,irc)
if(irc.ge.0) then
snr2=esnodb - db(2500.0/baud)
id1=1
! write(55,3055) nutc,xdt,f0,snr2,plog,irc
!3055 format(i4.4,4f9.2,i5)
go to 900
endif
enddo

View File

@ -1,6 +1,6 @@
subroutine q65_loops(c00,nutc,npts2,nsps,mode,mode_q65,nsubmode,nFadingModel, &
ndepth,jpk0,xdt0,f0,iaptype,APmask,APsymbols,codewords,snr1, &
xdt1,f1,snr2,irc,dat4)
xdt1,f1,snr2,dat4,id2,id3)
use packjt77
use timer_module, only: timer
@ -29,6 +29,8 @@ subroutine q65_loops(c00,nutc,npts2,nsps,mode,mode_q65,nsubmode,nFadingModel, &
save nsave,s3avg
id2=0
id3=0
ircbest=9999
allocate(c0(0:npts2-1))
irc=-99
@ -101,10 +103,12 @@ subroutine q65_loops(c00,nutc,npts2,nsps,mode,mode_q65,nsubmode,nFadingModel, &
call q65_dec_fullaplist(s3,s3prob,codewords,4,esnodb, &
dat4,plog,irc)
call timer('q65_apli',1)
if(irc.ge.0) id2=4
else
call timer('q65_dec ',0)
call q65_dec(s3,s3prob,APmask,APsymbols,esnodb,dat4,irc)
call timer('q65_dec ',1)
if(irc.ge.0) id2=iaptype
endif
! write(71,3071) 100*nutc,0.0,ndf,ndt,nbw,ndist,irc,iaptype, &
! kavg,nsave