w4kek
/
WSJT-X
mirror of https://github.com/saitohirga/WSJT-X.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More additions to pack77/unpack77 routines.

This commit is contained in:
Joe Taylor 2018-06-27 15:07:04 -04:00
parent c007b0f4cd
commit 983cd3f31c
12 changed files with 215 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lib/77bit/chk77_3.f90
View File

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

7
lib/77bit/encode77.f90
View File

@ -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 'chk77_3.f90'
include 'pack77_3.f90'
include 'pack77_4.f90'
include 'packtext77.f90'
include 'unpacktext77.f90'

2
lib/77bit/g2
View File

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

3
lib/77bit/g8
View File

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

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

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

10
lib/77bit/msgtypes.txt
View File

@ -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
3 <WA9XYZ> PJ4/KA1ABC R-11 13 53 1 1 6 74 Nonstandard calls
4 PA3XYZ/P GM4ABC/P R IO91 28 1 28 1 1 15 74 EU VHF contest
2 PA1XYZ/P GM4ABC/P R FN42 28 1 28 1 1 15 74 EU VHF Contest
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)
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

10
lib/77bit/pack77.f90
View File

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

36
lib/77bit/chk77_2.f90 → lib/77bit/pack77_3.f90
View File

@ -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
read(w(nwords),*,err=1) n
1 i3=2
n3=0
nserial=0
read(w(nwords),*,err=1) nserial
!1 i3=3
! 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
i3=2
nexch=0
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

50
lib/77bit/pack77_4.f90 Normal file
View File

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

8
lib/77bit/test28.f90
View File

@ -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
1010 format(a13,i12,2i5,2x,a1,2x,a13a13)
write(*,1010) call_0,n28,cerr,call_1
1010 format(a13,i12,2x,a1,2x,a13a13)
enddo
999 end program t8
999 end program test28

2
lib/77bit/unpack28.f90
View File

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

85
lib/77bit/unpack77.f90
View File

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