Enable q3 decoding for Q65 messages containing a nonstandard callsign.

lib/qra/q65/q65_set_list.f90

@@ -4,6 +4,7 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
   character*12 mycall,hiscall
   character*6 hisgrid
   character*37 msg0,msg,msgsent
+  logical my_std,his_std
   integer codewords(63,MAX_NCW)
   integer itone(85)
   integer isync(22)
@@ -11,12 +12,24 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
 
   ncw=0
   if(hiscall(1:1).eq. ' ') return
+  call stdcall(mycall,my_std)
+  call stdcall(hiscall,his_std)
   
   ncw=MAX_NCW
-  msg0=trim(mycall)//' '//trim(hiscall)
-  j0=len(trim(msg0))+2
   do i=1,ncw
-     msg=msg0
+     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) msg='<'//trim(mycall)//'> '//trim(hiscall)
+        if(i.ge.7) msg=trim(mycall)//' <'//trim(hiscall)//'>'
+        if(i.eq.6) then
+           msg='TNX 73 GL'
+           go to 10
+        endif
+     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'
@@ -32,7 +45,8 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
            if(msg(j0+1:j0+1).eq.' ') msg(j0+1:j0+1)='+'
         endif
      endif
-     call genq65(msg,0,msgsent,itone,i3,n3)
+
+10   call genq65(msg,0,msgsent,itone,i3,n3)
      i0=1
      j=0
      do k=1,85
@@ -49,3 +63,36 @@ subroutine q65_set_list(mycall,hiscall,hisgrid,codewords,ncw)
 
   return
 end subroutine q65_set_list
+
+subroutine stdcall(callsign,std)
+
+  character*12 callsign
+  character*1 c
+  logical is_digit,is_letter,std
+!Statement functions:
+  is_digit(c)=c.ge.'0' .and. c.le.'9'
+  is_letter(c)=c.ge.'A' .and. c.le.'Z'
+
+! Check for standard callsign
+  iarea=-1
+  n=len(trim(callsign))
+  do i=n,2,-1
+     if(is_digit(callsign(i:i))) exit
+  enddo
+  iarea=i                                   !Right-most digit (call area)
+  npdig=0                                   !Digits before call area
+  nplet=0                                   !Letters before call area
+  do i=1,iarea-1
+     if(is_digit(callsign(i:i))) npdig=npdig+1
+     if(is_letter(callsign(i:i))) nplet=nplet+1
+  enddo
+  nslet=0                                   !Letters in suffix
+  do i=iarea+1,n
+     if(is_letter(callsign(i:i))) nslet=nslet+1
+  enddo
+  std=.true.
+  if(iarea.lt.2 .or. iarea.gt.3 .or. nplet.eq.0 .or.       &
+       npdig.ge.iarea-1 .or. nslet.gt.3) std=.false.
+
+  return
+end subroutine stdcall