port changes from WSJT-X 2.0.1

ft8b.f90

@@ -12,7 +12,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
   character*77 c77
   real a(5)
   real s8(0:7,NN)
-  real s2(0:511),s2l(0:511)
+  real s2(0:511)
   real bmeta(174),bmetb(174),bmetc(174)
   real llra(174),llrb(174),llrc(174),llrd(174)           !Soft symbols
   complex dd0(NMAX)
@@ -181,7 +181,6 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
             print*,"Error - nsym must be 1, 2, or 3."
           endif
         enddo
-        s2l(0:nt-1)=log(s2(0:nt-1)+1e-32)
         i32=1+(k-1)*3+(ihalf-1)*87
         if(nsym.eq.1) ibmax=2
         if(nsym.eq.2) ibmax=5
@@ -383,7 +382,7 @@ subroutine ft8b(dd0,newdat,nQSOProgress,nfqso,nftx,ndepth,lapon,lapcqonly, &
      if(i3.gt.4 .or. (i3.eq.0.and.n3.gt.5)) then
         cycle
      endif
-     call unpack77(c77,msg37,msgcall,msggrid,unpk77_success)
+     call unpack77(c77,1,msg37,msgcall,msggrid,unpk77_success)
      if(.not.unpk77_success) then
         cycle
      endif

genft8.f90

@@ -17,7 +17,7 @@ subroutine genft8(msg,i3,n3,msgsent,msgbits,itone)
   i3=-1
   n3=-1
   call pack77(msg,i3,n3,c77)
-  call unpack77(c77,msgsent,msgcall,msggrid,unpk77_success)
+  call unpack77(c77,0,msgsent,msgcall,msggrid,unpk77_success)
   read(c77,'(77i1)',err=1) msgbits
   if(unpk77_success) go to 2
 1 msgbits=0

packjt77.f90

@@ -2,10 +2,15 @@ module packjt77
 
 ! These variables are accessible from outside via "use packjt77":
   parameter (MAXHASH=1000,MAXRECENT=10)
-  character*13 callsign(MAXHASH)
+  character (len=13), dimension(1:1024) ::  calls10=''
-  integer ihash10(MAXHASH),ihash12(MAXHASH),ihash22(MAXHASH)
+  character (len=13), dimension(1:4096) ::  calls12=''
-  integer n28a,n28b,nzhash
+  character (len=13), dimension(1:MAXHASH) :: calls22=''
-  character*13 recent_calls(MAXRECENT)
+  character (len=13), dimension(1:MAXRECENT) :: recent_calls=''
+  character (len=13) :: mycall13=''
+  character (len=13) :: dxcall13=''
+  integer, dimension(1:MAXHASH) :: ihash22=-1
+  integer :: nzhash=0
+  integer n28a,n28b
 
   contains
 
@@ -14,15 +19,13 @@ subroutine hash10(n10,c13)
   character*13 c13
 
   c13='<...>'
-  do i=1,nzhash
+  if(n10.lt.1 .or. n10.gt.1024) return
-     if(ihash10(i).eq.n10) then
+  if(len(trim(calls10(n10))).gt.0) then
-        c13=callsign(i)
+     c13=calls10(n10)
-        c13='<'//trim(c13)//'>'//'         '
+     c13='<'//trim(c13)//'>'
-        go to 900
+  endif
-     endif
+  return
-  enddo
 
-900 return
 end subroutine hash10
 
 subroutine hash12(n12,c13)
@@ -30,15 +33,13 @@ subroutine hash12(n12,c13)
   character*13 c13
 
   c13='<...>'
-  do i=1,nzhash
+  if(n12.lt.1 .or. n12.gt.4096) return
-     if(ihash12(i).eq.n12) then
+  if(len(trim(calls12(n12))).gt.0) then
-        c13=callsign(i)
+     c13=calls12(n12)
-        c13='<'//trim(c13)//'>'//'         '
+     c13='<'//trim(c13)//'>'
-        go to 900
+  endif
-     endif
+  return
-  enddo
 
-900 return
 end subroutine hash12
 
 
@@ -49,8 +50,8 @@ subroutine hash22(n22,c13)
   c13='<...>'
   do i=1,nzhash
      if(ihash22(i).eq.n22) then
-        c13=callsign(i)
+        c13=calls22(i)
-        c13='<'//trim(c13)//'>'//'         '
+        c13='<'//trim(c13)//'>'
         go to 900
      endif
   enddo
@@ -79,18 +80,6 @@ end function ihashcall
 subroutine save_hash_call(c13,n10,n12,n22)
 
   character*13 c13,cw
-  logical first
-  data first/.true./
-  save first
-
-  if(first) then
-     ihash10=-1
-     ihash12=-1
-     ihash22=-1
-     callsign='             '
-     nzhash=0
-     first=.false.
-  endif
 
   cw=c13
   if(cw(1:1).eq.' ' .or. cw(1:5).eq.'<...>') return
@@ -98,27 +87,30 @@ subroutine save_hash_call(c13,n10,n12,n22)
   i=index(cw,'>')
   if(i.gt.0) cw(i:)='         '
 
+  if(len(trim(cw)) .lt. 3) return
+
   n10=ihashcall(cw,10)
+  if(n10.ge.1 .and. n10 .le. 1024 .and. cw.ne.mycall13) calls10(n10)=cw
+
   n12=ihashcall(cw,12)
+  if(n12.ge.1 .and. n12 .le. 4096 .and. cw.ne.mycall13) calls12(n12)=cw
+
   n22=ihashcall(cw,22)
-  do i=1,nzhash
+  if(any(ihash22.eq.n22)) then   ! If entry exists, make sure callsign is the most recently received one
-     if(ihash22(i).eq.n22) go to 900     !This one is already in the table
+    where(ihash22.eq.n22) calls22=cw
-  enddo
+    go to 900
+  endif
 
 ! New entry: move table down, making room for new one at the top
-  ihash10(MAXHASH:2:-1)=ihash10(MAXHASH-1:1:-1)
-  ihash12(MAXHASH:2:-1)=ihash12(MAXHASH-1:1:-1)
   ihash22(MAXHASH:2:-1)=ihash22(MAXHASH-1:1:-1)
 
 ! Add the new entry
-  callsign(MAXHASH:2:-1)=callsign(MAXHASH-1:1:-1)
+  calls22(MAXHASH:2:-1)=calls22(MAXHASH-1:1:-1)
-  ihash10(1)=n10
-  ihash12(1)=n12
   ihash22(1)=n22
-  callsign(1)=cw
+  calls22(1)=cw
   if(nzhash.lt.MAXHASH) nzhash=nzhash+1
-
+900 continue
-900 return
+  return
 end subroutine save_hash_call
 
 subroutine pack77(msg0,i3,n3,c77)
@@ -154,7 +146,7 @@ subroutine pack77(msg0,i3,n3,c77)
 
   ! Check 0.5 (telemetry)
 5  i0=index(msg,' ')
-  c18=msg(1:i0-1)//'                  '
+  c18=msg(1:i0-1)
   c18=adjustr(c18)
   ntel=-99
   read(c18,1005,err=6) ntel
@@ -190,8 +182,13 @@ subroutine pack77(msg0,i3,n3,c77)
 900 return
 end subroutine pack77
 
-subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success)
+subroutine unpack77(c77,nrx,msg,msgcall,msggrid,unpk77_success)
-
+!
+! nrx=1 when unpacking a received message
+! nrx=0 when unpacking a to-be-transmitted message
+! the value of nrx is used to decide when mycall13 or dxcall13 should
+! be used in place of a callsign from the hashtable
+!
   parameter (NSEC=84)      !Number of ARRL Sections
   parameter (NUSCAN=65)    !Number of US states and Canadian provinces
   parameter (MAXGRID4=32400)
@@ -200,6 +197,7 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success)
   character*77 c77
   character*37 msg
   character*13 call_1,call_2,call_3,msgcall
+  character*13 mycall13_0,dxcall13_0
   character*11 c11
   character*3 crpt,cntx
   character*3 cmult(NUSCAN)
@@ -207,7 +205,9 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success)
   character*4 grid4,cserial,msggrid
   character*3 csec(NSEC)
   character*38 c
+  integer hashmy10,hashmy12,hashmy22,hashdx10,hashdx12,hashdx22
   logical unpk28_success,unpk77_success
+  logical dxcall13_set,mycall13_set
 
   data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/
   data csec/                                                         &
@@ -228,7 +228,32 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success)
        "SD ","TN ","TX ","UT ","VT ","VA ","WA ","WV ","WI ","WY ",  &
        "NB ","NS ","QC ","ON ","MB ","SK ","AB ","BC ","NWT","NF ",  &
        "LB ","NU ","YT ","PEI","DC "/
+  data dxcall13_set/.false./
+  data mycall13_set/.false./
+  data mycall13_0/''/
+  data dxcall13_0/''/
 
+  save hashmy10,hashmy12,hashmy22,hashdx10,hashdx12,hashdx22
+
+  if(mycall13.ne.mycall13_0) then
+    if(len(trim(mycall13)).gt.2) then
+       mycall13_set=.true.
+       mycall13_0=mycall13
+       call save_hash_call(mycall13,hashmy10,hashmy12,hashmy22)
+    else
+       mycall13_set=.false.
+    endif
+  endif
+
+  if(dxcall13.ne.dxcall13_0) then
+    if(len(trim(dxcall13)).gt.2) then
+      dxcall13_set=.true.
+      dxcall13_0=dxcall13
+      hashdx10=ihashcall(dxcall13,10)
+      hashdx12=ihashcall(dxcall13,12)
+      hashdx22=ihashcall(dxcall13,22)
+    endif
+  endif
   unpk77_success=.true.
 
 ! Check for bad data
@@ -263,13 +288,13 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success)
      call unpack28(n28b,call_2,unpk28_success)
      if(.not.unpk28_success .or. n28b.le.2) unpk77_success=.false.
      call hash10(n10,call_3)
-     if(call_3(1:1).eq.'<') then
+     if(nrx.eq.1     .and. &
-        msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)//  &
+        dxcall13_set .and. &
-             ' '//crpt
+        hashdx10.eq.n10) call_3='<'//trim(dxcall13)//'>'
-     else
+     if(nrx.eq.0     .and. &
-        msg=trim(call_1)//' RR73; '//trim(call_2)//' <'//trim(call_3)//  &
+        mycall13_set .and. &
-             '> '//crpt
+        n10.eq.hashmy10) call_3='<'//trim(mycall13)//'>'
-     endif
+     msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)//' '//crpt
   else if(i3.eq.0 .and. n3.eq.2) then
 ! 0.2  PA3XYZ/P R 590003 IO91NP           28 1 1 3 12 25   70   EU VHF contest
      read(c77,1020) n28a,ip,ir,irpt,iserial,igrid6
@@ -277,7 +302,7 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success)
      call unpack28(n28a,call_1,unpk28_success)
      if(.not.unpk28_success .or. n28a.le.2) unpk77_success=.false.
      nrs=52+irpt
-     if(ip.eq.1) call_1=trim(call_1)//'/P'//'        '
+     if(ip.eq.1) call_1=trim(call_1)//'/P'
      write(cexch,1022) nrs,iserial
 1022 format(i2,i4.4)
      n=igrid6
@@ -442,14 +467,25 @@ subroutine unpack77(c77,msg,msgcall,msggrid,unpk77_success)
         n58=n58/38
      enddo
      call hash12(n12,call_3)
-     if(iflip.eq.0) then
+     if(iflip.eq.0) then       ! 12 bit hash for TO call
         call_1=call_3
-        call_2=adjustl(c11)//'  '
+        call_2=adjustl(c11)//'          '
         call add_call_to_recent_calls(call_2)
-     else
+        if(nrx.eq.1 .and.                        &
-        call_1=adjustl(c11)//'  '
+           dxcall13_set .and. mycall13_set .and. &
+           call_2.eq.dxcall13 .and.              &
+           n12.eq.hashmy12 ) call_1='<'//trim(mycall13)//'>'
+        if(nrx.eq.1 .and.                        &
+           mycall13_set .and.                    &
+           index(call_1,'<...>').gt.0 .and.      &
+           n12.eq.hashmy12 ) call_1='<'//trim(mycall13)//'>'
+     else                      ! 12 bit hash for DE call
+        call_1=adjustl(c11)
         call_2=call_3
         call add_call_to_recent_calls(call_1)
+        if(nrx.eq.0 .and.                        &
+           mycall13_set .and. &
+           n12.eq.hashmy12) call_2='<'//trim(mycall13)//'>'
      endif
      if(icq.eq.0) then
         if(nrpt.eq.0) msg=trim(call_1)//' '//trim(call_2)
@@ -528,7 +564,7 @@ subroutine pack28(c13,n28)
            go to 900
         endif
         if(nlet.ge.1 .and. nlet.le.4 .and. nnum.eq.0) then
-           c4=c13(4:n)//'   '
+           c4=c13(4:n)
            c4=adjustr(c4)
            m=0
            do i=1,4
@@ -546,6 +582,9 @@ subroutine pack28(c13,n28)
 ! Check for <...> callsign
   if(c13(1:1).eq.'<')then
      call save_hash_call(c13,n10,n12,n22)   !Save callsign in hash table
+     i2=index(c13,'>')
+     c13=c13(2:i2-1)
+     n22=ihashcall(c13,22)
      n28=NTOKENS + n22
      go to 900
   endif
@@ -571,6 +610,7 @@ subroutine pack28(c13,n28)
        npdig.ge.iarea-1 .or. nslet.gt.3) then
 ! Treat this as a nonstandard callsign: compute its 22-bit hash
      call save_hash_call(c13,n10,n12,n22)   !Save callsign in hash table
+     n22=ihashcall(c13,n22)
      n28=NTOKENS + n22
      go to 900
   endif
@@ -658,7 +698,7 @@ subroutine unpack28(n28_0,c13,success)
   i5=n/27
   i6=n-27*i5
   c13=c1(i1+1:i1+1)//c2(i2+1:i2+1)//c3(i3+1:i3+1)//c4(i4+1:i4+1)//     &
-       c4(i5+1:i5+1)//c4(i6+1:i6+1)//'       '
+       c4(i5+1:i5+1)//c4(i6+1:i6+1)
   c13=adjustl(c13)
 
 900 i0=index(c13,' ')
@@ -723,7 +763,7 @@ subroutine pack77_01(nwords,w,i3,n3,c77)
 ! Pack a Type 0.1 message: DXpedition mode
 ! Example message:  "K1ABC RR73; W9XYZ <KH1/KH7Z> -11"   28 28 10 5
 
-  character*13 w(19)
+  character*13 w(19),c13
   character*77 c77
   character*6 bcall_1,bcall_2
   logical ok1,ok2
@@ -749,6 +789,9 @@ subroutine pack77_01(nwords,w,i3,n3,c77)
   call pack28(w(1),n28a)
   call pack28(w(3),n28b)
   call save_hash_call(w(4),n10,n12,n22)
+  i2=index(w(4),'>')
+  c13=w(4)(2:i2-1)
+  n10=ihashcall(c13,10)
   write(c77,1010) n28a,n28b,n10,n5,n3,i3
 1010 format(2b28.28,b10.10,b5.5,2b3.3)
 
@@ -782,13 +825,14 @@ subroutine pack77_02(nwords,w,i3,n3,c77)
 ! Type 0.2:   PA3XYZ/P R 590003 IO91NP           28 1 1 3 12 25   70   EU VHF contest
   i3=0
   n3=2
-  ip=0
+  i=index(w(1)//' ','/P ')
-  c13=w(1)
-  i=index(w(1),'/P')
   if(i.ge.4) then
      ip=1
-     c13=w(1)(1:i-1)//'         '
+     c13=w(1)(1:i-1)
-  endif
+  else
+     ip=0
+     c13=w(1)
+  end if
   call pack28(c13,n28a)
   ir=0
   if(w(2)(1:2).eq.'R ') ir=1
@@ -929,22 +973,24 @@ subroutine pack77_1(nwords,w,i3,n3,c77)
 ! 1     WA9XYZ/R KA1ABC/R R FN42           28 1 28 1 1 15   74   Standard msg
 ! 2     PA3XYZ/P GM4ABC/P R JO22           28 1 28 1 1 15   74   EU VHF contest
 
-10 if(nwords.eq.2 .or. nwords.eq.3 .or. (nwords.eq.4 .and.               &
+10 i1psuffix=index(w(1)//' ' ,'/P ')
-        w(3)(1:2).eq.'R ')) then
+  i2psuffix=index(w(2)//' ','/P ')
+  if(nwords.eq.2 .or. nwords.eq.3 .or. (nwords.eq.4 .and.               &
+       w(3)(1:2).eq.'R ')) then
      n3=0
      i3=1                          !Type 1: Standard message, possibly with "/R"
-     if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=2  !Type 2, with "/P"
+     if (i1psuffix.ge.4.or.i2psuffix.ge.4) i3=2 !Type 2, with "/P"
   endif
-  c13=bcall_1//'       '
+  c13=bcall_1
   if(c13(1:3).eq.'CQ_' .or. w(1)(1:1).eq.'<') c13=w(1)
   call pack28(c13,n28a)
-  c13=bcall_2//'       '
+  c13=bcall_2
   if(w(2)(1:1).eq.'<') c13=w(2)
   call pack28(c13,n28b)
   ipa=0
   ipb=0
-  if(index(w(1),'/P').ge.4 .or. index(w(1),'/R').ge.4) ipa=1
+  if(i1psuffix.ge.4.or.index(w(1)//' ','/R ').ge.4) ipa=1
-  if(index(w(2),'/P').ge.4 .or. index(w(2),'/R').ge.4) ipb=1
+  if(i2psuffix.ge.4.or.index(w(2)//' ','/R ').ge.4) ipb=1
 
   grid4=w(nwords)(1:4)
   if(is_grid4(grid4)) then
@@ -1205,6 +1251,7 @@ subroutine add_call_to_recent_calls(callsign)
 
   character*13 callsign
   logical ladd
+
 ! only add if the callsign is not already on the list
   ladd=.true.
   do i=1,MAXRECENT-1 ! if callsign is at the end of the list add it again