From 617b0bffc8c8814a9d144ffa8bd424496cd58d3d Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Wed, 27 Jun 2018 16:41:58 -0400 Subject: [PATCH] Nearly finished with pack77/unpack77. --- lib/77bit/CQ_messages.txt | 12 +++++++++++ lib/77bit/encode77.f90 | 22 ++++++++------------ lib/77bit/messages.txt | 36 ++++++++++++++++++++++++++++++++ lib/77bit/msgtypes.txt | 1 + lib/77bit/pack77.f90 | 3 ++- lib/77bit/pack77_1.f90 | 38 ++++++++++++++++++++++++++-------- lib/77bit/pack77_4.f90 | 2 +- lib/77bit/split77.f90 | 14 +++++++++++-- lib/77bit/unpack28.f90 | 1 + lib/77bit/unpack77.f90 | 43 ++++++++++++++++++++++++++------------- 10 files changed, 133 insertions(+), 39 deletions(-) create mode 100644 lib/77bit/CQ_messages.txt create mode 100644 lib/77bit/messages.txt diff --git a/lib/77bit/CQ_messages.txt b/lib/77bit/CQ_messages.txt new file mode 100644 index 000000000..f131f9fb5 --- /dev/null +++ b/lib/77bit/CQ_messages.txt @@ -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 diff --git a/lib/77bit/encode77.f90 b/lib/77bit/encode77.f90 index fad8e12df..dc24308ac 100644 --- a/lib/77bit/encode77.f90 +++ b/lib/77bit/encode77.f90 @@ -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 diff --git a/lib/77bit/messages.txt b/lib/77bit/messages.txt new file mode 100644 index 000000000..69af60dd7 --- /dev/null +++ b/lib/77bit/messages.txt @@ -0,0 +1,36 @@ +FREE TEXT MSG 71 0 71 +K1ABC RR73; W9XYZ -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) + PJ4/KA1ABC 13 58 1 2 74 Nonstandard call +PJ4/KA1ABC RRR 13 58 1 2 74 Nonstandard call + PJ4/KA1ABC RR73 13 58 1 2 74 Nonstandard call +PJ4/KA1ABC 73 13 58 1 2 74 Nonstandard call + 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 diff --git a/lib/77bit/msgtypes.txt b/lib/77bit/msgtypes.txt index dc1568f40..61a44da29 100644 --- a/lib/77bit/msgtypes.txt +++ b/lib/77bit/msgtypes.txt @@ -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) diff --git a/lib/77bit/pack77.f90 b/lib/77bit/pack77.f90 index d0996c68e..12bc087c1 100644 --- a/lib/77bit/pack77.f90 +++ b/lib/77bit/pack77.f90 @@ -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) diff --git a/lib/77bit/pack77_1.f90 b/lib/77bit/pack77_1.f90 index f36295930..09996cc16 100644 --- a/lib/77bit/pack77_1.f90 +++ b/lib/77bit/pack77_1.f90 @@ -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 diff --git a/lib/77bit/pack77_4.f90 b/lib/77bit/pack77_4.f90 index 798dd6983..5b853508e 100644 --- a/lib/77bit/pack77_4.f90 +++ b/lib/77bit/pack77_4.f90 @@ -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 diff --git a/lib/77bit/split77.f90 b/lib/77bit/split77.f90 index 430466d0d..2b11d8a88 100644 --- a/lib/77bit/split77.f90 +++ b/lib/77bit/split77.f90 @@ -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 diff --git a/lib/77bit/unpack28.f90 b/lib/77bit/unpack28.f90 index c095ae847..45ea9767d 100644 --- a/lib/77bit/unpack28.f90 +++ b/lib/77bit/unpack28.f90 @@ -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) diff --git a/lib/77bit/unpack77.f90 b/lib/77bit/unpack77.f90 index 4d497f57b..d3ed8e5f3 100644 --- a/lib/77bit/unpack77.f90 +++ b/lib/77bit/unpack77.f90 @@ -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