Working program test_ft8q3 and subroutine ft8q3().

lib/ft8/ft8b.f90

@@ -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)

lib/ft8/ft8q3.f90

@@ -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*12 call_1,call_2
-  character msg37*37
+  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)
+  if(xdt.eq.-99.0) return                !Silence compiler warning
-  nargs=iargc()
+  call stdcall(call_1,std_1)
-  if(nargs.ne.3) then
+  call stdcall(call_2,std_2)
-     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
 
   fs=200.0                               !Sample rate (Hz)
   dt=1.0/fs                              !Sample interval (s)
   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
+     i3=-1
-  n3=-1
+     n3=-1
-  call pack77(msg37,i3,n3,c77)
+     call pack77(msg,i3,n3,c77)
-  call genft8(msg37,i3,n3,msgsent37,msgbits,itone)
+     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
+     lagmax=-1
-     read(40,3040) cd(i)
+     ccfmax=0.
-3040 format(17x,2f10.3)
+     nsum=32*2
-  enddo
+     do lag=0,nlags-1
-
+        z=0.
-  lagbest=-1
+        s=0.
-  ccfbest=0.
+        do i=0,NWAVE-1
-  nsum=32*2
+           z=z + cd(i+lag)*conjg(cwave(i))
-  do lag=0,nlags-1
+           if(mod(i,nsum).eq.nsum-1 .or. i.eq.NWAVE-1) then
-     z=0.
+              s=s + abs(z)
-     s=0.
+              z=0.
-     do i=0,NWAVE-1
+           endif
-        z=z + cd(i+lag)*conjg(cwave(i))
+        enddo
-        if(mod(i,nsum).eq.nsum-1 .or. i.eq.NWAVE-1) then
+        ccf(lag)=s
-           s=s + abs(z)
+        if(ccf(lag).gt.ccfmax) then
-           z=0.
+           ccfmax=ccf(lag)
+           lagmax=lag
         endif
-     enddo
+     enddo ! lag
-!     ccf(lag)=abs(z)
+     ccfmsg(imsg)=ccfmax
-     ccf(lag)=s
+     if(ccfmax.gt.ccfbest) then
-     write(42,3042) lag-100,(lag-100)/200.0,ccf(lag)
+        ccfbest=ccfmax
-3042 format(i5,f10.3,f10.0)
+        lagbest=lagmax
-     if(ccf(lag).gt.ccfbest) then
+        msgbest=msg
-        ccfbest=ccf(lag)
-        lagbest=lag
      endif
-  enddo
+  enddo  ! imsg
 
-  z=0.
+  call pctile(ccfmsg,207,50,base)
-  do i=0,NWAVE-1
+  call pctile(ccfmsg,207,67,sigma)
-     z=z + cd(i+lagbest)*conjg(cwave(i))
+  sigma=sigma-base
-     if(mod(i,32).eq.31) then
+  ccfmsg=(ccfmsg-base)/(2.5*sigma)
-        amp=abs(z)**2
+  do imsg=1,207
-        pha=atan2(aimag(z),real(z))
+     write(44,3044) imsg,ccfmsg(imsg)
-        j=i/32
+3044 format(i5,f10.3)
-        write(43,3043) z,j,amp,pha
-3043    format(2f12.0,i6,f12.0,f12.6)
-     endif
   enddo
+  snr=maxval(ccfmsg)
 
-999 end program ft8q3
+  return
+end subroutine ft8q3

lib/ft8/test_ft8q3.f90

@@ -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*37 msg
-  character c77*77
+  character*12 call_1,call_2
-  complex cwave(0:NWAVE-1)
+  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
+  if(nargs.ne.4 .and. nargs.ne.5) then
-     print*,'Usage:    ft8q3 DT f0 "message"'
+     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
+  call getarg(3,call_1)                  !First callsign
-
+  call getarg(4,call_2)                  !Second callsign
-  fs=200.0                               !Sample rate (Hz)
+  grid4='    '
-  dt=1.0/fs                              !Sample interval (s)
+  if(nargs.eq.5) call getarg(5,grid4)    !Locator for call_2
-  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)
 
   do i=0,NZ-1
      read(40,3040) cd(i)
 3040 format(17x,2f10.3)
   enddo
 
-  lagbest=-1
+  call sec0(0,t)
-  ccfbest=0.
+  call ft8q3(cd,xdt,f0,call_1,call_2,grid4,msg,snr)
-  nsum=32*2
+  call sec0(1,t)
-  do lag=0,nlags-1
+  write(*,1100) t,snr,trim(msg)
-     z=0.
+1100 format('Time:',f6.2,'   S/N:',f6.1,'   msg: ',a)
-     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
 
 999 end program test_ft8q3