Working program test_ft8q3 and subroutine ft8q3().

This commit is contained in:
Joe Taylor 2021-10-26 16:40:14 -04:00
parent 384899754f
commit 901e9dbc38
3 changed files with 99 additions and 115 deletions

View File

@ -104,7 +104,8 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,nzhsym,lapon, &
call timer('ft8_down',0)
call ft8_downsample(dd0,newdat,f1,cd0) !Mix f1 to baseband and downsample
call timer('ft8_down',1)
if(f1.eq.1500.0) then
if(abs(nint(f1)-527).le.1) then
rewind(40)
do i=0,3199
write(40,3040) i,i/200.0,cd0(i)
3040 format(i5,f10.6,2x,2f10.3)

View File

@ -1,84 +1,110 @@
program ft8q3
subroutine ft8q3(cd,xdt,f0,call_1,call_2,grid4,msgbest,snr)
! Test q3-style decodes for FT8.
! Get q3-style decodes for FT8.
use packjt77
parameter(NN=79,NSPS=32)
parameter(NWAVE=NN*NSPS) !2528
parameter(NZ=3200,NLAGS=NZ-NWAVE)
character arg*12
character msg37*37
character*12 call_1,call_2
character*4 grid4
character*37 msg,msgbest,msgsent
character c77*77
complex cwave(0:NWAVE-1)
complex cd(0:NZ-1)
complex z
real xjunk(NWAVE)
real ccf(0:NLAGS-1)
real ccfmsg(207)
integer itone(NN)
integer*1 msgbits(77)
logical std_1,std_2
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.3) then
print*,'Usage: ft8q3 DT f0 "message"'
go to 999
endif
call getarg(1,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(2,arg)
read(arg,*) f0 !Frequency (Hz)
call getarg(3,msg37) !Message to be transmitted
if(xdt.eq.-99.0) return !Silence compiler warning
call stdcall(call_1,std_1)
call stdcall(call_2,std_2)
fs=200.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
bt=2.0
bt=2.0
ccfbest=0.
lagbest=-1
do imsg=1,207
msg=trim(call_1)//' '//trim(call_2)
i=imsg
if(.not.std_1) then
if(i.eq.1 .or. i.ge.6) msg='<'//trim(call_1)//'> '//trim(call_2)
if(i.ge.2 .and. i.le.4) msg=trim(call_1)//' <'//trim(call_2)//'>'
else if(.not.std_2) then
if(i.le.4 .or. i.eq.6) msg='<'//trim(call_1)//'> '//trim(call_2)
if(i.ge.7) msg=trim(call_1)//' <'//trim(call_2)//'>'
endif
j0=len(trim(msg))+2
if(i.eq.2) msg(j0:j0+2)='RRR'
if(i.eq.3) msg(j0:j0+3)='RR73'
if(i.eq.4) msg(j0:j0+1)='73'
if(i.eq.5) then
if(std_2) msg='CQ '//trim(call_2)//' '//grid4
if(.not.std_2) msg='CQ '//trim(call_2)
endif
if(i.eq.6 .and. std_2) msg(j0:j0+3)=grid4
if(i.ge.7 .and. i.le.206) then
isnr = -50 + (i-7)/2
if(iand(i,1).eq.1) then
write(msg(j0:j0+2),'(i3.2)') isnr
if(msg(j0:j0).eq.' ') msg(j0:j0)='+'
else
write(msg(j0:j0+3),'("R",i3.2)') isnr
if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+'
endif
endif
if(i.eq.207) msg='TNX 73 GL'
! Source-encode, then get itone()
i3=-1
n3=-1
call pack77(msg37,i3,n3,c77)
call genft8(msg37,i3,n3,msgsent37,msgbits,itone)
i3=-1
n3=-1
call pack77(msg,i3,n3,c77)
call genft8(msg,i3,n3,msgsent,msgbits,itone)
! Generate complex cwave
call gen_ft8wave(itone,NN,NSPS,bt,fs,f0,cwave,xjunk,1,NWAVE)
call gen_ft8wave(itone,NN,NSPS,bt,fs,f0,cwave,xjunk,1,NWAVE)
do i=0,NZ-1
read(40,3040) cd(i)
3040 format(17x,2f10.3)
enddo
lagbest=-1
ccfbest=0.
nsum=32*2
do lag=0,nlags-1
z=0.
s=0.
do i=0,NWAVE-1
z=z + cd(i+lag)*conjg(cwave(i))
if(mod(i,nsum).eq.nsum-1 .or. i.eq.NWAVE-1) then
s=s + abs(z)
z=0.
lagmax=-1
ccfmax=0.
nsum=32*2
do lag=0,nlags-1
z=0.
s=0.
do i=0,NWAVE-1
z=z + cd(i+lag)*conjg(cwave(i))
if(mod(i,nsum).eq.nsum-1 .or. i.eq.NWAVE-1) then
s=s + abs(z)
z=0.
endif
enddo
ccf(lag)=s
if(ccf(lag).gt.ccfmax) then
ccfmax=ccf(lag)
lagmax=lag
endif
enddo
! ccf(lag)=abs(z)
ccf(lag)=s
write(42,3042) lag-100,(lag-100)/200.0,ccf(lag)
3042 format(i5,f10.3,f10.0)
if(ccf(lag).gt.ccfbest) then
ccfbest=ccf(lag)
lagbest=lag
enddo ! lag
ccfmsg(imsg)=ccfmax
if(ccfmax.gt.ccfbest) then
ccfbest=ccfmax
lagbest=lagmax
msgbest=msg
endif
enddo
enddo ! imsg
z=0.
do i=0,NWAVE-1
z=z + cd(i+lagbest)*conjg(cwave(i))
if(mod(i,32).eq.31) then
amp=abs(z)**2
pha=atan2(aimag(z),real(z))
j=i/32
write(43,3043) z,j,amp,pha
3043 format(2f12.0,i6,f12.0,f12.6)
endif
call pctile(ccfmsg,207,50,base)
call pctile(ccfmsg,207,67,sigma)
sigma=sigma-base
ccfmsg=(ccfmsg-base)/(2.5*sigma)
do imsg=1,207
write(44,3044) imsg,ccfmsg(imsg)
3044 format(i5,f10.3)
enddo
snr=maxval(ccfmsg)
999 end program ft8q3
return
end subroutine ft8q3

View File

@ -7,78 +7,35 @@ program test_ft8q3
parameter(NWAVE=NN*NSPS) !2528
parameter(NZ=3200,NLAGS=NZ-NWAVE)
character arg*12
character msg37*37
character c77*77
complex cwave(0:NWAVE-1)
character*37 msg
character*12 call_1,call_2
character*4 grid4
complex cd(0:NZ-1)
complex z
real xjunk(NWAVE)
real ccf(0:NLAGS-1)
integer itone(NN)
integer*1 msgbits(77)
! Get command-line argument(s)
nargs=iargc()
if(nargs.ne.3) then
print*,'Usage: ft8q3 DT f0 "message"'
if(nargs.ne.4 .and. nargs.ne.5) then
print*,'Usage: ft8q3 DT f0 call_1 call_2 [grid4]'
go to 999
endif
call getarg(1,arg)
read(arg,*) xdt !Time offset from nominal (s)
call getarg(2,arg)
read(arg,*) f0 !Frequency (Hz)
call getarg(3,msg37) !Message to be transmitted
fs=200.0 !Sample rate (Hz)
dt=1.0/fs !Sample interval (s)
bt=2.0
! Source-encode, then get itone()
i3=-1
n3=-1
call pack77(msg37,i3,n3,c77)
call genft8(msg37,i3,n3,msgsent37,msgbits,itone)
! Generate complex cwave
call gen_ft8wave(itone,NN,NSPS,bt,fs,f0,cwave,xjunk,1,NWAVE)
call getarg(3,call_1) !First callsign
call getarg(4,call_2) !Second callsign
grid4=' '
if(nargs.eq.5) call getarg(5,grid4) !Locator for call_2
do i=0,NZ-1
read(40,3040) cd(i)
3040 format(17x,2f10.3)
enddo
lagbest=-1
ccfbest=0.
nsum=32*2
do lag=0,nlags-1
z=0.
s=0.
do i=0,NWAVE-1
z=z + cd(i+lag)*conjg(cwave(i))
if(mod(i,nsum).eq.nsum-1 .or. i.eq.NWAVE-1) then
s=s + abs(z)
z=0.
endif
enddo
! ccf(lag)=abs(z)
ccf(lag)=s
write(42,3042) lag-100,(lag-100)/200.0,ccf(lag)
3042 format(i5,f10.3,f10.0)
if(ccf(lag).gt.ccfbest) then
ccfbest=ccf(lag)
lagbest=lag
endif
enddo
z=0.
do i=0,NWAVE-1
z=z + cd(i+lagbest)*conjg(cwave(i))
if(mod(i,32).eq.31) then
amp=abs(z)**2
pha=atan2(aimag(z),real(z))
j=i/32
write(43,3043) z,j,amp,pha
3043 format(2f12.0,i6,f12.0,f12.6)
endif
enddo
call sec0(0,t)
call ft8q3(cd,xdt,f0,call_1,call_2,grid4,msg,snr)
call sec0(1,t)
write(*,1100) t,snr,trim(msg)
1100 format('Time:',f6.2,' S/N:',f6.1,' msg: ',a)
999 end program test_ft8q3