More additions to pack77/unpack77 routines.

lib/77bit/chk77_3.f90

@@ -1,29 +0,0 @@
-subroutine chk77_3(nwords,w,i3,n3)
-! Check Type 3 (One nonstandard call and one hashed call)
-
-  character*13 w(19)
-  character*13 call_1,call_2
-  character*6 bcall_1,bcall_2
-  character crrpt*4
-  logical ok1,ok2
-
-  if(nwords.eq.3) then
-     call_1=w(1)
-     if(call_1(1:1).eq.'<') call_1=w(1)(2:len(trim(w(1)))-1)
-     call_2=w(2)
-     if(call_2(1:1).eq.'<') call_2=w(2)(2:len(trim(w(2)))-1)
-     call chkcall(call_1,bcall_1,ok1)
-     call chkcall(call_2,bcall_2,ok2)
-     crrpt=w(nwords)(1:4)
-     i1=1
-     if(crrpt(1:1).eq.'R') i1=2
-     n=-99
-     read(crrpt(i1:),*,err=1) n
-1    if(ok1 .and. ok2 .and. n.ne.-99) then
-        i3=3
-        n3=0
-     endif
-  endif
-
-  return
-end subroutine chk77_3

lib/77bit/encode77.f90

@@ -13,9 +13,10 @@ program encode77
   do iline=1,999
      read(10,1002,end=999) i3a,n3a,msg0
 1002 format(i1,i4,1x,a37)
+     if(msg0.eq.'                                     ') exit
      i3=i3a
      n3=n3a
-     if(i3a.gt.1 .or. n3a.gt.5) cycle
+!     if(i3a.gt.1 .or. n3a.gt.5) cycle
      call pack77(msg0,i3,n3,c77)
      call unpack77(c77,msg)
      cerr=' '
@@ -36,7 +37,7 @@ include 'pack77_01.f90'
 include 'pack77_02.f90'
 include 'pack77_03.f90'
 include 'pack77_1.f90'
-include 'chk77_2.f90'
+include 'pack77_3.f90'
-include 'chk77_3.f90'
+include 'pack77_4.f90'
 include 'packtext77.f90'
 include 'unpacktext77.f90'

lib/77bit/g2

@@ -2,4 +2,4 @@ gfortran -c ../packjt.f90
 gfortran -o encode77 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant \
 	 encode77.f90 ../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \
 	 ../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 \
-	 ihashcall.f90 hash10.f90 packjt.o
+	 ihashcall.f90 hash10.f90 hash13.f90 hash24.f90 packjt.o

lib/77bit/g8

@@ -1 +1,2 @@
-gfortran -o test28 test28.f90 pack28.f90 unpack28.f90 ihashcall.f90 hash24.f90
+gfortran -o test28 -fbounds-check -Wall -Wno-conversion test28.f90 pack28.f90 \
+	 unpack28.f90 ihashcall.f90 hash24.f90

lib/77bit/hash13.f90

@@ -0,0 +1,34 @@
+subroutine hash13(n13,c13,isave)
+
+  parameter (NMAX=20)
+  character*13 c13,callsign(NMAX)
+  integer ihash(NMAX)
+  logical first
+  data first/.true./
+  save first,ihash,callsign
+
+  if(first) then
+     ihash=-1
+     callsign='             '
+     first=.false.
+  endif
+
+  if(isave.ge.0) then
+     do i=1,NMAX
+        if(ihash(i).eq.n13) go to 900             !This one is already in the list
+     enddo
+     ihash(NMAX:2:-1)=ihash(NMAX-1:1:-1)
+     callsign(NMAX:2:-1)=callsign(NMAX-1:1:-1)
+     ihash(1)=n13
+     callsign(1)=c13
+  else
+     do i=1,NMAX
+        if(ihash(i).eq.n13) then
+           c13=callsign(i)
+           go to 900
+        endif
+     enddo
+  endif
+
+900 return
+end subroutine hash13

lib/77bit/msgtypes.txt

@@ -6,6 +6,7 @@ i3 n3
 0   2 PA3XYZ 520093 IO91NP                 28 1 1 3 12 25   2   70   EU VHF contest (2)
 0   3 WA9XYZ KA1ABC R 16A EMA              28 28 1 4 3 7    3   71   ARRL Field Day
 0   3 WA9XYZ KA1ABC 7D EMA                 28 28 1 4 3 7    3   71   ARRL Field Day
+0   3 WA9XYZ G8ABC 1D DX                   28 28 1 4 3 7    3   71   ARRL Field Day
 0   4 WA9XYZ KA1ABC R 32A EMA              28 28 1 4 3 7    4   71   ARRL Field Day
 0   5 123456789ABCDEF012                   71                   71   Telemetry (18 hex)
 0   5 7123456789ABCDEF01                   71                   71   Telemetry (18 hex)
@@ -13,6 +14,9 @@ i3 n3
 0   5 81234567                             71                   71   Telemetry (18 hex)
 0   5 8123456789ABCDEF01                   71                   71   Telemetry (18 hex)
 1     WA9XYZ/R KA1ABC/R R FN42             28 1 28 1 1 15       74   Standard msg
-2     TU; W9XYZ K1ABC R 579 MA             1 28 28 1 3 13       74   ARRL RTTY contest
+2     PA1XYZ/P GM4ABC/P R FN42             28 1 28 1 1 15       74   EU VHF Contest
-3     <WA9XYZ> PJ4/KA1ABC R-11             13 53 1 1 6          74   Nonstandard calls
+3     TU; W9XYZ K1ABC R 579 MA             1 28 28 1 3 13       74   ARRL RTTY contest
-4     PA3XYZ/P GM4ABC/P R IO91             28 1 28 1 1 15       74   EU VHF contest
+3     TU; W9XYZ G8ABC R 559 0013           1 28 28 1 3 13       74   ARRL RTTY (DX)
+4     <WA9XYZ> PJ4/KA1ABC RR73             13 58 1 2            74   Nonstandard call
+4     <WA9XYZ> PJ4/KA1ABC                  13 58 1 2            74   Nonstandard call
+4     PJ4/KA1ABC <WA9XYZ> RRR              13 58 1 2            74   Nonstandard call

lib/77bit/pack77.f90

@@ -47,21 +47,19 @@ subroutine pack77(msg,i3,n3,c77)
   if(i3.ge.0) go to 900
 
 ! Check Type 3 (ARRL RTTY contest exchange)
-  call chk77_2(nwords,w,i3,n3)
+  call pack77_3(nwords,w,i3,n3,c77)
   if(i3.ge.0) go to 900
 
 ! Check Type 4 (One nonstandard call and one hashed call)
-  call chk77_3(nwords,w,i3,n3)
+  call pack77_4(nwords,w,i3,n3,c77)
   if(i3.ge.0) go to 900
 
-! By default, it's free text
+! It defaults to free text
 800 i3=0
   n3=0
   msg(14:)='                        '
   call packtext77(msg(1:13),c77(1:71))
   write(c77(72:77),'(2b3.3)') n3,i3
-  
-900 continue
 
-  return
+900  return
 end subroutine pack77

lib/77bit/pack77_3.f90

@@ -1,15 +1,15 @@
-subroutine chk77_2(nwords,w,i3,n3)
+subroutine pack77_3(nwords,w,i3,n3,c77)
 ! Check Type 2 (ARRL RTTY contest exchange)
 !ARRL RTTY   - US/Can: rpt state/prov      R 579 MA
 !     	     - DX:     rpt serial          R 559 0013
 
   parameter (NUSCAN=65)    !Number of US states and Canadian provinces/territories
   character*13 w(19)
+  character*77 c77
   character*6 bcall_1,bcall_2
   character*3 cmult(NUSCAN),mult
   character crpt*3
   logical ok1,ok2
-
   data cmult/                                                        &
        "AL ","AK ","AZ ","AR ","CA ","CO ","CT ","DE ","FL ","GA ",  &
        "HI ","ID ","IL ","IN ","IA ","KS ","KY ","LA ","ME ","MD ",  &
@@ -27,22 +27,40 @@ subroutine chk77_2(nwords,w,i3,n3)
      crpt=w(nwords-1)(1:3)
      if(crpt(1:1).eq.'5' .and. crpt(2:2).ge.'2' .and. crpt(2:2).le.'9' .and.    &
           crpt(3:3).eq.'9') then
-        n=-99
+        nserial=0
-        read(w(nwords),*,err=1) n
+        read(w(nwords),*,err=1) nserial
-1       i3=2
+!1       i3=3
-        n3=0
+!        n3=0
      endif
+1    mult='   '
+     imult=-1
      do i=1,NUSCAN
         if(cmult(i).eq.w(nwords)) then
+           imult=i
            mult=cmult(i)
            exit
         endif
      enddo
-     if(mult.ne.'   ') then
+     nexch=0
-        i3=2
+     if(nserial.gt.0) nexch=nserial
+     if(imult.gt.0) nexch=8000+imult
+     if(mult.ne.'   ' .or. nserial.gt.0) then
+        i3=3
         n3=0
+        itu=0
+        if(trim(w(1)).eq.'TU;') itu=1
+        call pack28(w(1+itu),n28a)
+        call pack28(w(2+itu),n28b)
+        ir=0
+        if(w(3+itu)(1:2).eq.'R ') ir=1
+        read(w(3+itu+ir),*) irpt
+        irpt=(irpt-509)/10 - 2
+! 3     TU; W9XYZ K1ABC R 579 MA             1 28 28 1 3 13       74   ARRL RTTY contest
+! 3     TU; W9XYZ G8ABC R 559 0013           1 28 28 1 3 13       74   ARRL RTTY (DX)
+        write(c77,1010) itu,n28a,n28b,ir,irpt,nexch,i3
+1010    format(b1,2b28.28,b1,b3.3,b13.13,b3.3)
      endif
   endif
 
   return
-end subroutine chk77_2
+end subroutine pack77_3

lib/77bit/pack77_4.f90

@@ -0,0 +1,50 @@
+subroutine pack77_4(nwords,w,i3,n3,c77)
+! Check Type 3 (One nonstandard call and one hashed call)
+
+  integer*8 n58
+  logical ok1,ok2
+  character*13 w(19)
+  character*77 c77
+  character*13 call_1,call_2
+  character*11 c11
+  character*6 bcall_1,bcall_2
+  character*38 c
+  data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/
+
+  if(nwords.eq.2 .or. nwords.eq.3) then
+     call_1=w(1)
+     if(call_1(1:1).eq.'<') call_1=w(1)(2:len(trim(w(1)))-1)
+     call_2=w(2)
+     if(call_2(1:1).eq.'<') call_2=w(2)(2:len(trim(w(2)))-1)
+     call chkcall(call_1,bcall_1,ok1)
+     call chkcall(call_2,bcall_2,ok2)
+     if(ok1 .and. ok2) then
+        i3=4
+        n3=0
+     endif
+
+     if(w(1)(1:1).eq.'<') then
+        iflip=0
+        n13=ihashcall(w(1),13)
+        call hash13(n13,w(1),0)               !Save this hash and its callsign
+        c11=adjustr(call_2(1:11))
+     else if(w(2)(1:1).eq.'<') then
+        iflip=1
+        n13=ihashcall(w(2),13)
+        call hash13(n13,w(2),0)               !Save this hash and its callsign
+        c11=adjustr(call_1(1:11))
+     endif
+     n58=0
+     do i=1,11
+        n58=n58*38 + index(c,c11(i:i)) - 1
+     enddo
+     nrpt=0
+     if(trim(w(3)).eq.'RRR') nrpt=1
+     if(trim(w(3)).eq.'RR73') nrpt=2
+     if(trim(w(3)).eq.'73') nrpr=3
+     write(c77,1010) n13,n58,iflip,nrpt,i3
+1010 format(b13.13,b58.58,b1,b2.2,b3.3)
+  endif
+
+  return
+end subroutine pack77_4

lib/77bit/test28.f90

@@ -1,4 +1,4 @@
-program t8
+program test28
 
   character*13 call_0,call_1,base_call_1
   character*1 cerr
@@ -14,8 +14,8 @@ program t8
         base_call_1=call_1(2:i-1)//'  '
      endif
      if(call_0.eq.base_call_1) cerr=' '
-     write(*,1010) call_0,n28,len(trim(call_0)),len(trim(call_1)),cerr,call_1
+     write(*,1010) call_0,n28,cerr,call_1
-1010 format(a13,i12,2i5,2x,a1,2x,a13a13)
+1010 format(a13,i12,2x,a1,2x,a13a13)
   enddo
   
-999 end program t8
+999 end program test28

lib/77bit/unpack28.f90

@@ -35,7 +35,7 @@ subroutine unpack28(n28_0,c13)
         i4=n-27*i3
         c13=c4(i1+1:i1+1)//c4(i2+1:i2+1)//c4(i3+1:i3+1)//c4(i4+1:i4+1)
         c13=adjustl(c13)
-        c13='CQ_'//c13
+        c13='CQ_'//c13(1:10)
         go to 900
      endif
   endif

lib/77bit/unpack77.f90

@@ -1,14 +1,21 @@
 subroutine unpack77(c77,msg)
 
   parameter (NSEC=84)      !Number of ARRL Sections
+  parameter (NUSCAN=65)    !Number of US states and Canadian provinces
+  integer*8 n58
   integer ntel(3)
   character*77 c77
   character*37 msg
   character*13 call_1,call_2,call_3
+  character*11 c11
   character*3 crpt,cntx
+  character*3 cmult(NUSCAN)
   character*6 cexch,grid6
-  character*4 grid4
+  character*4 grid4,cserial
   character*3 csec(NSEC)
+  character*38 c
+
+  data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/
   data csec/                                                         &
        "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ",  &       
        "EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ",  &       
@@ -19,6 +26,14 @@ subroutine unpack77(c77,msg)
        "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ",  &       
        "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX",  &       
        "WV ","WWA","WY ","DX "/
+  data cmult/                                                        &
+       "AL ","AK ","AZ ","AR ","CA ","CO ","CT ","DE ","FL ","GA ",  &
+       "HI ","ID ","IL ","IN ","IA ","KS ","KY ","LA ","ME ","MD ",  &
+       "MA ","MI ","MN ","MS ","MO ","MT ","NE ","NV ","NH ","NJ ",  &
+       "NM ","NY ","NC ","ND ","OH ","OK ","OR ","PA ","RI ","SC ",  &
+       "SD ","TN ","TX ","UT ","VT ","VA ","WA ","WV ","WI ","WY ",  &
+       "NB ","NS ","QC ","ON ","MB ","SK ","AB ","BC ","NWT","NF ",  &
+       "LB ","NU ","VT ","PEI","DC "/
 
   read(c77(72:77),'(2b3)') n3,i3
   msg=repeat(' ',37)
@@ -102,7 +117,8 @@ subroutine unpack77(c77,msg)
      enddo
      msg=adjustl(msg)
 
-  else if(i3.eq.1 .or. i3.eq.3) then
+  else if(i3.eq.1 .or. i3.eq.2) then
+! Standard message (Type 1) or "/P" form of standard message for EU VHF contest (Type 2)
      !### Here and elsewhere, must enable rpt/RRR/RR73/73 in igrid4
      read(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3
 1000 format(2(b28,b1),b1,b15,b3)
@@ -110,9 +126,9 @@ subroutine unpack77(c77,msg)
      call unpack28(n28b,call_2)
      i=index(call_1,' ')
      if(i.ge.4 .and. ipa.eq.1 .and. i3.eq.1) call_1(i:i+1)='/R'
-     if(i.ge.4 .and. ipa.eq.1 .and. i3.eq.3) call_1(i:i+1)='/P'
+     if(i.ge.4 .and. ipa.eq.1 .and. i3.eq.2) call_1(i:i+1)='/P'
      if(i.ge.4 .and. ipb.eq.1 .and. i3.eq.1) call_2(i:i+1)='/R'
-     if(i.ge.4 .and. ipb.eq.1 .and. i3.eq.3) call_2(i:i+1)='/P'
+     if(i.ge.4 .and. ipb.eq.1 .and. i3.eq.2) call_2(i:i+1)='/P'
 
      n=igrid4
      j1=n/(18*10*10)
@@ -127,6 +143,67 @@ subroutine unpack77(c77,msg)
      grid4(4:4)=char(j4+ichar('0'))
      if(ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//' '//grid4
      if(ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//' R '//grid4
+
+  else if(i3.eq.3) then
+! Type 3: ARRL RTTY Contest
+     read(c77,1040) itu,n28a,n28b,ir,irpt,nexch,i3
+1040 format(b1,2b28.28,b1,b3.3,b13.13,b3.3)
+     write(crpt,1042) irpt+2
+1042 format('5',i1,'9')
+     nserial=nexch
+     imult=-1
+     if(nexch.gt.8000) then
+        imult=nexch-8000
+        nserial=-1
+     endif
+     call unpack28(n28a,call_1)
+     call unpack28(n28b,call_2)
+     imult=0
+     nserial=0
+     if(nexch.gt.8000) imult=nexch-8000
+     if(nexch.lt.8000) nserial=nexch
+     
+     if(imult.ge.1 .and.imult.le.NUSCAN) then
+        if(itu.eq.0 .and. ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//             &
+             ' '//crpt//' '//cmult(imult)
+        if(itu.eq.1 .and. ir.eq.0) msg='TU; '//trim(call_1)//' '//trim(call_2)//     &
+             ' '//crpt//' '//cmult(imult)
+        if(itu.eq.0 .and. ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//             &
+             ' R '//crpt//' '//cmult(imult)
+        if(itu.eq.1 .and. ir.eq.1) msg='TU; '//trim(call_1)//' '//trim(call_2)//     &
+             ' R '//crpt//' '//cmult(imult)
+     else if(nserial.ge.1 .and. nserial.le.7999) then
+        write(cserial,'(i4.4)') nserial
+        if(itu.eq.0 .and. ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//             &
+             ' '//crpt//' '//cserial
+        if(itu.eq.1 .and. ir.eq.0) msg='TU; '//trim(call_1)//' '//trim(call_2)//     &
+             ' '//crpt//' '//cserial
+        if(itu.eq.0 .and. ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//             &
+             ' R '//crpt//' '//cserial
+        if(itu.eq.1 .and. ir.eq.1) msg='TU; '//trim(call_1)//' '//trim(call_2)//     &
+             ' R '//crpt//' '//cserial
+     endif
+  else if(i3.eq.4) then
+!     print*,c77
+     read(c77,1050) n13,n58,iflip,nrpt
+1050 format(b13,b58,b1,b2)
+     do i=11,1,-1
+        j=mod(n58,38)+1
+        c11(i:i)=c(j:j)
+        n58=n58/38
+     enddo
+     call hash13(n13,call_3,-1)
+     if(iflip.eq.0) then
+        call_1=call_3
+        call_2=adjustl(c11)//'  '
+     else
+        call_1=adjustl(c11)//'  '
+        call_2=call_3
+     endif
+     if(nrpt.eq.0) msg=trim(call_1)//' '//trim(call_2)
+     if(nrpt.eq.1) msg=trim(call_1)//' '//trim(call_2)//' RRR'
+     if(nrpt.eq.2) msg=trim(call_1)//' '//trim(call_2)//' RR73'
+     if(nrpt.eq.3) msg=trim(call_1)//' '//trim(call_2)//' 73'
   endif
 
   return