w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-09-28 16:16:48 -04:00
Code Issues Packages Projects Releases Wiki Activity

Basic function for message Types 0.0-0.5 and Type 1.

Browse Source
This commit is contained in:
Joe Taylor 2018-06-26 16:34:38 -04:00
parent 9d5a2e6f5a
commit b0636b561b
7 changed files with 91 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lib/77bit/chk77_1.f90
View File

@ -1,30 +0,0 @@
subroutine chk77_1(nwords,w,i3,n3)
! Check Type 1 (Standard 77-bit message) and Type 4 (ditto, with a "/P" call)
character*13 w(19)
character*6 bcall_1,bcall_2
character*4 grid4
logical is_grid4
logical ok1,ok2
is_grid4(grid4)=len(trim(grid4)).eq.4 .and. &
grid4(1:1).ge.'A' .and. grid4(1:1).le.'R' .and. &
grid4(2:2).ge.'A' .and. grid4(2:2).le.'R' .and. &
grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. &
grid4(4:4).ge.'0' .and. grid4(4:4).le.'9'
call chkcall(w(1),bcall_1,ok1)
call chkcall(w(2),bcall_2,ok2)
if(nwords.eq.3 .or. nwords.eq.4) then
if(ok1 .and. ok2 .and. is_grid4(w(nwords)(1:4))) then
if(nwords.eq.3 .or. (nwords.eq.4 .and. w(3)(1:2).eq.'R ')) then
i3=1 !Type 1: Standard message
if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=4
n3=0
endif
endif
endif
return
end subroutine chk77_1

6
lib/77bit/encode77.f90
View File

@ -13,7 +13,9 @@ program encode77
do iline=1,999 do iline=1,999
read(10,1002,end=999) i3a,n3a,msg0 read(10,1002,end=999) i3a,n3a,msg0
1002 format(i1,i4,1x,a37) 1002 format(i1,i4,1x,a37)
if(i3a.gt.0 .or. n3a.gt.3) cycle 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=' '
@ -33,7 +35,7 @@ include 'split77.f90'
include 'pack77_01.f90' include 'pack77_01.f90'
include 'pack77_02.f90' include 'pack77_02.f90'
include 'pack77_03.f90' include 'pack77_03.f90'
include 'chk77_1.f90' include 'pack77_1.f90'
include 'chk77_2.f90' include 'chk77_2.f90'
include 'chk77_3.f90' include 'chk77_3.f90'
include 'packtext77.f90' include 'packtext77.f90'

1
lib/77bit/msgtypes.txt
View File

@ -5,6 +5,7 @@ i3 n3
0 2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 2 70 EU VHF contest (2) 0 2 PA3XYZ/P R 590003 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 R 16A EMA 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 4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 4 71 ARRL Field Day
0 5 0123456789ABCDEF01 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
2 TU; W9XYZ K1ABC R 579 MA 1 28 28 1 3 13 74 ARRL RTTY contest 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 3 <WA9XYZ> PJ4/KA1ABC R-11 13 53 1 1 6 74 Nonstandard calls

18
lib/77bit/pack77.f90
View File

@ -6,6 +6,9 @@ subroutine pack77(msg,i3,n3,c77)
character*13 w(19) character*13 w(19)
character*77 c77 character*77 c77
integer nw(19) integer nw(19)
integer ntel(3)
if(i3.eq.0 .and. n3.eq.5) go to 5
! Convert msg to upper case; collapse multiple blanks; parse into words. ! Convert msg to upper case; collapse multiple blanks; parse into words.
call split77(msg,nwords,nw,w) call split77(msg,nwords,nw,w)
@ -23,9 +26,22 @@ subroutine pack77(msg,i3,n3,c77)
call pack77_03(nwords,w,i3,n3,c77) call pack77_03(nwords,w,i3,n3,c77)
if(i3.ge.0) go to 900 if(i3.ge.0) go to 900
! Check 0.5 (telemetry)
5 if(index(msg,' ').gt.18) then
ntel=-99
read(msg(1:18),1005,err=6) ntel
1005 format(3z6)
6 if(ntel(1).ge.0 .and. ntel(2).ge.0 .and. ntel(3).ge.0) then
i3=0
n3=5
write(c77,1006) ntel,n3
1006 format(b23.23,2b24.24,b3.3)
go to 900
endif
endif
! Check Types 1 and 4 (Standard 77-bit message (type 1) or with "/P" (type 4)) ! Check Types 1 and 4 (Standard 77-bit message (type 1) or with "/P" (type 4))
call chk77_1(nwords,w,i3,n3) call pack77_1(nwords,w,i3,n3,c77)
if(i3.ge.0) go to 900 if(i3.ge.0) go to 900
! Check Type 2 (ARRL RTTY contest exchange) ! Check Type 2 (ARRL RTTY contest exchange)

2
lib/77bit/pack77_03.f90
View File

@ -49,7 +49,7 @@ subroutine pack77_03(nwords,w,i3,n3,c77)
intx=ntx-1 intx=ntx-1
if(intx.ge.16) then if(intx.ge.16) then
n3=4 !Type 0.4 ARRL Field Day n3=4 !Type 0.4 ARRL Field Day
intx=ntx-16 intx=ntx-17
endif endif
call pack28(w(1),n28a) call pack28(w(1),n28a)
call pack28(w(2),n28b) call pack28(w(2),n28b)

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

@ -0,0 +1,50 @@
subroutine pack77_1(nwords,w,i3,n3,c77)
! Check Type 1 (Standard 77-bit message) and Type 3 (ditto, with a "/P" call)
character*13 w(19),c13
character*77 c77
character*6 bcall_1,bcall_2
character*4 grid4
logical is_grid4
logical ok1,ok2
is_grid4(grid4)=len(trim(grid4)).eq.4 .and. &
grid4(1:1).ge.'A' .and. grid4(1:1).le.'R' .and. &
grid4(2:2).ge.'A' .and. grid4(2:2).le.'R' .and. &
grid4(3:3).ge.'0' .and. grid4(3:3).le.'9' .and. &
grid4(4:4).ge.'0' .and. grid4(4:4).le.'9'
if(nwords.lt.3 .or. nwords.gt.4) return
call chkcall(w(1),bcall_1,ok1)
call chkcall(w(2),bcall_2,ok2)
if(.not.ok1 .or. .not.ok2) return
if(.not.is_grid4(w(nwords)(1:4))) return
! 1 WA9XYZ/R KA1ABC/R R FN42 28 1 28 1 1 15 74 Standard msg
! 3 PA3XYZ/P GM4ABC/P R JO22 28 1 28 1 1 15 74 EU VHF contest
if(nwords.eq.3 .or. (nwords.eq.4 .and. w(3)(1:2).eq.'R ')) then
n3=0
i3=1 !Type 1: Standard message
if(index(w(1),'/P').ge.4 .or. index(w(2),'/P').ge.4) i3=3
endif
c13=bcall_1//' '
call pack28(c13,n28a)
c13=bcall_2//' '
call pack28(c13,n28b)
ipa=0
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
write(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3
1000 format(2(b28.28,b1),b1,b15.15,b3.3)
return
end subroutine pack77_1

17
lib/77bit/unpack77.f90
View File

@ -1,6 +1,7 @@
subroutine unpack77(c77,msg) subroutine unpack77(c77,msg)
parameter (NSEC=84) !Number of ARRL Sections parameter (NSEC=84) !Number of ARRL Sections
integer ntel(3)
character*77 c77 character*77 c77
character*37 msg character*37 msg
character*13 call_1,call_2,call_3 character*13 call_1,call_2,call_3
@ -69,7 +70,7 @@ subroutine unpack77(c77,msg)
else if(i3.eq.0 .and. (n3.eq.3 .or. n3.eq.4)) then else if(i3.eq.0 .and. (n3.eq.3 .or. n3.eq.4)) then
! 0.3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day ! 0.3 WA9XYZ KA1ABC R 16A EMA 28 28 1 4 3 7 71 ARRL Field Day
! 0.4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day ! 0.4 WA9XYZ KA1ABC R 32A EMA 28 28 1 4 3 7 71 ARRL Field Day
read(c77,1030) n28a,n28b,ir,intx,nclass,isec read(c77,1030) n28a,n28b,ir,intx,nclass,isec
1030 format(2b28,b1,b4,b3,b7) 1030 format(2b28,b1,b4,b3,b7)
call unpack28(n28a,call_1) call unpack28(n28a,call_1)
@ -87,6 +88,20 @@ subroutine unpack77(c77,msg)
' '//cntx//' '//csec(isec) ' '//cntx//' '//csec(isec)
if(ir.eq.1 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// & if(ir.eq.1 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// &
' R '//cntx//' '//csec(isec) ' R '//cntx//' '//csec(isec)
else if(i3.eq.0 .and. n3.eq.5) then
! 0.5 0123456789abcdef01 71 71 Telemetry (18 hex)
read(c77,1006) ntel
1006 format(b23,2b24)
write(msg,1007) ntel
1007 format(3z6.6)
else if(i3.eq.1 .or. i3.eq.3) then
read(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3
1000 format(2(b28,b1),b1,b15,b3)
call unpack28(n28a,call_1)
call unpack28(n28b,call_2)
print*,call_1,call_2,ipa,ipb,ir,igrid4,i3
endif endif
return return