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

Nearly finished with pack77/unpack77.

This commit is contained in:
Joe Taylor 2018-06-27 16:41:58 -04:00
parent 983cd3f31c
commit 617b0bffc8
10 changed files with 133 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -0,0 +1,12 @@
CQ K1ABC FN42
DE K1ABC FN42
QRZ K1ABC FN42
CQ AA K1ABC FN42
CQ ZZ K1ABC FN42
CQ 000 K1ABC FN42
CQ 313 K1ABC FN42
CQ 999 K1ABC FN42
CQ AAA K1ABC FN42
CQ ZZZ K1ABC FN42
CQ AAAA K1ABC FN42
CQ ZZZZ K1ABC FN42

22
lib/77bit/encode77.f90
View File

@ -3,26 +3,22 @@ program encode77
character msg*37,msg0*37,cerr*1
character*77 c77
open(10,file='msgtypes.txt',status='old')
! Skip over first two lines
read(10,1001) cerr
read(10,1001) cerr
1001 format(a1)
nargs=iargc()
do iline=1,999
read(10,1002,end=999) i3a,n3a,msg0
1002 format(i1,i4,1x,a37)
if(nargs.eq.1) then
call getarg(1,msg0)
else
read(*,1002,end=999) msg0
1002 format(a37)
endif
if(msg0.eq.' ') exit
i3=i3a
n3=n3a
! if(i3a.gt.1 .or. n3a.gt.5) cycle
call pack77(msg0,i3,n3,c77)
call unpack77(c77,msg)
cerr=' '
if(i3a.ne.i3 .or. n3a.ne.n3 .or. msg.ne.msg0) cerr='*'
if(msg.ne.msg0) cerr='*'
write(*,1004) i3,n3,cerr,msg0,msg
1004 format(i1,'.',i1,1x,a1,1x,a37,1x,a37)
if(nargs.eq.1) exit
enddo
999 end program encode77

36
lib/77bit/messages.txt Normal file
View File

@ -0,0 +1,36 @@
FREE TEXT MSG 71 0 71
K1ABC RR73; W9XYZ <KH1/KH7Z> -12 28 28 10 5 1 71 DXpedition Mode
PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2)
PA3XYZ 520093 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2)
WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 3 71 ARRL Field Day
WA9XYZ KA1ABC 7D EMA 28 28 1 4 3 7 3 71 ARRL Field Day
WA9XYZ G8ABC 1D DX 28 28 1 4 3 7 3 71 ARRL Field Day
WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 4 71 ARRL Field Day
123456789ABCDEF012 71 71 Telemetry (18 hex)
7123456789ABCDEF01 71 71 Telemetry (18 hex)
71234567 71 71 Telemetry (18 hex)
81234567 71 71 Telemetry (18 hex)
8123456789ABCDEF01 71 71 Telemetry (18 hex)
WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg
WA9XYZ KA1ABC R-19 28 1 28 1 1 15 74 Standard msg
WA9XYZ KA1ABC +03 28 1 28 1 1 15 74 Standard msg
PA1XYZ/P GM4ABC/P R FN42 28 1 28 1 1 15 74 EU VHF Contest
TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 ARRL RTTY contest
TU; W9XYZ G8ABC R 559 0013 1 28 28 1 3 13 74 ARRL RTTY (DX)
<WA9XYZ> PJ4/KA1ABC 13 58 1 2 74 Nonstandard call
PJ4/KA1ABC <WA9XYZ> RRR 13 58 1 2 74 Nonstandard call
<WA9XYZ> PJ4/KA1ABC RR73 13 58 1 2 74 Nonstandard call
PJ4/KA1ABC <WA9XYZ> 73 13 58 1 2 74 Nonstandard call
<WA9XYZ> PJ4/KA1ABC 73 13 58 1 2 74 Nonstandard call
CQ K1ABC FN42
DE K1ABC FN42
QRZ K1ABC FN42
CQ AA K1ABC FN42
CQ ZZ K1ABC FN42
CQ 000 K1ABC FN42
CQ 313 K1ABC FN42
CQ 999 K1ABC FN42
CQ AAA K1ABC FN42
CQ ZZZ K1ABC FN42
CQ AAAA K1ABC FN42
CQ ZZZZ K1ABC FN42

1
lib/77bit/msgtypes.txt
View File

@ -14,6 +14,7 @@ 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
1 WA9XYZ KA1ABC R-11 28 1 28 1 1 15 74 Standard msg
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)

3
lib/77bit/pack77.f90
View File

@ -14,6 +14,7 @@ subroutine pack77(msg,i3,n3,c77)
call split77(msg,nwords,nw,w)
i3=-1
n3=-1
if(msg(1:3).eq.'CQ ' .or. msg(1:3).eq.'DE ' .or. msg(1:4).eq.'QRZ ') go to 100
! Check 0.1 (DXpedition mode)
call pack77_01(nwords,w,i3,n3,c77)
@ -43,7 +44,7 @@ subroutine pack77(msg,i3,n3,c77)
endif
! Check Types 1 and 2 (Standard 77-bit message (type 1) or with "/P" (type 2))
call pack77_1(nwords,w,i3,n3,c77)
100 call pack77_1(nwords,w,i3,n3,c77)
if(i3.ge.0) go to 900
! Check Type 3 (ARRL RTTY contest exchange)

38
lib/77bit/pack77_1.f90
View File

@ -1,10 +1,12 @@
subroutine pack77_1(nwords,w,i3,n3,c77)
! Check Type 1 (Standard 77-bit message) and Type 2 (ditto, with a "/P" call)
parameter (MAXGRID4=32400)
character*13 w(19),c13
character*77 c77
character*6 bcall_1,bcall_2
character*4 grid4
character c1*1,c2*2
logical is_grid4
logical ok1,ok2
is_grid4(grid4)=len(trim(grid4)).eq.4 .and. &
@ -13,11 +15,23 @@ subroutine pack77_1(nwords,w,i3,n3,c77)
grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. &
grid4(4:4).ge.'0' .and. grid4(4:4).le.'9'
! print*,'b',nwords,w(1:nwords)
if(nwords.lt.3 .or. nwords.gt.4) return
call chkcall(w(1),bcall_1,ok1)
call chkcall(w(2),bcall_2,ok2)
if(w(1)(1:3).eq.'DE ' .or. w(1)(1:3).eq.'CQ_' .or. w(1)(1:4).eq.'QRZ ') ok1=.true.
if(.not.ok1 .or. .not.ok2) return
if(.not.is_grid4(w(nwords)(1:4))) return
c1=w(nwords)(1:1)
c2=w(nwords)(1:2)
if(.not.is_grid4(w(nwords)(1:4)) .and. c1.ne.'+' .and. c1.ne.'-' &
.and. c2.ne.'R+' .and. c2.ne.'R-') return
if(c1.eq.'+' .or. c1.eq.'-') then
ir=0
read(w(nwords),*) irpt
else if(c2.eq.'R+' .or. c2.eq.'R-') then
ir=1
read(w(nwords)(2:),*) irpt
endif
! 1 WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg
! 2 PA3XYZ/P GM4ABC/P R JO22 28 1 28 1 1 15 74 EU VHF contest
@ -28,6 +42,7 @@ subroutine pack77_1(nwords,w,i3,n3,c77)
if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=2 !Type 2, with "/P"
endif
c13=bcall_1//' '
if(c13(1:3).eq.'CQ_') c13=w(1)
call pack28(c13,n28a)
c13=bcall_2//' '
call pack28(c13,n28b)
@ -35,16 +50,23 @@ subroutine pack77_1(nwords,w,i3,n3,c77)
ipb=0
if(index(w(1),'/P').ge.4 .or. index(w(1),'/R').ge.4) ipa=1
if(index(w(2),'/P').ge.4 .or. index(w(2),'/R').ge.4) ipb=1
ir=0
if(w(3).eq.'R ') ir=1
grid4=w(nwords)(1:4)
j1=(ichar(grid4(1:1))-ichar('A'))*18*10*10
j2=(ichar(grid4(2:2))-ichar('A'))*10*10
j3=(ichar(grid4(3:3))-ichar('0'))*10
j4=(ichar(grid4(4:4))-ichar('0'))
igrid4=j1+j2+j3+j4
if(is_grid4(grid4)) then
ir=0
if(w(3).eq.'R ') ir=1
j1=(ichar(grid4(1:1))-ichar('A'))*18*10*10
j2=(ichar(grid4(2:2))-ichar('A'))*10*10
j3=(ichar(grid4(3:3))-ichar('0'))*10
j4=(ichar(grid4(4:4))-ichar('0'))
igrid4=j1+j2+j3+j4
else
igrid4=MAXGRID4 + 35 + irpt
endif
write(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3
1000 format(2(b28.28,b1),b1,b15.15,b3.3)
! print*,igrid4
! print*,c77
return
end subroutine pack77_1

2
lib/77bit/pack77_4.f90
View File

@ -41,7 +41,7 @@ subroutine pack77_4(nwords,w,i3,n3,c77)
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
if(trim(w(3)).eq.'73') nrpt=3
write(c77,1010) n13,n58,iflip,nrpt,i3
1010 format(b13.13,b58.58,b1,b2.2,b3.3)
endif

14
lib/77bit/split77.f90
View File

@ -5,6 +5,8 @@ subroutine split77(msg,nwords,nw,w)
character*37 msg
character*13 w(19)
character*1 c,c0
character*6 bcall_1
logical ok1
integer nw(19)
iz=len(trim(msg))
@ -24,13 +26,21 @@ subroutine split77(msg,nwords,nw,w)
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
if(n.le.13) 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:)=' '
call chkcall(w(3),bcall_1,ok1)
if(ok1 .and. w(1)(1:3).eq.'CQ ') then
w(1)='CQ_'//w(2)(1:10)
w(2:12)=w(3:13)
nwords=nwords-1
endif
! print*,'a',nwords,w(1:nwords)
return
end subroutine split77

1
lib/77bit/unpack28.f90
View File

@ -27,6 +27,7 @@ subroutine unpack28(n28_0,c13)
endif
if(n28.le.532443) then
n=n28-1003
n0=n
i1=n/(27*27*27)
n=n-27*27*27*i1
i2=n/(27*27)

43
lib/77bit/unpack77.f90
View File

@ -2,6 +2,7 @@ subroutine unpack77(c77,msg)
parameter (NSEC=84) !Number of ARRL Sections
parameter (NUSCAN=65) !Number of US states and Canadian provinces
parameter (MAXGRID4=32400)
integer*8 n58
integer ntel(3)
character*77 c77
@ -124,25 +125,40 @@ subroutine unpack77(c77,msg)
1000 format(2(b28,b1),b1,b15,b3)
call unpack28(n28a,call_1)
call unpack28(n28b,call_2)
if(call_1(1:3).eq.'CQ_') call_1(3:3)=' '
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.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.2) call_2(i:i+1)='/P'
n=igrid4
j1=n/(18*10*10)
n=n-j1*18*10*10
j2=n/(10*10)
n=n-j2*10*10
j3=n/10
j4=n-j3*10
grid4(1:1)=char(j1+ichar('A'))
grid4(2:2)=char(j2+ichar('A'))
grid4(3:3)=char(j3+ichar('0'))
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
if(igrid4.le.MAXGRID4) then
n=igrid4
j1=n/(18*10*10)
n=n-j1*18*10*10
j2=n/(10*10)
n=n-j2*10*10
j3=n/10
j4=n-j3*10
grid4(1:1)=char(j1+ichar('A'))
grid4(2:2)=char(j2+ichar('A'))
grid4(3:3)=char(j3+ichar('0'))
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
irpt=igrid4-MAXGRID4
if(irpt.eq.1) msg=trim(call_1)//' '//trim(call_2)
if(irpt.eq.2) msg=trim(call_1)//' '//trim(call_2)//' RRR'
if(irpt.eq.2) msg=trim(call_1)//' '//trim(call_2)//' RR73'
if(irpt.eq.4) msg=trim(call_1)//' '//trim(call_2)//' 73'
if(irpt.ge.5) then
write(crpt,'(i3.2)') irpt-35
if(crpt(1:1).eq.' ') crpt(1:1)='+'
if(ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//' '//crpt
if(ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//' R'//crpt
endif
endif
else if(i3.eq.3) then
! Type 3: ARRL RTTY Contest
@ -184,7 +200,6 @@ subroutine unpack77(c77,msg)
' 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