From 796f5e865f4b9f3185fee9c27790f500bbfd0be2 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Sun, 29 Jul 2018 16:34:21 -0400 Subject: [PATCH] Fix a flw in handling i3=4 messages; export n28a_77 and n28b_77. --- lib/77bit/encode77.f90 | 26 ++++++++++------- lib/77bit/messages.txt | 6 ++++ lib/77bit/packjt77.f90 | 63 +++++++++++++++++++++++------------------- 3 files changed, 56 insertions(+), 39 deletions(-) diff --git a/lib/77bit/encode77.f90 b/lib/77bit/encode77.f90 index d52078c12..cf013a34f 100644 --- a/lib/77bit/encode77.f90 +++ b/lib/77bit/encode77.f90 @@ -5,20 +5,26 @@ program encode77 character*80 msg0 character msg*37,cerr*1 character*77 c77 + character*80 infile nargs=iargc() - open(10,file='messages.txt',status='old') + if(nargs.ne.1 .and.nargs.ne.2) then + print*,'Usage: encode77 "message"' + print*,' encode77 -f ' + go to 999 + endif + call getarg(1,msg0) + if(nargs.eq.2) then + call getarg(2,infile) + open(10,file=infile,status='old') + write(*,1000) +1000 format('i3.n3 Err Message to be encoded Decoded message' & + /80('-')) + endif do iline=1,999 - if(nargs.eq.1) then - call getarg(1,msg0) - else - if(iline.eq.1) write(*,1000) -1000 format('i3.n3 Err Message to be encoded Decoded message'/ & - 80('-')) - read(10,1002,end=999) msg0 -1002 format(a80) - endif + if(nargs.eq.2) read(10,1002,end=999) msg0 +1002 format(a80) if(msg0(1:1).eq.'$') exit if(msg0.eq.' ') cycle if(msg0(2:2).eq.'.' .or. msg0(3:3).eq.'.') cycle diff --git a/lib/77bit/messages.txt b/lib/77bit/messages.txt index dc7cbb84d..00c3b73c4 100644 --- a/lib/77bit/messages.txt +++ b/lib/77bit/messages.txt @@ -67,4 +67,10 @@ W9XYZ RRR ----------------------------------------------------------- TNX BOB 73 GL free text msg +CQ YW18FIFA + KA1ABC +KA1ABC -11 + KA1ABC R-17 + YW1FIFA RR73 + KA1ABC 73 123456789ABCD diff --git a/lib/77bit/packjt77.f90 b/lib/77bit/packjt77.f90 index 91faee50c..d22f7cd9d 100644 --- a/lib/77bit/packjt77.f90 +++ b/lib/77bit/packjt77.f90 @@ -1,5 +1,8 @@ module packjt77 +! These variables are accessible from outside via "use packjt": + integer n28a_77,n28b_77 + contains subroutine hash10(n10,c13) @@ -242,14 +245,14 @@ subroutine unpack77(c77,msg) else if(i3.eq.0 .and. n3.eq.1) then ! 0.1 K1ABC RR73; W9XYZ -11 28 28 10 5 71 DXpedition Mode - read(c77,1010) n28a,n28b,n10,n5 + read(c77,1010) n28a_77,n28b_77,n10,n5 1010 format(2b28,b10,b5) irpt=2*n5 - 30 write(crpt,1012) irpt 1012 format(i3.2) if(irpt.ge.0) crpt(1:1)='+' - call unpack28(n28a,call_1) - call unpack28(n28b,call_2) + call unpack28(n28a_77,call_1) + call unpack28(n28b_77,call_2) call hash10(n10,call_3) if(call_3(1:1).eq.'<') then msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)// & @@ -260,9 +263,9 @@ subroutine unpack77(c77,msg) endif else if(i3.eq.0 .and. n3.eq.2) then ! 0.2 PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest - read(c77,1020) n28a,ip,ir,irpt,iserial,igrid6 + read(c77,1020) n28a_77,ip,ir,irpt,iserial,igrid6 1020 format(b28,2b1,b3,b12,b25) - call unpack28(n28a,call_1) + call unpack28(n28a_77,call_1) nrs=52+irpt if(ip.eq.1) call_1=trim(call_1)//'/P'//' ' write(cexch,1022) nrs,iserial @@ -290,11 +293,11 @@ 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 - read(c77,1030) n28a,n28b,ir,intx,nclass,isec + read(c77,1030) n28a_77,n28b_77,ir,intx,nclass,isec 1030 format(2b28,b1,b4,b3,b7) if(isec.gt.NSEC) isec=NSEC !### Check range for other params? ### - call unpack28(n28a,call_1) - call unpack28(n28b,call_2) + call unpack28(n28a_77,call_1) + call unpack28(n28b_77,call_2) ntx=intx+1 if(n3.eq.4) ntx=ntx+16 write(cntx(1:2),1032) ntx @@ -323,10 +326,10 @@ subroutine unpack77(c77,msg) else if(i3.eq.1 .or. i3.eq.2) then ! Type 1 (standard message) or Type 2 ("/P" form for EU VHF contest) - read(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3 + read(c77,1000) n28a_77,ipa,n28b_77,ipb,ir,igrid4,i3 1000 format(2(b28,b1),b1,b15,b3) - call unpack28(n28a,call_1) - call unpack28(n28b,call_2) + call unpack28(n28a_77,call_1) + call unpack28(n28b_77,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' @@ -365,7 +368,7 @@ subroutine unpack77(c77,msg) else if(i3.eq.3) then ! Type 3: ARRL RTTY Contest - read(c77,1040) itu,n28a,n28b,ir,irpt,nexch,i3 + read(c77,1040) itu,n28a_77,n28b_77,ir,irpt,nexch,i3 1040 format(b1,2b28.28,b1,b3.3,b13.13,b3.3) write(crpt,1042) irpt+2 1042 format('5',i1,'9') @@ -375,8 +378,8 @@ subroutine unpack77(c77,msg) imult=nexch-8000 nserial=-1 endif - call unpack28(n28a,call_1) - call unpack28(n28b,call_2) + call unpack28(n28a_77,call_1) + call unpack28(n28b_77,call_2) imult=0 nserial=0 if(nexch.gt.8000) imult=nexch-8000 @@ -713,10 +716,10 @@ subroutine pack77_01(nwords,w,i3,n3,c77) ! Type 0.1: K1ABC RR73; W9XYZ -11 28 28 10 5 71 DXpedition Mode i3=0 n3=1 - call pack28(w(1),n28a) - call pack28(w(3),n28b) + call pack28(w(1),n28a_77) + call pack28(w(3),n28b_77) call save_hash_call(w(4),n10,n12,n22) - write(c77,1010) n28a,n28b,n10,n5,n3,i3 + write(c77,1010) n28a_77,n28b_77,n10,n5,n3,i3 1010 format(2b28.28,b10.10,b5.5,2b3.3) 900 return @@ -756,7 +759,7 @@ subroutine pack77_02(nwords,w,i3,n3,c77) ip=1 c13=w(1)(1:i-1)//' ' endif - call pack28(c13,n28a) + call pack28(c13,n28a_77) ir=0 if(w(2)(1:2).eq.'R ') ir=1 irpt=nx/10000 - 52 @@ -769,7 +772,7 @@ subroutine pack77_02(nwords,w,i3,n3,c77) j5=(ichar(grid6(5:5))-ichar('A'))*24 j6=(ichar(grid6(6:6))-ichar('A')) igrid6=j1+j2+j3+j4+j5+j6 - write(c77,1010) n28a,ip,ir,irpt,iserial,igrid6,n3,i3 + write(c77,1010) n28a_77,ip,ir,irpt,iserial,igrid6,n3,i3 1010 format(b28.28,2b1,b3.3,b12.12,b25.25,b4.4,b3.3) return @@ -829,11 +832,11 @@ subroutine pack77_03(nwords,w,i3,n3,c77) n3=4 !Type 0.4 ARRL Field Day intx=ntx-17 endif - call pack28(w(1),n28a) - call pack28(w(2),n28b) + call pack28(w(1),n28a_77) + call pack28(w(2),n28b_77) ir=0 if(w(3)(1:2).eq.'R ') ir=1 - write(c77,1010) n28a,n28b,ir,intx,nclass,isec,n3,i3 + write(c77,1010) n28a_77,n28b_77,ir,intx,nclass,isec,n3,i3 1010 format(2b28.28,b1,b4.4,b3.3,b7.7,2b3.3) return @@ -903,10 +906,10 @@ subroutine pack77_1(nwords,w,i3,n3,c77) endif c13=bcall_1//' ' if(c13(1:3).eq.'CQ_' .or. w(1)(1:1).eq.'<') c13=w(1) - call pack28(c13,n28a) + call pack28(c13,n28a_77) c13=bcall_2//' ' if(w(2)(1:1).eq.'<') c13=w(2) - call pack28(c13,n28b) + call pack28(c13,n28b_77) ipa=0 ipb=0 if(index(w(1),'/P').ge.4 .or. index(w(1),'/R').ge.4) ipa=1 @@ -929,7 +932,7 @@ subroutine pack77_1(nwords,w,i3,n3,c77) irpt=1 igrid4=MAXGRID4+irpt endif - write(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3 + write(c77,1000) n28a_77,ipa,n28b_77,ipb,ir,igrid4,i3 1000 format(2(b28.28,b1),b1,b15.15,b3.3) return @@ -988,8 +991,8 @@ subroutine pack77_3(nwords,w,i3,n3,c77) n3=0 itu=0 if(trim(w(1)).eq.'TU;') itu=1 - call pack28(w(1+itu),n28a) - call pack28(w(2+itu),n28b) + call pack28(w(1+itu),n28a_77) + call pack28(w(2+itu),n28b_77) ir=0 if(w(3+itu)(1:2).eq.'R ') ir=1 read(w(3+itu+ir),*) irpt @@ -998,7 +1001,7 @@ subroutine pack77_3(nwords,w,i3,n3,c77) if(irpt.gt.7) irpt=7 ! 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) - write(c77,1010) itu,n28a,n28b,ir,irpt,nexch,i3 + write(c77,1010) itu,n28a_77,n28b_77,ir,irpt,nexch,i3 1010 format(b1,2b28.28,b1,b3.3,b13.13,b3.3) endif endif @@ -1027,11 +1030,11 @@ subroutine pack77_4(nwords,w,i3,n3,c77) if(call_2(1:1).eq.'<') call_2=w(2)(2:len(trim(w(2)))-1) call chkcall(call_1,bcall_1,ok1) call chkcall(call_2,bcall_2,ok2) + icq=0 if(trim(w(1)).eq.'CQ' .or. (ok1.and.ok2)) then if(trim(w(1)).eq.'CQ' .and. len(trim(w(2))).le.4) go to 900 i3=4 n3=0 - icq=0 if(trim(w(1)).eq.'CQ') icq=1 endif @@ -1042,10 +1045,12 @@ subroutine pack77_4(nwords,w,i3,n3,c77) call save_hash_call(w(2),n10,n12,n22) else if(w(1)(1:1).eq.'<') then iflip=0 + i3=4 call save_hash_call(w(1),n10,n12,n22) c11=adjustr(call_2(1:11)) else if(w(2)(1:1).eq.'<') then iflip=1 + i3=4 call save_hash_call(w(2),n10,n12,n22) c11=adjustr(call_1(1:11)) endif