w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-25 05:38:46 -05:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Joe Taylor 2018-06-27 11:08:39 -04:00
parent 12e0def237
commit d4784ef7dc
10 changed files with 163 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lib/77bit/calls.txt Normal file
View File

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

7
lib/77bit/calls2.txt Normal file
View File

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

4
lib/77bit/calls3.txt Normal file
View File

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

1
lib/77bit/g8 Normal file
View File

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

34
lib/77bit/hash24.f90 Normal file
View File

@ -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

20
lib/77bit/hashcalls.txt Normal file
View File

@ -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

100
lib/77bit/pack28.f90
View File

@ -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

16
lib/77bit/test28.f90 Normal file
View File

@ -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

12
lib/77bit/tokens.txt Normal file
View File

@ -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

11
lib/77bit/unpack28.f90
View File

@ -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)