From 9d5a2e6f5a4ae07761c59b4c0a728e7100928e25 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Tue, 26 Jun 2018 15:20:39 -0400 Subject: [PATCH] Through type 0.3. --- lib/77bit/encode77.f90 | 30 ++++-- lib/77bit/g2 | 7 +- lib/77bit/msgtypes.txt | 2 +- lib/77bit/pack28.f90 | 24 +++-- lib/77bit/pack77.f90 | 6 +- lib/77bit/pack77_01.f90 | 14 ++- lib/77bit/pack77_02.f90 | 45 +++++++-- lib/77bit/pack77_03.f90 | 66 +++++++++----- lib/77bit/parse77.f90 | 197 ---------------------------------------- lib/77bit/unpack28.f90 | 44 +++++---- lib/77bit/unpack77.f90 | 81 +++++++++++++++-- 11 files changed, 229 insertions(+), 287 deletions(-) delete mode 100644 lib/77bit/parse77.f90 diff --git a/lib/77bit/encode77.f90 b/lib/77bit/encode77.f90 index 7d42e57e9..a7ad06388 100644 --- a/lib/77bit/encode77.f90 +++ b/lib/77bit/encode77.f90 @@ -1,6 +1,7 @@ -program t2 +program encode77 character msg*37,msg0*37,cerr*1 + character*77 c77 open(10,file='msgtypes.txt',status='old') @@ -10,17 +11,30 @@ program t2 1001 format(a1) do iline=1,999 - read(10,1002,end=999) i3,n3,msg + read(10,1002,end=999) i3a,n3a,msg0 1002 format(i1,i4,1x,a37) - msg0=msg - call parse77(msg,i3a,n3a) + if(i3a.gt.0 .or. n3a.gt.3) 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='*' - write(*,1004) i3,n3,i3a,n3a,cerr,msg -1004 format(i1,3i3,2x,a1,2x,a37) + write(*,1004) i3,n3,cerr,msg0,msg +1004 format(i1,'.',i1,1x,a1,1x,a37,1x,a37) enddo -999 end program t2 +999 end program encode77 -include 'parse77.f90' include '../chkcall.f90' +include 'pack77.f90' +include 'unpack77.f90' +include 'pack28.f90' +include 'unpack28.f90' +include 'split77.f90' +include 'pack77_01.f90' +include 'pack77_02.f90' +include 'pack77_03.f90' +include 'chk77_1.f90' +include 'chk77_2.f90' +include 'chk77_3.f90' +include 'packtext77.f90' +include 'unpacktext77.f90' diff --git a/lib/77bit/g2 b/lib/77bit/g2 index ca59617ec..d4d6f2073 100644 --- a/lib/77bit/g2 +++ b/lib/77bit/g2 @@ -1,4 +1,5 @@ gfortran -c ../packjt.f90 -gfortran -o t2 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant t2.f90 \ - ../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \ - ../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 packjt.o +gfortran -o encode77 -fbounds-check -Wall -Wno-conversion -Wno-real-q-constant \ + encode77.f90 ../deg2grid.f90 ../grid2deg.f90 ../fix_contest_msg.f90 \ + ../to_contest_msg.f90 ../fmtmsg.f90 ../azdist.f90 ../geodist.f90 \ + ihashcall.f90 hash10.f90 packjt.o diff --git a/lib/77bit/msgtypes.txt b/lib/77bit/msgtypes.txt index e140eaef2..53aff5411 100644 --- a/lib/77bit/msgtypes.txt +++ b/lib/77bit/msgtypes.txt @@ -1,7 +1,7 @@ i3 n3 -------------------------------------------------------------------------------------- 0 0 FREE TEXT MSG 71 0 71 -0 1 K1ABC RR73; W9XYZ -11 28 28 10 5 1 71 DXpedition Mode +0 1 K1ABC RR73; W9XYZ -12 28 28 10 5 1 71 DXpedition Mode 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 diff --git a/lib/77bit/pack28.f90 b/lib/77bit/pack28.f90 index 329606c53..7146af560 100644 --- a/lib/77bit/pack28.f90 +++ b/lib/77bit/pack28.f90 @@ -47,14 +47,22 @@ subroutine pack28(c13,n28) ! We have a standard callsign n=len(trim(callsign)) callsign=adjustr(callsign) - n28=index(c1,callsign(1:1))-1 - n28=n28*nc(2) + index(c2,callsign(2:2)) - 1 - n28=n28*nc(3) + index(c3,callsign(3:3)) - 1 - n28=n28*nc(4) + index(c4,callsign(4:4)) - 1 - n28=n28*nc(5) + index(c4,callsign(5:5)) - 1 - n28=n28*nc(6) + index(c4,callsign(6:6)) - 1 - n28=n28 + NTOKENS + N24 - + i1=36*10*27*27*27*(index(c1,callsign(1:1))-1) + i2=10*27*27*27*(index(c2,callsign(2:2))-1) + i3=27*27*27*(index(c3,callsign(3:3))-1) + i4=27*27*(index(c4,callsign(4:4))-1) + i5=27*(index(c4,callsign(5:5))-1) + i6=index(c4,callsign(6:6))-1 + n28=i1+i2+i3+i4+i5+i6 + +! n28=index(c1,callsign(1:1))-1 +! n28=n28*nc(2) + index(c2,callsign(2:2)) - 1 +! n28=n28*nc(3) + index(c3,callsign(3:3)) - 1 +! n28=n28*nc(4) + index(c4,callsign(4:4)) - 1 +! n28=n28*nc(5) + index(c4,callsign(5:5)) - 1 +! n28=n28*nc(6) + index(c4,callsign(6:6)) - 1 + n28=n28 + NTOKENS + N24 + return end subroutine pack28 diff --git a/lib/77bit/pack77.f90 b/lib/77bit/pack77.f90 index 175747fb6..65d164f1a 100644 --- a/lib/77bit/pack77.f90 +++ b/lib/77bit/pack77.f90 @@ -15,13 +15,12 @@ subroutine pack77(msg,i3,n3,c77) ! Check 0.1 (DXpedition mode) call pack77_01(nwords,w,i3,n3,c77) if(i3.ge.0) go to 900 - ! Check 0.2 (EU VHF contest exchange) - call chk77_02(nwords,w,i3,n3) + call pack77_02(nwords,w,i3,n3,c77) if(i3.ge.0) go to 900 ! Check 0.3 and 0.4 (ARRL Field Day exchange) - call chk77_03(nwords,w,i3,n3) + call pack77_03(nwords,w,i3,n3,c77) if(i3.ge.0) go to 900 @@ -45,7 +44,6 @@ subroutine pack77(msg,i3,n3,c77) write(c77(72:77),'(2b3.3)') n3,i3 900 continue -! print*,'B: ',c77 return end subroutine pack77 diff --git a/lib/77bit/pack77_01.f90 b/lib/77bit/pack77_01.f90 index f71616c25..f9c766cbf 100644 --- a/lib/77bit/pack77_01.f90 +++ b/lib/77bit/pack77_01.f90 @@ -3,10 +3,11 @@ subroutine pack77_01(nwords,w,i3,n3,c77) ! Pack a Type 0.1 message: DXpedition mode ! Example message: "K1ABC RR73; W9XYZ -11" 28 28 10 5 - character*13 w(19) + character*13 w(19),chash(20) character*77 c77 character*6 bcall_1,bcall_2 logical ok1,ok2 + common/hashcom/ihash10(20),chash if(nwords.ne.5) return !Must have 5 words if(trim(w(2)).ne.'RR73;') return !2nd word must be "RR73;" @@ -14,19 +15,22 @@ subroutine pack77_01(nwords,w,i3,n3,c77) if(index(w(4),'>').lt.1) return n=-99 read(w(5),*,err=1) n -1 if(n.lt.-30 .or. n.gt.30) return !5th word must be a valid report +1 if(n.eq.-99) return !5th word must be a valid report + n5=(n+30)/2 + if(n5.lt.0) n5=0 + if(n5.gt.31) n5=31 call chkcall(w(1),bcall_1,ok1) if(.not.ok1) return !1st word must be a valid basecall call chkcall(w(3),bcall_2,ok2) if(.not.ok2) return !3rd word must be a valid basecall -! It's a Type 0.1 message +! 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) - n10=0 - n5=17 + n10=ihashcall(w(4),10) !Get the 10-bit hash code + call hash10(n10,w(4),0) !Save this hash and its callsign write(c77,1010) n28a,n28b,n10,n5,n3,i3 1010 format(2b28.28,b10.10,b5.5,2b3.3) diff --git a/lib/77bit/pack77_02.f90 b/lib/77bit/pack77_02.f90 index 92e96746d..dd8af8c78 100644 --- a/lib/77bit/pack77_02.f90 +++ b/lib/77bit/pack77_02.f90 @@ -1,6 +1,7 @@ -subroutine chk77_02(nwords,w,i3,n3) +subroutine pack77_02(nwords,w,i3,n3,c77) - character*13 w(19) + character*13 w(19),c13 + character*77 c77 character*6 bcall_1,grid6 logical ok1,is_grid6 @@ -13,14 +14,38 @@ subroutine chk77_02(nwords,w,i3,n3) grid6(6:6).ge.'A' .and. grid6(6:6).le.'X' call chkcall(w(1),bcall_1,ok1) - if(nwords.eq.3 .or. nwords.eq.4) then - n=-1 - if(nwords.ge.2) read(w(nwords-1),*,err=2) n -2 if(ok1 .and. n.ge.520001 .and. n.le.594095 .and. is_grid6(w(nwords)(1:6))) then - i3=0 - n3=2 !Type 0.2: EU VHF+ Contest - endif + if(.not.ok1) return !bcall_1 must be a valid basecall + if(nwords.lt.3 .or. nwords.gt.4) return !nwords must be 3 or 4 + nx=-1 + if(nwords.ge.2) read(w(nwords-1),*,err=2) nx +2 if(nx.lt.520001 .or. nx.gt.594095) return !Exchange between 520001 - 594095 + if(.not.is_grid6(w(nwords)(1:6))) return !Last word must be a valid grid6 + +! Type 0.2: PA3XYZ/P R 590003 IO91NP 28 1 1 3 12 25 70 EU VHF contest + i3=0 + n3=2 + ip=0 + c13=w(1) + i=index(w(1),'/P') + if(i.ge.4) then + ip=1 + c13=w(1)(1:i-1)//' ' endif + call pack28(c13,n28a) + ir=0 + if(w(2)(1:2).eq.'R ') ir=1 + irpt=nx/10000 - 52 + iserial=mod(nx,10000) + grid6=w(nwords)(1:6) + j1=(ichar(grid6(1:1))-ichar('A'))*18*10*10*24*24 + j2=(ichar(grid6(2:2))-ichar('A'))*10*10*24*24 + j3=(ichar(grid6(3:3))-ichar('0'))*10*24*24 + j4=(ichar(grid6(4:4))-ichar('0'))*24*24 + 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 +1010 format(b28.28,2b1,b3.3,b12.12,b25.25,b4.4,b3.3) return -end subroutine chk77_02 +end subroutine pack77_02 diff --git a/lib/77bit/pack77_03.f90 b/lib/77bit/pack77_03.f90 index b1b2a6c19..cc76c1d7d 100644 --- a/lib/77bit/pack77_03.f90 +++ b/lib/77bit/pack77_03.f90 @@ -1,12 +1,12 @@ -subroutine chk77_03(nwords,w,i3,n3) +subroutine pack77_03(nwords,w,i3,n3,c77) ! Check 0.3 and 0.4 (ARRL Field Day exchange) - parameter (NSEC=83) !Number of ARRL Sections + parameter (NSEC=84) !Number of ARRL Sections character*13 w(19) + character*77 c77 character*6 bcall_1,bcall_2 - character*3 csec(NSEC),section + character*3 csec(NSEC) logical ok1,ok2 - data csec/ & "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", & "EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", & @@ -16,31 +16,47 @@ subroutine chk77_03(nwords,w,i3,n3) "ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", & "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", & "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", & - "WV ","WWA","WY "/ - + "WV ","WWA","WY ","DX "/ + + if(nwords.lt.4 .or. nwords.gt.5) return call chkcall(w(1),bcall_1,ok1) call chkcall(w(2),bcall_2,ok2) + if(.not.ok1 .or. .not.ok2) return - if(nwords.eq.4 .or. nwords.eq.5) then - n=-1 - j=len(trim(w(nwords-1)))-1 - if(j.ge.2) read(w(nwords-1)(1:j),*,err=4) n !Number of transmitters -4 m=len(trim(w(nwords))) !Length of section abbreviation - if(ok1 .and. ok2 .and. n.ge.1 .and. n.le.32 .and. (m.eq.2 .or. m.eq.3)) then - section=' ' - do i=1,NSEC - if(csec(i).eq.w(nwords)) then - section=csec(i) - exit - endif - enddo - if(section.ne.' ') then - i3=0 - if(n.ge.1 .and. n.le.16) n3=3 !Type 0.3 ARRL Field Day - if(n.ge.17 .and. n.le.32) n3=4 !Type 0.4 ARRL Field Day - endif + ntx=-1 + j=len(trim(w(nwords-1)))-1 + if(j.ge.2) read(w(nwords-1)(1:j),*,err=1) ntx !Number of transmitters +1 if(ntx.lt.1 .or. ntx.gt.32) return + nclass=ichar(w(nwords-1)(j+1:j+1))-ichar('A') + + m=len(trim(w(nwords))) !Length of section abbreviation + if(m.lt.2 .or. m.gt.3) return + + isec=-1 + do i=1,NSEC + if(csec(i).eq.w(nwords)) then + isec=i + exit endif + enddo + if(isec.eq.-1) return + +! 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 + + i3=0 + n3=3 !Type 0.3 ARRL Field Day + intx=ntx-1 + if(intx.ge.16) then + n3=4 !Type 0.4 ARRL Field Day + intx=ntx-16 endif + call pack28(w(1),n28a) + call pack28(w(2),n28b) + ir=0 + if(w(3)(1:2).eq.'R ') ir=1 + write(c77,1010) n28a,n28b,ir,intx,nclass,isec,n3,i3 +1010 format(2b28.28,b1,b4.4,b3.3,b7.7,2b3.3) return -end subroutine chk77_03 +end subroutine pack77_03 diff --git a/lib/77bit/parse77.f90 b/lib/77bit/parse77.f90 deleted file mode 100644 index 6f86055be..000000000 --- a/lib/77bit/parse77.f90 +++ /dev/null @@ -1,197 +0,0 @@ -subroutine parse77(msg,i3,n3) - - use packjt - parameter (NSEC=83) !Number of ARRL Sections - parameter (NUSCAN=65) !Number of US states and Canadian provinces/territories - character*37 msg - character*22 msg22 - character*13 w(19),c13 - character*13 call_1,call_2 - character*6 bcall_1,bcall_2,grid6 - character*4 grid4 - character crpt*3,crrpt*4 - character*77 c77bit - character*1 c,c0 - character*3 csec(NSEC),cmult(NUSCAN),section,mult - logical ok1,ok2,text1,text2 - logical is_grid4,is_grid6 - - data csec/ & - "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", & - "EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", & - "KS ","KY ","LA ","LAX","MAR","MB ","MDC","ME ","MI ","MN ", & - "MO ","MS ","MT ","NC ","ND ","NE ","NFL","NH ","NL ","NLI", & - "NM ","NNJ","NNY","NT ","NTX","NV ","OH ","OK ","ONE","ONN", & - "ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", & - "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", & - "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", & - "WV ","WWA","WY "/ - - data cmult/ & - "AL ","AK ","AZ ","AR ","CA ","CO ","CT ","DE ","FL ","GA ", & - "HI ","ID ","IL ","IN ","IA ","KS ","KY ","LA ","ME ","MD ", & - "MA ","MI ","MN ","MS ","MO ","MT ","NE ","NV ","NH ","NJ ", & - "NM ","NY ","NC ","ND ","OH ","OK ","OR ","PA ","RI ","SC ", & - "SD ","TN ","TX ","UT ","VT ","VA ","WA ","WV ","WI ","WY ", & - "NB ","NS ","QC ","ON ","MB ","SK ","AB ","BC ","NWT","NF ", & - "LB ","NU ","VT ","PEI","DC "/ - - 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' - - is_grid6(grid6)=len(trim(grid6)).eq.6 .and. & - grid6(1:1).ge.'A' .and. grid6(1:1).le.'R' .and. & - grid6(2:2).ge.'A' .and. grid6(2:2).le.'R' .and. & - grid6(3:3).ge.'0' .and. grid6(3:3).le.'9' .and. & - grid6(4:4).ge.'0' .and. grid6(4:4).le.'9' .and. & - grid6(5:5).ge.'A' .and. grid6(5:5).le.'X' .and. & - grid6(6:6).ge.'A' .and. grid6(6:6).le.'X' - - iz=len(trim(msg)) -! Convert to upper case; parse into words. - j=0 - k=0 - n=0 - c0=' ' - w=' ' - do i=1,iz - c=msg(i:i) !Single character - if(c.eq.' ' .and. c0.eq.' ') cycle !Skip over leading or repeated blanks - if(c.ne.' ' .and. c0.eq.' ') then - k=k+1 !New word - n=0 - endif - j=j+1 !Index in msg - 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 - c0=c - enddo - iz=j !Message length - nw=k !Number of words in msg - msg(iz+1:)=' ' - -! Check 0.1 (DXpedition mode) - i3=0 - n3=0 - i0=index(msg," RR73; ") - call chkcall(w(1)(1:12),bcall_1,ok1) - call chkcall(w(3)(1:12),bcall_2,ok2) - - if(i0.ge.4 .and. i0.le.7 .and. nw.eq.5 .and. ok1 .and. ok2) then - i0=0 - n3=1 !Type 0.1: DXpedition mode - go to 900 - endif - -! Check 0.2 (EU VHF contest exchange) - if(nw.eq.3 .or. nw.eq.4) then - n=-1 - if(nw.ge.2) read(w(nw-1),*,err=2) n -2 if(ok1 .and. n.ge.520001 .and. n.le.594095 .and. is_grid6(w(nw)(1:6))) then - i3=0 - n3=2 !Type 0.2: EU VHF+ Contest - go to 900 - endif - endif - - call chkcall(w(2)(1:12),bcall_2,ok2) - -! Check 0.3 and 0.4 (ARRL Field Day exchange) - if(nw.eq.4 .or. nw.eq.5) then - n=-1 - j=len(trim(w(nw-1)))-1 - if(j.ge.2) read(w(nw-1)(1:j),*,err=4) n !Number of transmitters -4 m=len(trim(w(nw))) !Length of section abbreviation - if(ok1 .and. ok2 .and. n.ge.1 .and. n.le.32 .and. (m.eq.2 .or. m.eq.3)) then - section=' ' - do i=1,NSEC - if(csec(i).eq.w(nw)) then - section=csec(i) - exit - endif - enddo - if(section.ne.' ') then - i3=0 - if(n.ge.1 .and. n.le.16) n3=3 !Type 0.3 ARRL Field Day - if(n.ge.17 .and. n.le.32) n3=4 !Type 0.4 ARRL Field Day - go to 900 - endif - endif - endif - - n3=0 -! Check Type 1 (Standard 77-bit message) and Type 4 (ditto, with a "/P" call) - if(nw.eq.3 .or. nw.eq.4) then - if(ok1 .and. ok2 .and. is_grid4(w(nw)(1:4))) then - if(nw.eq.3 .or. (nw.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 - go to 900 - endif - endif - endif - -! Check Type 2 (ARRL RTTY contest exchange) - if(nw.eq.4 .or. nw.eq.5 .or. nw.eq.6) then - i1=1 - if(trim(w(1)).eq.'TU;') i1=2 - call chkcall(w(i1),bcall_1,ok1) - call chkcall(w(i1+1),bcall_2,ok2) - crpt=w(nw-1)(1:3) - if(crpt(1:1).eq.'5' .and. crpt(2:2).ge.'2' .and. crpt(2:2).le.'9' .and. & - crpt(3:3).eq.'9') then - i3=2 - n3=0 - go to 900 - endif - endif - -! Check Type 3 (One nonstandard call and one hashed call) - if(nw.eq.3) then - call_1=w(1) - if(call_1(1:1).eq.'<') call_1=w(1)(2:len(trim(w(1)))-1) - call_2=w(2) - 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) - crrpt=w(nw)(1:4) - i1=1 - if(crrpt(1:1).eq.'R') i1=2 - n=-99 - read(crrpt(i1:),*,err=6) n -6 if(ok1 .and. ok2 .and. n.ne.-99) then - i3=3 - n3=0 - go to 900 - endif - endif - -! It's free text - i3=0 - n3=0 - msg(iz+1:)=' ' - call packtext(msg(1:22),nc1,nc2,ng) - write(c77bit,1100) nc1,nc2,ng,i3,n3 !c77bit is the 77-bit message -1100 format(2b28.28,b15.15,b3.3,b3.3) - print*,c77bit - read(c77bit,1102) nc1,nc2,ng,i3,n3 -1102 format(2b28,b15,2b3) - call unpacktext(nc1,nc2,ng,msg22) - write(*,3002) nc1,nc2,ng,i3,n3,msg22(1:13) -3002 format(2i12,i8,2i3,2x,a13) - -900 continue - - call packcall(bcall_1,nc1,text1) - call packcall(bcall_2,nc2,text2) - if(.not.text1) write(*,3001) bcall_1,nc1 - if(.not.text2) write(*,3001) bcall_2,nc2 -3001 format(50x,a6,i12) - - return -end subroutine parse77 diff --git a/lib/77bit/unpack28.f90 b/lib/77bit/unpack28.f90 index db0be6f77..5e8cfe62d 100644 --- a/lib/77bit/unpack28.f90 +++ b/lib/77bit/unpack28.f90 @@ -13,30 +13,34 @@ subroutine unpack28(n28,c13) data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ data nc/37,36,19,27,27,27/ - n=n28 - NTOKENS - N24 - j=mod(n,nc(6)) - c13(6:6)=c4(j+1:j+1) - n=n/nc(6) + if(n28.lt.NTOKENS) then + !code for tokens CQ, DE, QRZ, etc. + endif + n28=n28-NTOKENS + if(n28.lt.N24) then + !code for 24-bit hash + endif + +! Standard callsign + n=n28 - N24 + + i1=n/(36*10*27*27*27) + n=n-36*10*27*27*27*i1 - j=mod(n,nc(5)) - c13(5:5)=c4(j+1:j+1) - n=n/nc(5) + i2=n/(10*27*27*27) + n=n-10*27*27*27*i2 - j=mod(n,nc(4)) - c13(4:4)=c4(j+1:j+1) - n=n/nc(4) + i3=n/(27*27*27) + n=n-27*27*27*i3 - j=mod(n,nc(3)) - c13(3:3)=c3(j+1:j+1) - n=n/nc(3) + i4=n/(27*27) + n=n-27*27*i4 - j=mod(n,nc(2)) - c13(2:2)=c2(j+1:j+1) - n=n/nc(2) - - j=n - c13(1:1)=c1(j+1:j+1) - c13(7:)=' ' + i5=n/27 + i6=n-27*i5 + c13=c1(i1+1:i1+1)//c2(i2+1:i2+1)//c3(i3+1:i3+1)//c4(i4+1:i4+1)// & + c4(i5+1:i5+1)//c4(i6+1:i6+1)//' ' + c13=adjustl(c13) return end subroutine unpack28 diff --git a/lib/77bit/unpack77.f90 b/lib/77bit/unpack77.f90 index 600a2a84b..f290192b3 100644 --- a/lib/77bit/unpack77.f90 +++ b/lib/77bit/unpack77.f90 @@ -1,23 +1,92 @@ subroutine unpack77(c77,msg) + parameter (NSEC=84) !Number of ARRL Sections character*77 c77 character*37 msg - character*13 c13 + character*13 call_1,call_2,call_3 + character*3 crpt,cntx + character*6 cexch,grid6 + character*3 csec(NSEC) + data csec/ & + "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", & + "EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", & + "KS ","KY ","LA ","LAX","MAR","MB ","MDC","ME ","MI ","MN ", & + "MO ","MS ","MT ","NC ","ND ","NE ","NFL","NH ","NL ","NLI", & + "NM ","NNJ","NNY","NT ","NTX","NV ","OH ","OK ","ONE","ONN", & + "ONS","OR ","ORG","PAC","PR ","QC ","RI ","SB ","SC ","SCV", & + "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", & + "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", & + "WV ","WWA","WY ","DX "/ read(c77(72:77),'(2b3)') n3,i3 msg=repeat(' ',37) if(i3.eq.0 .and. n3.eq.0) then +! 0.0 Free text call unpacktext77(c77(1:71),msg(1:13)) msg(14:)=' ' + 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 1010 format(2b28,b10,b5) - print*,'C1:',n28a,n28b,n10,n5,n3,i3 - call unpack28(n28a,c13) - print*,'C2: ',c13 - call unpack28(n28b,c13) - print*,'C3: ',c13 + 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 hash10(n10,call_3,-1) + msg=trim(call_1)//' RR73; '//trim(call_2)//' '//trim(call_3)//' '//crpt + + 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 +1020 format(b28,2b1,b3,b12,b25) + call unpack28(n28a,call_1) + nrs=52+irpt + if(ip.eq.1) call_1=trim(call_1)//'/P'//' ' + write(cexch,1022) nrs,iserial +1022 format(i2,i4.4) + n=igrid6 + j1=n/(18*10*10*24*24) + n=n-j1*18*10*10*24*24 + j2=n/(10*10*24*24) + n=n-j2*10*10*24*24 + j3=n/(10*24*24) + n=n-j3*10*24*24 + j4=n/(24*24) + n=n-j4*24*24 + j5=n/24 + j6=n-j5*24 + grid6(1:1)=char(j1+ichar('A')) + grid6(2:2)=char(j2+ichar('A')) + grid6(3:3)=char(j3+ichar('0')) + grid6(4:4)=char(j4+ichar('0')) + grid6(5:5)=char(j5+ichar('A')) + grid6(6:6)=char(j6+ichar('A')) + msg=trim(call_1)//' '//cexch//' '//grid6 + if(ir.eq.1) msg=trim(call_1)//' R '//cexch//' '//grid6 + 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 +1030 format(2b28,b1,b4,b3,b7) + call unpack28(n28a,call_1) + call unpack28(n28b,call_2) + ntx=intx+1 + if(n3.eq.4) ntx=ntx+16 + write(cntx(1:2),1032) ntx +1032 format(i2) + cntx(3:3)=char(ichar('A')+nclass) + if(ir.eq.0 .and. ntx.lt.10) msg=trim(call_1)//' '//trim(call_2)// & + cntx//' '//csec(isec) + if(ir.eq.1 .and. ntx.lt.10) msg=trim(call_1)//' '//trim(call_2)// & + ' R'//cntx//' '//csec(isec) + if(ir.eq.0 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// & + ' '//cntx//' '//csec(isec) + if(ir.eq.1 .and. ntx.ge.10) msg=trim(call_1)//' '//trim(call_2)// & + ' R '//cntx//' '//csec(isec) endif return