Hound can now decode Fox messages with i3bit=1.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@8297 ab8295b8-cf94-4d9e-aec4-7959e3be5d79

CMakeLists.txt

@@ -438,6 +438,7 @@ set (wsjt_FSRCS
   lib/foldspec9f.f90
   lib/four2a.f90
   lib/ft8/foxgen.f90
+  lib/ft8/foxgen_wrap.f90
   lib/fqso_first.f90
   lib/freqcal.f90
   lib/fsk4hf/fsk4hf.f90

lib/decoder.f90

@@ -435,13 +435,13 @@ contains
     integer, intent(in) :: snr
     real, intent(in) :: dt
     real, intent(in) :: freq
-    character(len=22), intent(in) :: decoded
+    character(len=32), intent(in) :: decoded
     character c1*12,c2*6,g2*4,w*4
-    integer i1,i2,i3,n15,nwrap
+    integer i0,i1,i2,i3,n15,nwrap
     integer, intent(in) :: nap 
     real, intent(in) :: qual 
     character*2 annot
-    character*22 decoded0
+    character*32 decoded0
     logical isgrid4,first
     data first/.true./
     save
@@ -464,15 +464,20 @@ contains
     endif
     
     decoded0=decoded
+
     annot='  ' 
     if(nap.ne.0) then
        write(annot,'(a1,i1)') 'a',nap
        if(qual.lt.0.17) decoded0(22:22)='?'
     endif
-    write(*,1000) params%nutc,snr,dt,nint(freq),decoded0,annot
+
+    i0=index(decoded0,';')
+    if(i0.le.0) write(*,1000) params%nutc,snr,dt,nint(freq),decoded0(1:22),annot
 1000 format(i6.6,i4,f5.1,i5,' ~ ',1x,a22,1x,a2)
+    if(i0.gt.0) write(*,1001) params%nutc,snr,dt,nint(freq),decoded0
+1001 format(i6.6,i4,f5.1,i5,' ~ ',1x,a32)
     write(13,1002) params%nutc,nint(sync),snr,dt,freq,0,decoded0
-1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a22,' FT8')
+1002 format(i6.6,i4,i5,f6.1,f8.0,i4,3x,a32,' FT8')
 
     i1=index(decoded0,' ')
     i2=i1 + index(decoded0(i1+1:),' ')

lib/ft8/extractmessage174.f90

@@ -23,7 +23,7 @@ subroutine extractmessage174(decoded,msgreceived,ncrcflag,recent_calls,nrecent)
   i1Dec8BitBytes(11)=0
   icrc12=crc12(c_loc(i1Dec8BitBytes),11)          !CRC12 computed from 75 msg bits
 
-  if(ncrc12.eq.icrc12) then
+  if(ncrc12.eq.icrc12 .or. sum(decoded(57:87)).eq.0) then  !### Kludge ###
 ! CRC12 checks out --- unpack 72-bit message
     do ibyte=1,12
       itmp=0

lib/ft8/foxgen.f90

@@ -1,5 +1,19 @@
 subroutine foxgen()
 
+  ! Called from MainWindow::foxTxSequencer() to generate the Tx waveform in
+  ! FT8 Fox mode.  The Tx message can contain up to 5 "slots", each carrying
+  ! its own FT8 signal.
+  
+  ! Encoded messages can be of the form "HoundCall FoxCall rpt" (a standard FT8
+  ! message with i3bit=0) or "HoundCall_1 RR73; HoundCall_2 <FoxCall> rpt", 
+  ! a new message type with i3bit=1.  The waveform is generated with
+  ! fsample=48000 Hz; it is compressed to reduce the PEP-to-average power ratio,
+  ! with (currently disabled) filtering afterware to reduce spectral growth.
+
+  ! Input message information is provided in character array cmsg(5), in
+  ! common/foxcom/.  The generated wave(NWAVE) is passed back in the same
+  ! common block.
+  
   use crc
   parameter (NN=79,ND=58,KK=87,NSPS=4*1920)
   parameter (NWAVE=NN*NSPS,NFFT=614400,NH=NFFT/2)
@@ -11,13 +25,14 @@ subroutine foxgen()
   logical bcontest,checksumok
   integer itone(NN)
   integer icos7(0:6)
-  integer*1 msgbits(KK),codeword(3*ND)
+  integer*1 msgbits(KK),codeword(3*ND),msgbits2
   integer*1, target:: i1Msg8BitBytes(11)
   integer*1, target:: mycall
   real x(NFFT),y(NFFT)
   real*8 dt,twopi,f0,fstep,dfreq,phi,dphi
   complex cx(0:NH),cy(0:NH)
   common/foxcom/wave(NWAVE),nslots,i3bit(5),cmsg(5),mycall(6)
+  common/foxcom2/itone2(NN),msgbits2(KK)
   equivalence (x,cx),(y,cy)
   data icos7/2,5,6,0,4,1,3/                   !Costas 7x7 tone pattern
 
@@ -28,37 +43,27 @@ subroutine foxgen()
   twopi=8.d0*atan(1.d0)
   wave=0.
   mygrid='      '
-  nrpt=0
+  irpt=0
 
   do n=1,nslots
-!###
-!     if(n.eq.1) then
-!        cmsg(n)='W0AAA W3DDD'
-!        i3bit(n)=0
-!     endif
-!     if(n.eq.2) then
-!        cmsg(n)='W0AAA RR73; W3DDD <K1JT> -12'
-!        i3bit(n)=1
-!     endif
-!###     
      i3b=i3bit(n)
      if(i3b.eq.0) then
-        msg=cmsg(n)(1:22)
+        msg=cmsg(n)(1:22)                     !Stansard FT8 message
      else
-        i1=index(cmsg(n),' ')
+        i1=index(cmsg(n),' ')                 !Special Fox message
         i2=index(cmsg(n),';')
         i3=index(cmsg(n),'<')
         i4=index(cmsg(n),'>')
         msg=cmsg(n)(1:i1)//cmsg(n)(i2+1:i3-2)//'                   '
-        read(cmsg(n)(i4+2:i4+4),*) nrpt
+        read(cmsg(n)(i4+2:i4+4),*) irpt
      endif
      call genft8(msg,mygrid,bcontest,0,msgsent,msgbits,itone)
 
      if(i3b.eq.1) then
         icrc10=crc10(c_loc(mycall),6)
-        ng16=64*icrc10 + nrpt+30
+        nrpt=irpt+30
-        write(cbits,1001) msgbits(1:56),ng16,i3b,0
+        write(cbits,1001) msgbits(1:56),icrc10,nrpt,i3b,0
-1001    format(56b1.1,b16.16,b3.3,b12.12)
+1001    format(56b1.1,b10.10,b6.6,b3.3,b12.12)
         read(cbits,1002) msgbits
 1002    format(87i1)
 
@@ -67,7 +72,8 @@ subroutine foxgen()
 1003    format(11b8)
         icrc12=crc12(c_loc(i1Msg8BitBytes),11)
 
-        write(cbits,1001) msgbits(1:56),ng16,i3b,icrc12
+        print*,'BB',icrc10,nrpt,i3b,icrc12
+        write(cbits,1001) msgbits(1:56),icrc10,nrpt,i3b,icrc12
         read(cbits,1002) msgbits
 
         call encode174(msgbits,codeword)      !Encode the test message
@@ -85,13 +91,9 @@ subroutine foxgen()
         enddo
      endif
      
-!###
+! Make copies of itone() and msgbits() for ft8sim
-!     call chkcrc12a(msgbits,nbadcrc)
+     itone2=itone
-!     i3bb=4*msgbits(73) + 2*msgbits(74) + msgbits(75)
+     msgbits2=msgbits
-!     iFreeText=msgbits(57)
-!     write(*,3001) i3b,i3bb,icrc10,icrc12,nbadcrc,msgsent
-!3001 format(5i6,2x,a22)
-!###
 
      f0=1500.d0 + fstep*(n-1)
      phi=0.d0

lib/ft8/ft8b.f90

@@ -1,13 +1,17 @@
 subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly,           &
-     napwid,lsubtract,nagain,iaptype,mygrid6,bcontest,sync0,f1,xdt,xbase,     &
+     napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,bcontest,sync0,f1,xdt,xbase,   &
-     apsym,nharderrors,dmin,nbadcrc,ipass,iera,message,xsnr)  
+     apsym,nharderrors,dmin,nbadcrc,ipass,iera,msg32,xsnr)  
 
+  use crc
   use timer_module, only: timer
   include 'ft8_params.f90'
   parameter(NRECENT=10,NP2=2812)
+  character*32 msg32
   character message*22,msgsent*22
-  character*12 recent_calls(NRECENT)
+  character*12 mycall12,recent_calls(NRECENT)
-  character*6 mygrid6
+  character*6, target:: mycall6
+  character*6 mygrid6,c1,c2
+  character*87 cbits
   logical bcontest
   real a(5)
   real s1(0:7,ND),s2(0:7,NN),s1sort(8*ND)
@@ -15,7 +19,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly,    &
   real bmeta(3*ND),bmetb(3*ND),bmetap(3*ND)
   real llr(3*ND),llra(3*ND),llr0(3*ND),llr1(3*ND),llrap(3*ND)           !Soft symbols
   real dd0(15*12000)
-  integer*1 decoded(KK),apmask(3*ND),cw(3*ND)
+  integer*1 decoded(KK),decoded0(KK),apmask(3*ND),cw(3*ND)
   integer*1 msgbits(KK)
   integer apsym(KK)
   integer mcq(28),mde(28),mrrr(16),m73(16),mrr73(16)
@@ -359,7 +363,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly,    &
      message='                      '
      xsnr=-99.0
      if(count(cw.eq.0).eq.174) cycle           !Reject the all-zero codeword
-!###     if(any(decoded(73:75).ne.0)) cycle        !Reject if any of the 3 extra bits is nonzero
      if(nharderrors.ge.0 .and. nharderrors+dmin.lt.60.0 .and. &        
         .not.(sync.lt.2.0 .and. nharderrors.gt.35)      .and. &
         .not.(ipass.gt.2 .and. nharderrors.gt.39)       .and. &
@@ -370,17 +373,15 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly,    &
         nharderrors=-1
         cycle 
      endif
-!###
      i3bit=4*decoded(73) + 2*decoded(74) + decoded(75)
      iFreeText=decoded(57)
-!     if(nbadcrc.eq.0) write(*,3001) nharderrors,nbadcrc,i3bit
-!3001 format('A',3i5)
-!###     
      if(nbadcrc.eq.0) then
+        decoded0=decoded
+        if(i3bit.eq.1) decoded(57:)=0
         call extractmessage174(decoded,message,ncrcflag,recent_calls,nrecent)
+        decoded=decoded0
+! This needs fixing for messages with i3bit=1:        
         call genft8(message,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
-        if(i3bit.eq.1 .and. iFreeText.eq.0) message(21:21)='1'
-        if(i3bit.eq.2 .and. iFreeText.eq.0) message(21:21)='2'
         if(lsubtract) call subtractft8(dd0,itone,f1,xdt2)
         xsig=0.0
         xnoi=0.0
@@ -393,10 +394,37 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly,    &
         if(xnoi.gt.0 .and. xnoi.lt.xsig) xsnr=xsig/xnoi-1.0
         xsnr=10.0*log10(xsnr)-27.0
         xsnr2=db(xsig/xbase - 1.0) - 32.0
-!        write(52,3052) f1,xdt,xsig,xnoi,xbase,xsnr,xsnr2
-!3052    format(7f10.2)
         if(.not.nagain) xsnr=xsnr2
         if(xsnr .lt. -24.0) xsnr=-24.0
+        
+        if(i3bit.eq.1) then
+           mycall6=mycall12(1:6)
+           icrc10=crc10(c_loc(mycall6),6)
+           write(cbits,1001) decoded
+1001       format(87i1)
+           read(cbits,1002) ncrc10,nrpt
+1002       format(56x,b10,b6)
+           irpt=nrpt-30
+           i1=index(message,' ')
+           i2=index(message(i1+1:),' ') + i1
+           c1=message(1:i1)//'   '
+           c2=message(i1+1:i2)//'   '
+           msg32=c1//' RR73; '//c2//' <'//trim(mycall6)//'>    '
+           write(msg32(30:32),1010) irpt
+1010       format(i3.2)
+           if(msg32(30:30).ne.'-') msg32(30:30)='+'
+           
+           iz=len(trim(msg32))
+           do iter=1,5                           !Collapse multiple blanks into one
+              ib2=index(msg32(1:iz),'  ')
+              if(ib2.lt.1) exit
+              msg32=msg32(1:ib2)//msg32(ib2+2:)
+              iz=iz-1
+           enddo
+        else
+           msg32=message//'          '
+        endif
+        
         return
      endif
   enddo

lib/ft8/ft8sim.f90

@@ -7,7 +7,7 @@ program ft8sim
   include 'ft8_params.f90'               !Set various constants
   type(hdr) h                            !Header for .wav file
   character arg*12,fname*17,sorm*1
-  character msg*22,msgsent*22,msg0*22
+  character msg32*32,msg*22,msgsent*22,msg0*22
   character*6 mygrid6
   logical bcontest
   complex c0(0:NMAX-1)
@@ -27,7 +27,7 @@ program ft8sim
      print*,'Make nfiles negative to invoke 72-bit contest mode.'
      go to 999
   endif
-  call getarg(1,msg)                     !Message to be transmitted
+  call getarg(1,msg32)                   !Message to be transmitted
   call getarg(2,sorm)                    !s for single signal, m for multiple sigs 
   if(sorm.eq."s") then
     print*,"Generating single signal at 1500 Hz."
@@ -68,13 +68,21 @@ program ft8sim
   sig=sqrt(2*bandwidth_ratio) * 10.0**(0.05*snrdb)
   if(snrdb.gt.90.0) sig=1.0
   txt=NN*NSPS/12000.0
-  i3bit=0                                ! ### TEMPORARY ??? ###
 
 ! Source-encode, then get itone()
+  if(index(msg32,';').lt.0) then
+     i3bit=0
+     msg=msg32(1:22)
      call genft8(msg,mygrid6,bcontest,i3bit,msgsent,msgbits,itone)
      write(*,1000) f0,xdt,txt,snrdb,bw,msgsent
 1000 format('f0:',f9.3,'   DT:',f6.2,'   TxT:',f6.1,'   SNR:',f6.1,    &
           '  BW:',f4.1,2x,a22)
+  else
+     call foxgen_wrap(msg32,msgbits,itone)
+     write(*,1001) f0,xdt,txt,snrdb,bw,msg32
+1001 format('f0:',f9.3,'   DT:',f6.2,'   TxT:',f6.1,'   SNR:',f6.1,    &
+          '  BW:',f4.1,2x,a32)
+  endif
 
   write(*,'(28i1,1x,28i1)') msgbits(1:56)
   write(*,'(16i1)') msgbits(57:72)
@@ -146,3 +154,5 @@ program ft8sim
   enddo
        
 999 end program ft8sim
+
+  

lib/ft8_decode.f90

@@ -24,7 +24,7 @@ module ft8_decode
        integer, intent(in) :: snr
        real, intent(in) :: dt
        real, intent(in) :: freq
-       character(len=22), intent(in) :: decoded
+       character(len=32), intent(in) :: decoded
        integer, intent(in) :: nap 
        real, intent(in) :: qual 
      end subroutine ft8_decode_callback
@@ -52,7 +52,7 @@ contains
     character*6 mygrid6,hisgrid6
     integer*2 iwave(15*12000)
     integer apsym(KK)
-    character datetime*13,message*22
+    character datetime*13,message*22,msg32*32
     character*22 allmessages(100)
     integer allsnrs(100)
     save s,dd
@@ -106,8 +106,9 @@ contains
         nsnr0=min(99,nint(10.0*log10(sync) - 25.5))    !### empirical ###
         call timer('ft8b    ',0)
         call ft8b(dd,newdat,nQSOProgress,nfqso,nftx,ndepth,lft8apon,lapcqonly,       &
-             napwid,lsubtract,nagain,iaptype,mygrid6,bcontest,sync,f1,xdt,     &
+             napwid,lsubtract,nagain,iaptype,mycall12,mygrid6,bcontest,sync,f1,xdt,  &
-             xbase,apsym,nharderrors,dmin,nbadcrc,iappass,iera,message,xsnr)
+             xbase,apsym,nharderrors,dmin,nbadcrc,iappass,iera,msg32,xsnr)
+        message=msg32(1:22)   !###
         nsnr=nint(xsnr) 
         xdt=xdt-0.5
         hd=nharderrors+dmin
@@ -132,7 +133,7 @@ contains
 !           flush(81)
            if(.not.ldupe .and. associated(this%callback)) then
               qual=1.0-(nharderrors+dmin)/60.0 ! scale qual to [0.0,1.0]
-              call this%callback(sync,nsnr,xdt,f1,message,iaptype,qual)
+              call this%callback(sync,nsnr,xdt,f1,msg32,iaptype,qual)
            endif
         endif
       enddo