From d6dd7016016c5a7351aef59047fc85b8f79d62be Mon Sep 17 00:00:00 2001
From: Joe Taylor <joe@princeton.edu>
Date: Wed, 8 Feb 2023 12:34:48 -0500
Subject: [PATCH] Decoding via q3list now basically working with grid
 exchanges.

---
 lib/q65_decode.f90            |   9 ++-
 lib/qra/q65/q65.f90           |   7 +--
 lib/qra/q65/q65_set_list2.f90 | 100 +++++++++++++++++-----------------
 3 files changed, 58 insertions(+), 58 deletions(-)

diff --git a/lib/q65_decode.f90 b/lib/q65_decode.f90
index a30ba4b33..8114565b1 100644
--- a/lib/q65_decode.f90
+++ b/lib/q65_decode.f90
@@ -112,9 +112,12 @@ contains
     nhist2=0
     if(ncontest.eq.1) then
 ! NA VHF Contest or ARRL Digi Contest
-       open(24,file=trim(data_dir)//'/q3list.bin',status='unknown',     &
-            form='unformatted')
-       read(24,end=2) nhist2,callers(1:nhist2)
+!       open(24,file=trim(data_dir)//'/q3list.bin',status='unknown',     &
+!            form='unformatted')
+!       read(24,end=2) nhist2,callers(1:nhist2)
+       open(24,file=trim(data_dir)//'/q3list.bin',status='unknown')
+       read(24,3024,end=2) nhist2,callers(1:nhist2)
+3024   format(i5/(a6,2x,a4,2x,i10))
        now=time()
        do i=1,nhist2
           hours=(now - callers(i)%nsec)/3600.0
diff --git a/lib/qra/q65/q65.f90 b/lib/qra/q65/q65.f90
index 35bdedbf0..5f1909e59 100644
--- a/lib/qra/q65/q65.f90
+++ b/lib/qra/q65/q65.f90
@@ -598,7 +598,7 @@ subroutine q65_dec1(s3,nsubmode,b90ts,esnodb,irc,dat4,decoded)
   integer dat4(13)
   character c77*77,decoded*37
   logical unpk77_success
-  
+
   nFadingModel=1
   decoded='                                     '
   call q65_intrinsics_ff(s3,nsubmode,b90ts,nFadingModel,s3prob)
@@ -894,12 +894,11 @@ subroutine q65_hist2(msg0,callers,nhist2)
      callers(nhist2)%grid=g4
      callers(nhist2)%nsec=time()
      rewind(24)
-     write(24) nhist2,callers(1:nhist2)
+     write(24,3024) nhist2,callers(1:nhist2)
+3024 format(i5/(a6,2x,a4,2x,i10))
      rewind(24)
   endif
 
-!  print*,'c',nhist2,trim(msg),' ',c6,' ',g4
-
 900 return
 end subroutine q65_hist2
 
diff --git a/lib/qra/q65/q65_set_list2.f90 b/lib/qra/q65/q65_set_list2.f90
index 1015ac975..31c920f95 100644
--- a/lib/qra/q65/q65_set_list2.f90
+++ b/lib/qra/q65/q65_set_list2.f90
@@ -4,9 +4,10 @@ subroutine q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2,codewords,ncw)
   parameter (MAX_NCW=206)
   parameter (MAX_CALLERS=40)  !For multiple q3 decodes in NA VHf Contest mode
   character*12 mycall,hiscall
-  character*6 hisgrid
+  character*6 hisgrid,c6
+  character*4 g4
   character*37 msg,msgsent
-  logical my_std,his_std
+  logical std,isgrid
   integer codewords(63,MAX_NCW)
   integer itone(85)
   integer isync(22)
@@ -15,59 +16,56 @@ subroutine q65_set_list2(mycall,hiscall,hisgrid,callers,nhist2,codewords,ncw)
 
   data isync/1,9,12,13,15,22,23,26,27,33,35,38,46,50,55,60,62,66,69,74,76,85/
 
-!  print*,'b nhist2:',nhist2
-  if(nhist2.ne.-99) return
-  
-  ncw=0
-  if(hiscall(1:1).eq. ' ') return
-  call stdcall(mycall,my_std)
-  call stdcall(hiscall,his_std)
-  
-  ncw=MAX_NCW
-  do i=1,ncw
-     msg=trim(mycall)//' '//trim(hiscall)
-     if(.not.my_std) then
-        if(i.eq.1 .or. i.ge.6)  msg='<'//trim(mycall)//'> '//trim(hiscall)
-        if(i.ge.2 .and. i.le.4) msg=trim(mycall)//' <'//trim(hiscall)//'>'
-     else if(.not.his_std) then
-        if(i.le.4 .or. i.eq.6) msg='<'//trim(mycall)//'> '//trim(hiscall)
-        if(i.ge.7) msg=trim(mycall)//' <'//trim(hiscall)//'>'
-     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(his_std) msg='CQ '//trim(hiscall)//' '//hisgrid(1:4)
-        if(.not.his_std) msg='CQ '//trim(hiscall)
-     endif
-     if(i.eq.6 .and. his_std) msg(j0:j0+3)=hisgrid(1:4)
-     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
+  isgrid(g4)=g4(1:1).ge.'A' .and. g4(1:1).le.'R' .and. g4(2:2).ge.'A' .and. &
+       g4(2:2).le.'R' .and. g4(3:3).ge.'0' .and. g4(3:3).le.'9' .and.       &
+       g4(4:4).ge.'0' .and. g4(4:4).le.'9' .and. g4(1:4).ne.'RR73'
 
-     call genq65(msg,0,msgsent,itone,i3,n3)
-     i0=1
-     j=0
-     do k=1,85
-        if(k.eq.isync(i0)) then
-           i0=i0+1
-           cycle
+  call stdcall(hiscall,std)
+  jmax=nhist2
+  if(std .and. isgrid(hisgrid(1:4))) then
+     jmax=nhist2+1
+     do j=1,nhist2
+        if(callers(j)%call .eq. hiscall(1:6)) then
+           jmax=nhist2
+           exit
         endif
-        j=j+1
-        codewords(j,i)=itone(k) - 1
      enddo
-!     write(71,3001) i,isnr,codewords(1:13,i),trim(msg)
-!3001 format(i3,2x,i3.2,2x,13i3,2x,a)
+  endif
+
+  codewords(:,1)=0
+  i=1
+  do j=1,jmax
+     c6=callers(j)%call
+     g4=callers(j)%grid
+     if(j.eq.nhist2+1) then
+        c6=hiscall(1:6)
+        g4=hisgrid(1:4)
+     endif
+     do k=1,5
+        i=i+1
+        msg=trim(mycall)//' '//trim(c6)
+        j0=len(trim(msg))+1
+        if(k.eq.1) msg=msg(1:j0)//g4
+        if(k.eq.2) msg=msg(1:j0)//'R '//g4
+        if(k.eq.3) msg(j0:j0+3)=' RRR'
+        if(k.eq.4) msg(j0:j0+4)=' RR73'
+        if(k.eq.5) msg(j0:j0+2)=' 73'
+        call genq65(msg,0,msgsent,itone,i3,n3)
+        i0=1
+        jj=0
+        do kk=1,85
+           if(kk.eq.isync(i0)) then
+              i0=i0+1
+              cycle
+           endif
+           jj=jj+1
+           codewords(jj,i)=itone(kk) - 1
+        enddo
+        write(71,3001) i,j,k,codewords(1:13,i),trim(msg)
+3001    format(3i3,2x,13i3,2x,a)
+     enddo
   enddo
-!  print*,'aa',ncontest,ncw,1970.0 + time()/(365.25*86400.0)
+  ncw=i
 
   return
 end subroutine q65_set_list2