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

Nearly finished with pack77/unpack77.

Browse Source
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 msg*37,msg0*37,cerr*1
character*77 c77 character*77 c77
open(10,file='msgtypes.txt',status='old') nargs=iargc()
! Skip over first two lines
read(10,1001) cerr
read(10,1001) cerr
1001 format(a1)
do iline=1,999 do iline=1,999
read(10,1002,end=999) i3a,n3a,msg0 if(nargs.eq.1) then
1002 format(i1,i4,1x,a37) call getarg(1,msg0)
else
read(*,1002,end=999) msg0
1002 format(a37)
endif
if(msg0.eq.' ') exit if(msg0.eq.' ') exit
i3=i3a
n3=n3a
! if(i3a.gt.1 .or. n3a.gt.5) cycle
call pack77(msg0,i3,n3,c77) call pack77(msg0,i3,n3,c77)
call unpack77(c77,msg) call unpack77(c77,msg)
cerr=' ' 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 write(*,1004) i3,n3,cerr,msg0,msg
1004 format(i1,'.',i1,1x,a1,1x,a37,1x,a37) 1004 format(i1,'.',i1,1x,a1,1x,a37,1x,a37)
if(nargs.eq.1) exit
enddo enddo
999 end program encode77 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 81234567 71 71 Telemetry (18 hex)
0 5 8123456789ABCDEF01 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/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 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 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 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) call split77(msg,nwords,nw,w)
i3=-1 i3=-1
n3=-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) ! Check 0.1 (DXpedition mode)
call pack77_01(nwords,w,i3,n3,c77) call pack77_01(nwords,w,i3,n3,c77)
@ -43,7 +44,7 @@ subroutine pack77(msg,i3,n3,c77)
endif endif
! Check Types 1 and 2 (Standard 77-bit message (type 1) or with "/P" (type 2)) ! 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 if(i3.ge.0) go to 900
! Check Type 3 (ARRL RTTY contest exchange) ! 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) subroutine pack77_1(nwords,w,i3,n3,c77)
! Check Type 1 (Standard 77-bit message) and Type 2 (ditto, with a "/P" call) ! Check Type 1 (Standard 77-bit message) and Type 2 (ditto, with a "/P" call)
parameter (MAXGRID4=32400)
character*13 w(19),c13 character*13 w(19),c13
character*77 c77 character*77 c77
character*6 bcall_1,bcall_2 character*6 bcall_1,bcall_2
character*4 grid4 character*4 grid4
character c1*1,c2*2
logical is_grid4 logical is_grid4
logical ok1,ok2 logical ok1,ok2
is_grid4(grid4)=len(trim(grid4)).eq.4 .and. & 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(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. &
grid4(4:4).ge.'0' .and. grid4(4:4).le.'9' 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 if(nwords.lt.3 .or. nwords.gt.4) return
call chkcall(w(1),bcall_1,ok1) call chkcall(w(1),bcall_1,ok1)
call chkcall(w(2),bcall_2,ok2) 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.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 ! 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 ! 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" if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=2 !Type 2, with "/P"
endif endif
c13=bcall_1//' ' c13=bcall_1//' '
if(c13(1:3).eq.'CQ_') c13=w(1)
call pack28(c13,n28a) call pack28(c13,n28a)
c13=bcall_2//' ' c13=bcall_2//' '
call pack28(c13,n28b) call pack28(c13,n28b)
@ -35,16 +50,23 @@ subroutine pack77_1(nwords,w,i3,n3,c77)
ipb=0 ipb=0
if(index(w(1),'/P').ge.4 .or. index(w(1),'/R').ge.4) ipa=1 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 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) grid4=w(nwords)(1:4)
j1=(ichar(grid4(1:1))-ichar('A'))*18*10*10 if(is_grid4(grid4)) then
j2=(ichar(grid4(2:2))-ichar('A'))*10*10 ir=0
j3=(ichar(grid4(3:3))-ichar('0'))*10 if(w(3).eq.'R ') ir=1
j4=(ichar(grid4(4:4))-ichar('0')) j1=(ichar(grid4(1:1))-ichar('A'))*18*10*10
igrid4=j1+j2+j3+j4 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 write(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3
1000 format(2(b28.28,b1),b1,b15.15,b3.3) 1000 format(2(b28.28,b1),b1,b15.15,b3.3)
! print*,igrid4
! print*,c77
return return
end subroutine pack77_1 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 nrpt=0
if(trim(w(3)).eq.'RRR') nrpt=1 if(trim(w(3)).eq.'RRR') nrpt=1
if(trim(w(3)).eq.'RR73') nrpt=2 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 write(c77,1010) n13,n58,iflip,nrpt,i3
1010 format(b13.13,b58.58,b1,b2.2,b3.3) 1010 format(b13.13,b58.58,b1,b2.2,b3.3)
endif endif

14
lib/77bit/split77.f90
View File

@ -5,6 +5,8 @@ subroutine split77(msg,nwords,nw,w)
character*37 msg character*37 msg
character*13 w(19) character*13 w(19)
character*1 c,c0 character*1 c,c0
character*6 bcall_1
logical ok1
integer nw(19) integer nw(19)
iz=len(trim(msg)) iz=len(trim(msg))
@ -24,13 +26,21 @@ subroutine split77(msg,nwords,nw,w)
n=n+1 !Index in word n=n+1 !Index in word
msg(j:j)=c msg(j:j)=c
if(c.ge.'a' .and. c.le.'z') msg(j:j)=char(ichar(c)-32) !Force upper case 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 c0=c
enddo enddo
iz=j !Message length iz=j !Message length
nwords=k !Number of words in msg nwords=k !Number of words in msg
nw(k)=len(trim(w(k))) nw(k)=len(trim(w(k)))
msg(iz+1:)=' ' 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 return
end subroutine split77 end subroutine split77

1
lib/77bit/unpack28.f90
View File

@ -27,6 +27,7 @@ subroutine unpack28(n28_0,c13)
endif endif
if(n28.le.532443) then if(n28.le.532443) then
n=n28-1003 n=n28-1003
n0=n
i1=n/(27*27*27) i1=n/(27*27*27)
n=n-27*27*27*i1 n=n-27*27*27*i1
i2=n/(27*27) 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 (NSEC=84) !Number of ARRL Sections
parameter (NUSCAN=65) !Number of US states and Canadian provinces parameter (NUSCAN=65) !Number of US states and Canadian provinces
parameter (MAXGRID4=32400)
integer*8 n58 integer*8 n58
integer ntel(3) integer ntel(3)
character*77 c77 character*77 c77
@ -124,25 +125,40 @@ subroutine unpack77(c77,msg)
1000 format(2(b28,b1),b1,b15,b3) 1000 format(2(b28,b1),b1,b15,b3)
call unpack28(n28a,call_1) call unpack28(n28a,call_1)
call unpack28(n28b,call_2) call unpack28(n28b,call_2)
if(call_1(1:3).eq.'CQ_') call_1(3:3)=' '
i=index(call_1,' ') 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.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. 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.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' if(i.ge.4 .and. ipb.eq.1 .and. i3.eq.2) call_2(i:i+1)='/P'
n=igrid4 if(igrid4.le.MAXGRID4) then
j1=n/(18*10*10) n=igrid4
n=n-j1*18*10*10 j1=n/(18*10*10)
j2=n/(10*10) n=n-j1*18*10*10
n=n-j2*10*10 j2=n/(10*10)
j3=n/10 n=n-j2*10*10
j4=n-j3*10 j3=n/10
grid4(1:1)=char(j1+ichar('A')) j4=n-j3*10
grid4(2:2)=char(j2+ichar('A')) grid4(1:1)=char(j1+ichar('A'))
grid4(3:3)=char(j3+ichar('0')) grid4(2:2)=char(j2+ichar('A'))
grid4(4:4)=char(j4+ichar('0')) grid4(3:3)=char(j3+ichar('0'))
if(ir.eq.0) msg=trim(call_1)//' '//trim(call_2)//' '//grid4 grid4(4:4)=char(j4+ichar('0'))
if(ir.eq.1) msg=trim(call_1)//' '//trim(call_2)//' R '//grid4 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 else if(i3.eq.3) then
! Type 3: ARRL RTTY Contest ! Type 3: ARRL RTTY Contest
@ -184,7 +200,6 @@ subroutine unpack77(c77,msg)
' R '//crpt//' '//cserial ' R '//crpt//' '//cserial
endif endif
else if(i3.eq.4) then else if(i3.eq.4) then
! print*,c77
read(c77,1050) n13,n58,iflip,nrpt read(c77,1050) n13,n58,iflip,nrpt
1050 format(b13,b58,b1,b2) 1050 format(b13,b58,b1,b2)
do i=11,1,-1 do i=11,1,-1