From d4784ef7dcbdd7140b380f316cc246cd1862e44e Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Wed, 27 Jun 2018 11:08:39 -0400 Subject: [PATCH] More work on pack28/unpack28, and a test28 program. --- lib/77bit/calls.txt | 5 ++ lib/77bit/calls2.txt | 7 +++ lib/77bit/calls3.txt | 4 ++ lib/77bit/g8 | 1 + lib/77bit/hash24.f90 | 34 ++++++++++++++ lib/77bit/hashcalls.txt | 20 ++++++++ lib/77bit/pack28.f90 | 100 +++++++++++++++++++++++----------------- lib/77bit/test28.f90 | 16 +++++++ lib/77bit/tokens.txt | 12 +++++ lib/77bit/unpack28.f90 | 11 +++-- 10 files changed, 163 insertions(+), 47 deletions(-) create mode 100644 lib/77bit/calls.txt create mode 100644 lib/77bit/calls2.txt create mode 100644 lib/77bit/calls3.txt create mode 100644 lib/77bit/g8 create mode 100644 lib/77bit/hash24.f90 create mode 100644 lib/77bit/hashcalls.txt create mode 100644 lib/77bit/test28.f90 create mode 100644 lib/77bit/tokens.txt diff --git a/lib/77bit/calls.txt b/lib/77bit/calls.txt new file mode 100644 index 000000000..c542c9b61 --- /dev/null +++ b/lib/77bit/calls.txt @@ -0,0 +1,5 @@ +KA1ABC +WB9XYZ +KH1/KH7Z + +CQ DX K1ABC diff --git a/lib/77bit/calls2.txt b/lib/77bit/calls2.txt new file mode 100644 index 000000000..b1f487741 --- /dev/null +++ b/lib/77bit/calls2.txt @@ -0,0 +1,7 @@ +A0A +A00A +A0AA +A0AAA +KA0ABC +5B1ABC +9Y4XYZ diff --git a/lib/77bit/calls3.txt b/lib/77bit/calls3.txt new file mode 100644 index 000000000..69a81bb90 --- /dev/null +++ b/lib/77bit/calls3.txt @@ -0,0 +1,4 @@ +AA0AAA +A0AAA +A0AAB +A0AA diff --git a/lib/77bit/g8 b/lib/77bit/g8 new file mode 100644 index 000000000..60c34b765 --- /dev/null +++ b/lib/77bit/g8 @@ -0,0 +1 @@ +gfortran -o test28 test28.f90 pack28.f90 unpack28.f90 ihashcall.f90 hash24.f90 diff --git a/lib/77bit/hash24.f90 b/lib/77bit/hash24.f90 new file mode 100644 index 000000000..c3298ec53 --- /dev/null +++ b/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 diff --git a/lib/77bit/hashcalls.txt b/lib/77bit/hashcalls.txt new file mode 100644 index 000000000..d8058f1f2 --- /dev/null +++ b/lib/77bit/hashcalls.txt @@ -0,0 +1,20 @@ + + +K1ABC +WB9XYZ +KA1ABC +WB9XYZ +K1JT +KA1JT +5B1ABC +9Y4XYZ +9Y4AB +999ABC +ZM90DX +EI30T +ZS9YOTA +HA70BAY +HB9GOLD +YW18FIFA +YB50ST +W2000XYZ diff --git a/lib/77bit/pack28.f90 b/lib/77bit/pack28.f90 index 7a13f27f0..18dc4fe5b 100644 --- a/lib/77bit/pack28.f90 +++ b/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 @@ -18,8 +19,17 @@ subroutine pack28(c13,n28) data a3/'0123456789'/ 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 @@ -66,50 +76,54 @@ subroutine pack28(c13,n28) endif endif endif + +! Check for <...> callsign + if(c13(1:1).eq.'<')then + n24=ihashcall(c13,24) + call hash24(n24,c13,1) !Save (key,value) in hash table + n28=NTOKENS + n24 + go to 900 + endif + +! Check for standard callsign + iarea=-1 + n=len(trim(c13)) + do i=n,2,-1 + if(is_digit(c13(i:i))) exit + enddo + iarea=i + npdig=0 + nplet=0 + do i=1,iarea-1 + if(is_digit(c13(i:i))) npdig=npdig+1 + if(is_letter(c13(i:i))) nplet=nplet+1 + enddo + nslet=0 + do i=iarea+1,n + 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 - 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) - - i1=36*10*27*27*27*(index(a1,callsign(1:1))-1) - i2=10*27*27*27*(index(a2,callsign(2:2))-1) - i3=27*27*27*(index(a3,callsign(3:3))-1) - i4=27*27*(index(a4,callsign(4:4))-1) - i5=27*(index(a4,callsign(5:5))-1) + n=len(trim(c13)) +! This is a standard callsign + if(iarea.eq.2) callsign=' '//c13(1:5) + if(iarea.eq.3) callsign=c13(1:6) + i1=index(a1,callsign(1:1))-1 + i2=index(a2,callsign(2:2))-1 + i3=index(a3,callsign(3:3))-1 + i4=index(a4,callsign(4:4))-1 + i5=index(a4,callsign(5:5))-1 i6=index(a4,callsign(6:6))-1 - n28=i1+i2+i3+i4+i5+i6 - -! n28=index(a1,callsign(1:1))-1 -! 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 + n28=36*10*27*27*27*i1 + 10*27*27*27*i2 + 27*27*27*i3 + 27*27*i4 + & + 27*i5 + i6 + n28=n28 + NTOKENS + MAX24 900 return end subroutine pack28 diff --git a/lib/77bit/test28.f90 b/lib/77bit/test28.f90 new file mode 100644 index 000000000..2d6c4c342 --- /dev/null +++ b/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 diff --git a/lib/77bit/tokens.txt b/lib/77bit/tokens.txt new file mode 100644 index 000000000..bb5142041 --- /dev/null +++ b/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 diff --git a/lib/77bit/unpack28.f90 b/lib/77bit/unpack28.f90 index 9d5df39cd..38a7d94ec 100644 --- a/lib/77bit/unpack28.f90 +++ b/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 - !code for 24-bit hash + if(n28.lt.MAX24) then +! 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)