More work on pack28/unpack28, and a test28 program.

lib/77bit/calls.txt

@@ -0,0 +1,5 @@
+KA1ABC
+WB9XYZ
+KH1/KH7Z
+<KH1/KH7Z>
+CQ DX K1ABC

lib/77bit/calls2.txt

@@ -0,0 +1,7 @@
+A0A
+A00A
+A0AA
+A0AAA
+KA0ABC
+5B1ABC
+9Y4XYZ

lib/77bit/calls3.txt

@@ -0,0 +1,4 @@
+AA0AAA
+A0AAA
+A0AAB
+A0AA

lib/77bit/g8

@@ -0,0 +1 @@
+gfortran -o test28 test28.f90 pack28.f90 unpack28.f90 ihashcall.f90 hash24.f90

lib/77bit/hash24.f90

@@ -0,0 +1,34 @@
+subroutine hash24(n24,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.n24) 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)=n24
+     callsign(1)=c13
+  else
+     do i=1,NMAX
+        if(ihash(i).eq.n24) then
+           c13=callsign(i)
+           go to 900
+        endif
+     enddo
+  endif
+
+900 return
+end subroutine hash24

lib/77bit/hashcalls.txt

@@ -0,0 +1,20 @@
+<KH1/KH7Z>
+<VP2E/KA1ABC>
+K1ABC
+WB9XYZ
+KA1ABC
+WB9XYZ
+K1JT
+KA1JT
+5B1ABC
+9Y4XYZ
+9Y4AB
+999ABC
+ZM90DX
+EI30T
+ZS9YOTA
+HA70BAY
+HB9GOLD
+YW18FIFA
+YB50ST
+W2000XYZ

lib/77bit/pack28.f90

@@ -3,8 +3,9 @@ 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)
+  parameter (NTOKENS=4874084,MAX24=16777216)
   integer nc(6)
+  logical is_digit,is_letter
   character*13 c13
   character*6 callsign
   character*1 c
@@ -19,7 +20,16 @@ subroutine pack28(c13,n28)
   data a4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
   data nc/37,36,19,27,27,27/
   
+  is_digit(c)=c.ge.'0' .and. c.le.'9'
+  is_letter(c)=c.ge.'A' .and. c.le.'Z'
+
   n28=-1
+! 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)
+
 ! Check for special tokens first
   if(c13(1:3).eq.'DE ') then
      n28=0
@@ -67,49 +77,53 @@ subroutine pack28(c13,n28)
      endif
   endif
 
-  callsign=c13(1:6)  
+! Check for <...> callsign
-! Work-around for Swaziland prefix:
+  if(c13(1:1).eq.'<')then
-  if(c13(1:4).eq.'3DA0') callsign='3D0'//c13(5:7)
+     n24=ihashcall(c13,24)
-! Work-around for Guinea prefixes:
+     call hash24(n24,c13,1)     !Save (key,value) in hash table
-  if(c13(1:2).eq.'3X' .and. c13(3:3).ge.'A' .and.          &
+     n28=NTOKENS + n24
-       c13(3:3).le.'Z') callsign='Q'//c13(3:6)
+     go to 900
+  endif
 
-!  if(callsign(1:3).eq.'CQ ') then
+! Check for standard callsign
-!     n28=1
+  iarea=-1
-!     if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and.        &
+  n=len(trim(c13))
-!          callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and.      &
+  do i=n,2,-1
-!          callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
+     if(is_digit(c13(i:i))) exit
-!        read(callsign(4:6),*) nfreq
+  enddo
-!        n28=3 + nfreq
+  iarea=i
-!     endif
+  npdig=0
-!     return
+  nplet=0
-!  else if(callsign(1:4).eq.'QRZ ') then
+  do i=1,iarea-1
-!     n28=2
+     if(is_digit(c13(i:i))) npdig=npdig+1
-!     return
+     if(is_letter(c13(i:i))) nplet=nplet+1
-!  else if(callsign(1:3).eq.'DE ') then
+  enddo
-!     n28=267796945
+  nslet=0
-!     return
+  do i=iarea+1,n
-!  endif
+     if(is_letter(c13(i:i))) nslet=nslet+1
+  enddo
+  if(iarea.lt.2 .or. iarea.gt.3 .or. nplet.eq.0 .or.       &
+       npdig.ge.iarea-1 .or. nslet.gt.3) then
+! Treat this as a nonstandard callsign: compute its 24-bit hash
+     n24=ihashcall(c13,24)
+     call hash24(n24,c13,1)     !Save (key,value) in hash table
+     n28=NTOKENS + n24
+     go to 900
+  endif
   
-! We have a standard callsign
+  n=len(trim(c13))
-  n=len(trim(callsign))
+! This is a standard callsign
-  callsign=adjustr(callsign)
+  if(iarea.eq.2) callsign=' '//c13(1:5)
-
+  if(iarea.eq.3) callsign=c13(1:6)
-  i1=36*10*27*27*27*(index(a1,callsign(1:1))-1)
+  i1=index(a1,callsign(1:1))-1
-  i2=10*27*27*27*(index(a2,callsign(2:2))-1)
+  i2=index(a2,callsign(2:2))-1
-  i3=27*27*27*(index(a3,callsign(3:3))-1)
+  i3=index(a3,callsign(3:3))-1
-  i4=27*27*(index(a4,callsign(4:4))-1)
+  i4=index(a4,callsign(4:4))-1
-  i5=27*(index(a4,callsign(5:5))-1)
+  i5=index(a4,callsign(5:5))-1
   i6=index(a4,callsign(6:6))-1
-  n28=i1+i2+i3+i4+i5+i6
+  n28=36*10*27*27*27*i1 + 10*27*27*27*i2 + 27*27*27*i3 + 27*27*i4 + &
-  
+       27*i5 + i6
-!  n28=index(a1,callsign(1:1))-1
+  n28=n28 + NTOKENS + MAX24
-!  n28=n28*nc(2) + index(a2,callsign(2:2)) - 1
-!  n28=n28*nc(3) + index(a3,callsign(3:3)) - 1
-!  n28=n28*nc(4) + index(a4,callsign(4:4)) - 1
-!  n28=n28*nc(5) + index(a4,callsign(5:5)) - 1
-!  n28=n28*nc(6) + index(a4,callsign(6:6)) - 1
-  n28=n28 + NTOKENS + N24
 
 900 return
 end subroutine pack28

lib/77bit/test28.f90

@@ -0,0 +1,16 @@
+program t8
+
+  character*13 call_0,call_1
+  character*1 cerr
+
+  do i=1,999
+     read(*,'(a13)',end=999) call_0
+     call pack28(call_0,n28)
+     call unpack28(n28,call_1)
+     cerr=' '
+     if(call_0.ne.call_1) cerr='*'
+     write(*,1010) call_0,n28,len(trim(call_0)),len(trim(call_1)),cerr,call_1
+1010 format(a13,i12,2i5,2x,a1,2x,a13a13)
+  enddo
+  
+999 end program t8

lib/77bit/tokens.txt

@@ -0,0 +1,12 @@
+DE
+QRZ
+CQ
+CQ_000
+CQ_313
+CQ_999
+CQ_A
+CQ_AAAA
+CQ_AB
+CQ_ABC
+CQ_ABCD
+CQ_ZZZZ

lib/77bit/unpack28.f90

@@ -1,6 +1,6 @@
 subroutine unpack28(n28_0,c13)
 
-  parameter (NTOKENS=4874084,N24=16777216)
+  parameter (NTOKENS=4874084,MAX24=16777216)
   integer nc(6)
   character*13 c13
   character*37 c1
@@ -40,12 +40,15 @@ subroutine unpack28(n28_0,c13)
      endif
   endif
   n28=n28-NTOKENS
-  if(n28.lt.N24) then
+  if(n28.lt.MAX24) then
-     !code for 24-bit hash
+! This is a 24-bit hash of a callsign
+     n24=n28
+     call hash24(n24,c13,-1)     !Retrieve callsign from hash table
+     go to 900
   endif
   
 ! Standard callsign
-  n=n28 - N24
+  n=n28 - MAX24
   i1=n/(36*10*27*27*27)
   n=n-36*10*27*27*27*i1
   i2=n/(10*27*27*27)