diff --git a/lib/77bit/chk77_1.f90 b/lib/77bit/chk77_1.f90 deleted file mode 100644 index 946b2070e..000000000 --- a/lib/77bit/chk77_1.f90 +++ /dev/null @@ -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 diff --git a/lib/77bit/encode77.f90 b/lib/77bit/encode77.f90 index a7ad06388..06ddd2e3b 100644 --- a/lib/77bit/encode77.f90 +++ b/lib/77bit/encode77.f90 @@ -13,7 +13,9 @@ program encode77 do iline=1,999 read(10,1002,end=999) i3a,n3a,msg0 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 unpack77(c77,msg) cerr=' ' @@ -33,7 +35,7 @@ include 'split77.f90' include 'pack77_01.f90' include 'pack77_02.f90' include 'pack77_03.f90' -include 'chk77_1.f90' +include 'pack77_1.f90' include 'chk77_2.f90' include 'chk77_3.f90' include 'packtext77.f90' diff --git a/lib/77bit/msgtypes.txt b/lib/77bit/msgtypes.txt index 53aff5411..e661babf2 100644 --- a/lib/77bit/msgtypes.txt +++ b/lib/77bit/msgtypes.txt @@ -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 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 5 0123456789ABCDEF01 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 PJ4/KA1ABC R-11 13 53 1 1 6 74 Nonstandard calls diff --git a/lib/77bit/pack77.f90 b/lib/77bit/pack77.f90 index 65d164f1a..c119db515 100644 --- a/lib/77bit/pack77.f90 +++ b/lib/77bit/pack77.f90 @@ -6,12 +6,15 @@ subroutine pack77(msg,i3,n3,c77) character*13 w(19) character*77 c77 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. call split77(msg,nwords,nw,w) i3=-1 n3=-1 - + ! Check 0.1 (DXpedition mode) call pack77_01(nwords,w,i3,n3,c77) if(i3.ge.0) go to 900 @@ -22,10 +25,23 @@ subroutine pack77(msg,i3,n3,c77) ! Check 0.3 and 0.4 (ARRL Field Day exchange) call pack77_03(nwords,w,i3,n3,c77) 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)) - call chk77_1(nwords,w,i3,n3) + call pack77_1(nwords,w,i3,n3,c77) if(i3.ge.0) go to 900 ! Check Type 2 (ARRL RTTY contest exchange) diff --git a/lib/77bit/pack77_03.f90 b/lib/77bit/pack77_03.f90 index cc76c1d7d..de5e0c7ee 100644 --- a/lib/77bit/pack77_03.f90 +++ b/lib/77bit/pack77_03.f90 @@ -49,7 +49,7 @@ subroutine pack77_03(nwords,w,i3,n3,c77) intx=ntx-1 if(intx.ge.16) then n3=4 !Type 0.4 ARRL Field Day - intx=ntx-16 + intx=ntx-17 endif call pack28(w(1),n28a) call pack28(w(2),n28b) diff --git a/lib/77bit/pack77_1.f90 b/lib/77bit/pack77_1.f90 new file mode 100644 index 000000000..90ae28de7 --- /dev/null +++ b/lib/77bit/pack77_1.f90 @@ -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 diff --git a/lib/77bit/unpack77.f90 b/lib/77bit/unpack77.f90 index f290192b3..e674e5a71 100644 --- a/lib/77bit/unpack77.f90 +++ b/lib/77bit/unpack77.f90 @@ -1,6 +1,7 @@ subroutine unpack77(c77,msg) parameter (NSEC=84) !Number of ARRL Sections + integer ntel(3) character*77 c77 character*37 msg 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 ! 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 1030 format(2b28,b1,b4,b3,b7) call unpack28(n28a,call_1) @@ -87,6 +88,20 @@ subroutine unpack77(c77,msg) ' '//cntx//' '//csec(isec) if(ir.eq.1 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// & ' 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 return