Add files for source encoding and decoding of 77-bit messages.

lib/77bit/chk77_01.f90

@@ -0,0 +1,18 @@
+subroutine chk77_01(msg,nwords,w,nw,i3,n3)
+
+  character*37 msg
+  character*13 w(19)
+  character*6 bcall_1,bcall_2
+  integer nw(19)
+  logical ok1,ok2
+  
+  call chkcall(w(1),bcall_1,ok1)
+  call chkcall(w(3),bcall_2,ok2)
+
+  if(nwords.eq.5 .and. trim(w(2)).eq.'RR73;' .and. ok1 .and. ok2) then
+     i3=0                             !Type 0.1: DXpedition mode
+     n3=1
+  endif
+
+  return
+end subroutine chk77_01

lib/77bit/chk77_02.f90

@@ -0,0 +1,26 @@
+subroutine chk77_02(nwords,w,i3,n3)
+
+  character*13 w(19)
+  character*6 bcall_1,grid6
+  logical ok1,is_grid6
+
+  is_grid6(grid6)=len(trim(grid6)).eq.6 .and.                        &
+       grid6(1:1).ge.'A' .and. grid6(1:1).le.'R' .and.               &
+       grid6(2:2).ge.'A' .and. grid6(2:2).le.'R' .and.               &
+       grid6(3:3).ge.'0' .and. grid6(3:3).le.'9' .and.               &
+       grid6(4:4).ge.'0' .and. grid6(4:4).le.'9' .and.               &
+       grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and.               &
+       grid6(6:6).ge.'A' .and. grid6(6:6).le.'X'
+
+  call chkcall(w(1),bcall_1,ok1)
+  if(nwords.eq.3 .or. nwords.eq.4) then
+     n=-1
+     if(nwords.ge.2) read(w(nwords-1),*,err=2) n
+2    if(ok1 .and. n.ge.520001 .and. n.le.594095 .and. is_grid6(w(nwords)(1:6))) then
+        i3=0
+        n3=2                          !Type 0.2: EU VHF+ Contest
+     endif
+  endif
+
+  return
+end subroutine chk77_02

lib/77bit/chk77_03.f90

@@ -0,0 +1,46 @@
+subroutine chk77_03(nwords,w,i3,n3)
+! Check 0.3 and 0.4 (ARRL Field Day exchange)
+
+  parameter (NSEC=83)      !Number of ARRL Sections
+  character*13 w(19)
+  character*6 bcall_1,bcall_2
+  character*3 csec(NSEC),section
+  logical ok1,ok2
+
+  data csec/                                                         &
+       "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ",  &       
+       "EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ",  &       
+       "KS ","KY ","LA ","LAX","MAR","MB ","MDC","ME ","MI ","MN ",  &       
+       "MO ","MS ","MT ","NC ","ND ","NE ","NFL","NH ","NL ","NLI",  &       
+       "NM ","NNJ","NNY","NT ","NTX","NV ","OH ","OK ","ONE","ONN",  &       
+       "ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV",  &       
+       "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ",  &       
+       "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX",  &       
+       "WV ","WWA","WY "/
+  
+  call chkcall(w(1),bcall_1,ok1)
+  call chkcall(w(2),bcall_2,ok2)
+  
+  if(nwords.eq.4 .or. nwords.eq.5) then
+     n=-1
+     j=len(trim(w(nwords-1)))-1
+     if(j.ge.2) read(w(nwords-1)(1:j),*,err=4) n      !Number of transmitters
+4    m=len(trim(w(nwords)))                           !Length of section abbreviation
+     if(ok1 .and. ok2 .and. n.ge.1 .and. n.le.32 .and. (m.eq.2 .or. m.eq.3)) then
+        section='   '
+        do i=1,NSEC
+           if(csec(i).eq.w(nwords)) then
+              section=csec(i)
+              exit
+           endif
+        enddo
+        if(section.ne.'   ') then
+           i3=0
+           if(n.ge.1 .and. n.le.16) n3=3    !Type 0.3 ARRL Field Day
+           if(n.ge.17 .and. n.le.32) n3=4   !Type 0.4 ARRL Field Day
+        endif
+     endif
+  endif
+
+  return
+end subroutine chk77_03

lib/77bit/chk77_1.f90

@@ -0,0 +1,30 @@
+subroutine chk77_1(nwords,w,i3,n3)
+! Check Type 1 (Standard 77-bit message) and Type 4 (ditto, with a "/P" call)
+
+  character*13 w(19)
+  character*6 bcall_1,bcall_2
+  character*4 grid4
+  logical is_grid4
+  logical ok1,ok2
+
+  is_grid4(grid4)=len(trim(grid4)).eq.4 .and.                        &
+       grid4(1:1).ge.'A' .and. grid4(1:1).le.'R' .and.               &
+       grid4(2:2).ge.'A' .and. grid4(2:2).le.'R' .and.               &
+       grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and.               &
+       grid4(4:4).ge.'0' .and. grid4(4:4).le.'9'
+
+  call chkcall(w(1),bcall_1,ok1)
+  call chkcall(w(2),bcall_2,ok2)
+  
+  if(nwords.eq.3 .or. nwords.eq.4) then
+     if(ok1 .and. ok2 .and. is_grid4(w(nwords)(1:4))) then
+        if(nwords.eq.3 .or. (nwords.eq.4 .and. w(3)(1:2).eq.'R ')) then
+           i3=1                          !Type 1: Standard message
+           if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=4
+           n3=0
+        endif
+     endif
+  endif
+
+  return
+end subroutine chk77_1

lib/77bit/chk77_2.f90

@@ -0,0 +1,48 @@
+subroutine chk77_2(nwords,w,i3,n3)
+! 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*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 ",  &
+       "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 "/
+
+  if(nwords.eq.4 .or. nwords.eq.5 .or. nwords.eq.6) then
+     i1=1
+     if(trim(w(1)).eq.'TU;') i1=2
+     call chkcall(w(i1),bcall_1,ok1)
+     call chkcall(w(i1+1),bcall_2,ok2)
+     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
+        read(w(nwords),*,err=1) n
+1       i3=2
+        n3=0
+     endif
+     do i=1,NUSCAN
+        if(cmult(i).eq.w(nwords)) then
+           mult=cmult(i)
+           exit
+        endif
+     enddo
+     if(mult.ne.'   ') then
+        i3=2
+        n3=0
+     endif
+  endif
+
+  return
+end subroutine chk77_2

lib/77bit/chk77_3.f90

@@ -0,0 +1,29 @@
+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/g2

@@ -0,0 +1,4 @@
+gfortran -c ../packjt.f90
+gfortran -o t2 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant t2.f90 \
+	 ../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \
+	 ../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 packjt.o

lib/77bit/g5

@@ -0,0 +1,4 @@
+gfortran -c -O2 ../packjt.f90
+gfortran -o t5 -O2 t5.f90 ../deg2grid.f90 ../grid2deg.f90 \
+	 ../fix_contest_msg.f90 ../to_contest_msg.f90 ../fmtmsg.f90 \
+	 ../azdist.f90 ../geodist.f90 packjt.o

lib/77bit/pack28.f90

@@ -0,0 +1,60 @@
+subroutine pack28(c13,n28)
+
+! Pack a special token, a 24-bit hash code, or a valid base call into a 28-bit
+! integer.
+
+  parameter (NTOKENS=4874084,N24=16777216)
+  integer nc(6)
+  character*13 c13
+  character*6 callsign
+  character*37 c1
+  character*36 c2
+  character*10 c3
+  character*27 c4
+  data c1/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+  data c2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+  data c3/'0123456789'/
+  data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+  data nc/37,36,19,27,27,27/
+
+  n28=0
+  callsign=c13(1:6)
+  
+! Work-around for Swaziland prefix:
+  if(c13(1:4).eq.'3DA0') callsign='3D0'//c13(5:7)
+
+! Work-around for Guinea prefixes:
+  if(c13(1:2).eq.'3X' .and. c13(3:3).ge.'A' .and.          &
+       c13(3:3).le.'Z') callsign='Q'//c13(3:6)
+
+!  if(callsign(1:3).eq.'CQ ') then
+!     n28=1
+!     if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and.        &
+!          callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and.      &
+!          callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
+!        read(callsign(4:6),*) nfreq
+!        n28=3 + nfreq
+!     endif
+!     return
+!  else if(callsign(1:4).eq.'QRZ ') then
+!     n28=2
+!     return
+!  else if(callsign(1:3).eq.'DE ') then
+!     n28=267796945
+!     return
+!  endif
+
+! We have a standard callsign
+  n=len(trim(callsign))
+  callsign=adjustr(callsign)
+  n28=index(c1,callsign(1:1))-1
+  n28=n28*nc(2) + index(c2,callsign(2:2)) - 1
+  n28=n28*nc(3) + index(c3,callsign(3:3)) - 1
+  n28=n28*nc(4) + index(c4,callsign(4:4)) - 1
+  n28=n28*nc(5) + index(c4,callsign(5:5)) - 1
+  n28=n28*nc(6) + index(c4,callsign(6:6)) - 1
+  n28=n28 + NTOKENS + N24
+
+     
+  return
+end subroutine pack28

lib/77bit/pack77.f90

@@ -0,0 +1,51 @@
+subroutine pack77(msg,i3,n3,c77)
+
+  use packjt
+  character*37 msg
+!  character*22 msg22
+  character*13 w(19)
+  character*77 c77
+  integer nw(19)
+
+! Convert msg to upper case; collapse multiple blanks; parse into words.
+  call split77(msg,nwords,nw,w)
+  i3=-1
+  n3=-1
+  
+! Check 0.1 (DXpedition mode)
+  call pack77_01(nwords,w,i3,n3,c77)
+  if(i3.ge.0) go to 900
+
+! Check 0.2 (EU VHF contest exchange)
+  call chk77_02(nwords,w,i3,n3)
+  if(i3.ge.0) go to 900
+
+! Check 0.3 and 0.4 (ARRL Field Day exchange)
+  call chk77_03(nwords,w,i3,n3)
+  if(i3.ge.0) go to 900
+  
+
+! Check Types 1 and 4 (Standard 77-bit message (type 1) or with "/P" (type 4))
+  call chk77_1(nwords,w,i3,n3)
+  if(i3.ge.0) go to 900
+
+! Check Type 2 (ARRL RTTY contest exchange)
+  call chk77_2(nwords,w,i3,n3)
+  if(i3.ge.0) go to 900
+
+! Check Type 3 (One nonstandard call and one hashed call)
+  call chk77_3(nwords,w,i3,n3)
+  if(i3.ge.0) go to 900
+
+! By default, it's free text
+  i3=0
+  n3=0
+  msg(14:)='                        '
+  call packtext77(msg(1:13),c77(1:71))
+  write(c77(72:77),'(2b3.3)') n3,i3
+  
+900 continue
+!  print*,'B: ',c77
+
+  return
+end subroutine pack77

lib/77bit/pack77_01.f90

@@ -0,0 +1,34 @@
+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*77 c77
+  character*6 bcall_1,bcall_2
+  logical ok1,ok2
+
+  if(nwords.ne.5) return                !Must have 5 words
+  if(trim(w(2)).ne.'RR73;') return      !2nd word must be "RR73;"
+  if(w(4)(1:1).ne.'<') return           !4th word must have <...>
+  if(index(w(4),'>').lt.1) return
+  n=-99
+  read(w(5),*,err=1) n
+1 if(n.lt.-30 .or. n.gt.30) return      !5th word must be a valid report 
+  call chkcall(w(1),bcall_1,ok1)
+  if(.not.ok1) return                   !1st word must be a valid basecall
+  call chkcall(w(3),bcall_2,ok2)
+  if(.not.ok2) return                   !3rd word must be a valid basecall
+
+! It's a Type 0.1 message
+  i3=0
+  n3=1
+  call pack28(w(1),n28a)
+  call pack28(w(3),n28b)
+  n10=0
+  n5=17
+  write(c77,1010) n28a,n28b,n10,n5,n3,i3
+1010 format(2b28.28,b10.10,b5.5,2b3.3)
+  
+  return
+end subroutine pack77_01

lib/77bit/packtext77.f90

@@ -0,0 +1,28 @@
+subroutine packtext77(c13,c71)
+
+  real*16 q
+  character*13 c13,w
+  character*71 c71
+  character*42 c
+  data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-./?'/
+
+  q=0.q0
+  w=adjustr(c13)
+  do i=1,13
+     j=index(c,w(i:i))-1
+     if(j.lt.0) j=0
+     q=42.q0*q + j
+  enddo
+
+  do i=71,1,-1
+     c71(i:i)='0'
+     n=mod(q,2.q0)
+     q=q/2.q0
+     if(n.eq.1) then
+        c71(i:i)='1'
+        q=q-0.q5
+     endif
+  enddo
+
+  return
+end subroutine packtext77

lib/77bit/split77.f90

@@ -0,0 +1,36 @@
+subroutine split77(msg,nwords,nw,w)
+
+! Convert msg to upper case; collapse multiple blanks; parse into words.
+
+  character*37 msg
+  character*13 w(19)
+  character*1 c,c0
+  integer nw(19)
+    
+  iz=len(trim(msg))
+  j=0
+  k=0
+  n=0
+  c0=' '
+  w='             '
+  do i=1,iz
+     c=msg(i:i)                                 !Single character
+     if(c.eq.' ' .and. c0.eq.' ') cycle         !Skip leading/repeated blanks
+     if(c.ne.' ' .and. c0.eq.' ') then
+        k=k+1                                   !New word
+        n=0
+     endif
+     j=j+1                                      !Index in msg
+     n=n+1                                      !Index in word
+     msg(j:j)=c
+     if(c.ge.'a' .and. c.le.'z') msg(j:j)=char(ichar(c)-32)  !Force upper case
+     w(k)(n:n)=c                                !Copy character c into word
+     c0=c
+  enddo
+  iz=j                                          !Message length
+  nwords=k                                      !Number of words in msg
+  nw(k)=len(trim(w(k)))
+  msg(iz+1:)='                                     '
+
+  return
+end subroutine split77

lib/77bit/unpack28.f90

@@ -0,0 +1,42 @@
+subroutine unpack28(n28,c13)
+
+  parameter (NTOKENS=4874084,N24=16777216)
+  integer nc(6)
+  character*13 c13
+  character*37 c1
+  character*36 c2
+  character*10 c3
+  character*27 c4
+  data c1/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+  data c2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+  data c3/'0123456789'/
+  data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+  data nc/37,36,19,27,27,27/
+
+  n=n28 - NTOKENS - N24
+  j=mod(n,nc(6))
+  c13(6:6)=c4(j+1:j+1)
+  n=n/nc(6)
+
+  j=mod(n,nc(5))
+  c13(5:5)=c4(j+1:j+1)
+  n=n/nc(5)
+
+  j=mod(n,nc(4))
+  c13(4:4)=c4(j+1:j+1)
+  n=n/nc(4)
+
+  j=mod(n,nc(3))
+  c13(3:3)=c3(j+1:j+1)
+  n=n/nc(3)
+
+  j=mod(n,nc(2))
+  c13(2:2)=c2(j+1:j+1)
+  n=n/nc(2)
+
+  j=n
+  c13(1:1)=c1(j+1:j+1)
+  c13(7:)='       '
+
+  return
+end subroutine unpack28

lib/77bit/unpack77.f90

@@ -0,0 +1,24 @@
+subroutine unpack77(c77,msg)
+
+  character*77 c77
+  character*37 msg
+  character*13 c13
+
+  read(c77(72:77),'(2b3)') n3,i3
+  msg=repeat(' ',37)
+  if(i3.eq.0 .and. n3.eq.0) then
+     call unpacktext77(c77(1:71),msg(1:13))
+     msg(14:)='                        '
+  else if(i3.eq.0 .and. n3.eq.1) then
+     read(c77,1010) n28a,n28b,n10,n5
+1010 format(2b28,b10,b5)
+     print*,'C1:',n28a,n28b,n10,n5,n3,i3
+     call unpack28(n28a,c13)
+     print*,'C2: ',c13
+     call unpack28(n28b,c13)
+     print*,'C3: ',c13
+
+  endif
+
+  return
+end subroutine unpack77

lib/77bit/unpacktext77.f90

@@ -0,0 +1,22 @@
+subroutine unpacktext77(c71,c13)
+
+  real*16 q,q1
+  integer*8 n1,n2
+  character*13 c13
+  character*71 c71
+  character*42 c
+  data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-./?'/
+
+  read(c71,1001) n1,n2
+1001 format(b63,b8)
+  q=n1*256.q0 + n2
+
+  do i=13,1,-1
+     q1=mod(q,42.q0)
+     j=q1+1.q0
+     c13(i:i)=c(j:j)
+     q=(q-q1)/42.q0
+  enddo
+
+  return
+end subroutine unpacktext77