diff --git a/lib/77bit/chk77_01.f90 b/lib/77bit/chk77_01.f90 new file mode 100644 index 000000000..48a7fc113 --- /dev/null +++ b/lib/77bit/chk77_01.f90 @@ -0,0 +1,18 @@ +subroutine chk77_01(msg,nwords,w,nw,i3,n3) + + character*37 msg + character*13 w(19) + character*6 bcall_1,bcall_2 + integer nw(19) + logical ok1,ok2 + + call chkcall(w(1),bcall_1,ok1) + call chkcall(w(3),bcall_2,ok2) + + if(nwords.eq.5 .and. trim(w(2)).eq.'RR73;' .and. ok1 .and. ok2) then + i3=0 !Type 0.1: DXpedition mode + n3=1 + endif + + return +end subroutine chk77_01 diff --git a/lib/77bit/chk77_02.f90 b/lib/77bit/chk77_02.f90 new file mode 100644 index 000000000..92e96746d --- /dev/null +++ b/lib/77bit/chk77_02.f90 @@ -0,0 +1,26 @@ +subroutine chk77_02(nwords,w,i3,n3) + + character*13 w(19) + character*6 bcall_1,grid6 + logical ok1,is_grid6 + + 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' + + 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 + endif + + return +end subroutine chk77_02 diff --git a/lib/77bit/chk77_03.f90 b/lib/77bit/chk77_03.f90 new file mode 100644 index 000000000..b1b2a6c19 --- /dev/null +++ b/lib/77bit/chk77_03.f90 @@ -0,0 +1,46 @@ +subroutine chk77_03(nwords,w,i3,n3) +! Check 0.3 and 0.4 (ARRL Field Day exchange) + + parameter (NSEC=83) !Number of ARRL Sections + character*13 w(19) + character*6 bcall_1,bcall_2 + character*3 csec(NSEC),section + 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 ", & + "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 "/ + + call chkcall(w(1),bcall_1,ok1) + call chkcall(w(2),bcall_2,ok2) + + 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 + endif + endif + + return +end subroutine chk77_03 diff --git a/lib/77bit/chk77_1.f90 b/lib/77bit/chk77_1.f90 new file mode 100644 index 000000000..946b2070e --- /dev/null +++ b/lib/77bit/chk77_1.f90 @@ -0,0 +1,30 @@ +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/chk77_2.f90 b/lib/77bit/chk77_2.f90 new file mode 100644 index 000000000..2dc0d6d42 --- /dev/null +++ b/lib/77bit/chk77_2.f90 @@ -0,0 +1,48 @@ +subroutine chk77_2(nwords,w,i3,n3) +! Check Type 2 (ARRL RTTY contest exchange) +!ARRL RTTY - US/Can: rpt state/prov R 579 MA +! - DX: rpt serial R 559 0013 + + parameter (NUSCAN=65) !Number of US states and Canadian provinces/territories + character*13 w(19) + character*6 bcall_1,bcall_2 + character*3 cmult(NUSCAN),mult + character crpt*3 + logical ok1,ok2 + + 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 "/ + + if(nwords.eq.4 .or. nwords.eq.5 .or. nwords.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(nwords-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 + n=-99 + read(w(nwords),*,err=1) n +1 i3=2 + n3=0 + endif + do i=1,NUSCAN + if(cmult(i).eq.w(nwords)) then + mult=cmult(i) + exit + endif + enddo + if(mult.ne.' ') then + i3=2 + n3=0 + endif + endif + + return +end subroutine chk77_2 diff --git a/lib/77bit/chk77_3.f90 b/lib/77bit/chk77_3.f90 new file mode 100644 index 000000000..1e20d51bb --- /dev/null +++ b/lib/77bit/chk77_3.f90 @@ -0,0 +1,29 @@ +subroutine chk77_3(nwords,w,i3,n3) +! Check Type 3 (One nonstandard call and one hashed call) + + character*13 w(19) + character*13 call_1,call_2 + character*6 bcall_1,bcall_2 + character crrpt*4 + logical ok1,ok2 + + if(nwords.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(nwords)(1:4) + i1=1 + if(crrpt(1:1).eq.'R') i1=2 + n=-99 + read(crrpt(i1:),*,err=1) n +1 if(ok1 .and. ok2 .and. n.ne.-99) then + i3=3 + n3=0 + endif + endif + + return +end subroutine chk77_3 diff --git a/lib/77bit/g2 b/lib/77bit/g2 new file mode 100644 index 000000000..ca59617ec --- /dev/null +++ b/lib/77bit/g2 @@ -0,0 +1,4 @@ +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 diff --git a/lib/77bit/g5 b/lib/77bit/g5 new file mode 100644 index 000000000..70cffcefa --- /dev/null +++ b/lib/77bit/g5 @@ -0,0 +1,4 @@ +gfortran -c -O2 ../packjt.f90 +gfortran -o t5 -O2 t5.f90 ../deg2grid.f90 ../grid2deg.f90 \ + ../fix_contest_msg.f90 ../to_contest_msg.f90 ../fmtmsg.f90 \ + ../azdist.f90 ../geodist.f90 packjt.o diff --git a/lib/77bit/pack28.f90 b/lib/77bit/pack28.f90 new file mode 100644 index 000000000..329606c53 --- /dev/null +++ b/lib/77bit/pack28.f90 @@ -0,0 +1,60 @@ +subroutine pack28(c13,n28) + +! Pack a special token, a 24-bit hash code, or a valid base call into a 28-bit +! integer. + + parameter (NTOKENS=4874084,N24=16777216) + integer nc(6) + character*13 c13 + character*6 callsign + character*37 c1 + character*36 c2 + character*10 c3 + character*27 c4 + data c1/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data c2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data c3/'0123456789'/ + data c4/' ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data nc/37,36,19,27,27,27/ + + n28=0 + callsign=c13(1:6) + +! Work-around for Swaziland prefix: + if(c13(1:4).eq.'3DA0') callsign='3D0'//c13(5:7) + +! Work-around for Guinea prefixes: + if(c13(1:2).eq.'3X' .and. c13(3:3).ge.'A' .and. & + c13(3:3).le.'Z') callsign='Q'//c13(3:6) + +! if(callsign(1:3).eq.'CQ ') then +! n28=1 +! if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. & +! callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. & +! callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then +! read(callsign(4:6),*) nfreq +! n28=3 + nfreq +! endif +! return +! else if(callsign(1:4).eq.'QRZ ') then +! n28=2 +! return +! else if(callsign(1:3).eq.'DE ') then +! n28=267796945 +! return +! endif + +! 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 + + + return +end subroutine pack28 diff --git a/lib/77bit/pack77.f90 b/lib/77bit/pack77.f90 new file mode 100644 index 000000000..175747fb6 --- /dev/null +++ b/lib/77bit/pack77.f90 @@ -0,0 +1,51 @@ +subroutine pack77(msg,i3,n3,c77) + + use packjt + character*37 msg +! character*22 msg22 + character*13 w(19) + character*77 c77 + integer nw(19) + +! 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 + +! Check 0.2 (EU VHF contest exchange) + call chk77_02(nwords,w,i3,n3) + if(i3.ge.0) go to 900 + +! Check 0.3 and 0.4 (ARRL Field Day exchange) + call chk77_03(nwords,w,i3,n3) + if(i3.ge.0) go to 900 + + +! Check Types 1 and 4 (Standard 77-bit message (type 1) or with "/P" (type 4)) + call chk77_1(nwords,w,i3,n3) + if(i3.ge.0) go to 900 + +! Check Type 2 (ARRL RTTY contest exchange) + call chk77_2(nwords,w,i3,n3) + if(i3.ge.0) go to 900 + +! Check Type 3 (One nonstandard call and one hashed call) + call chk77_3(nwords,w,i3,n3) + if(i3.ge.0) go to 900 + +! By default, it's free text + i3=0 + n3=0 + msg(14:)=' ' + call packtext77(msg(1:13),c77(1:71)) + 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 new file mode 100644 index 000000000..f71616c25 --- /dev/null +++ b/lib/77bit/pack77_01.f90 @@ -0,0 +1,34 @@ +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*77 c77 + character*6 bcall_1,bcall_2 + logical ok1,ok2 + + if(nwords.ne.5) return !Must have 5 words + if(trim(w(2)).ne.'RR73;') return !2nd word must be "RR73;" + if(w(4)(1:1).ne.'<') return !4th word must have <...> + 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 + 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 + i3=0 + n3=1 + call pack28(w(1),n28a) + call pack28(w(3),n28b) + n10=0 + n5=17 + write(c77,1010) n28a,n28b,n10,n5,n3,i3 +1010 format(2b28.28,b10.10,b5.5,2b3.3) + + return +end subroutine pack77_01 diff --git a/lib/77bit/packtext77.f90 b/lib/77bit/packtext77.f90 new file mode 100644 index 000000000..5d876f8d1 --- /dev/null +++ b/lib/77bit/packtext77.f90 @@ -0,0 +1,28 @@ +subroutine packtext77(c13,c71) + + real*16 q + character*13 c13,w + character*71 c71 + character*42 c + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-./?'/ + + q=0.q0 + w=adjustr(c13) + do i=1,13 + j=index(c,w(i:i))-1 + if(j.lt.0) j=0 + q=42.q0*q + j + enddo + + do i=71,1,-1 + c71(i:i)='0' + n=mod(q,2.q0) + q=q/2.q0 + if(n.eq.1) then + c71(i:i)='1' + q=q-0.q5 + endif + enddo + + return +end subroutine packtext77 diff --git a/lib/77bit/split77.f90 b/lib/77bit/split77.f90 new file mode 100644 index 000000000..430466d0d --- /dev/null +++ b/lib/77bit/split77.f90 @@ -0,0 +1,36 @@ +subroutine split77(msg,nwords,nw,w) + +! Convert msg to upper case; collapse multiple blanks; parse into words. + + character*37 msg + character*13 w(19) + character*1 c,c0 + integer nw(19) + + iz=len(trim(msg)) + 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 leading/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 + nwords=k !Number of words in msg + nw(k)=len(trim(w(k))) + msg(iz+1:)=' ' + + return +end subroutine split77 diff --git a/lib/77bit/unpack28.f90 b/lib/77bit/unpack28.f90 new file mode 100644 index 000000000..db0be6f77 --- /dev/null +++ b/lib/77bit/unpack28.f90 @@ -0,0 +1,42 @@ +subroutine unpack28(n28,c13) + + parameter (NTOKENS=4874084,N24=16777216) + integer nc(6) + character*13 c13 + character*37 c1 + character*36 c2 + character*10 c3 + character*27 c4 + data c1/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data c2/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + data c3/'0123456789'/ + 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) + + j=mod(n,nc(5)) + c13(5:5)=c4(j+1:j+1) + n=n/nc(5) + + j=mod(n,nc(4)) + c13(4:4)=c4(j+1:j+1) + n=n/nc(4) + + j=mod(n,nc(3)) + c13(3:3)=c3(j+1:j+1) + n=n/nc(3) + + 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:)=' ' + + return +end subroutine unpack28 diff --git a/lib/77bit/unpack77.f90 b/lib/77bit/unpack77.f90 new file mode 100644 index 000000000..600a2a84b --- /dev/null +++ b/lib/77bit/unpack77.f90 @@ -0,0 +1,24 @@ +subroutine unpack77(c77,msg) + + character*77 c77 + character*37 msg + character*13 c13 + + read(c77(72:77),'(2b3)') n3,i3 + msg=repeat(' ',37) + if(i3.eq.0 .and. n3.eq.0) then + call unpacktext77(c77(1:71),msg(1:13)) + msg(14:)=' ' + else if(i3.eq.0 .and. n3.eq.1) then + 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 + + endif + + return +end subroutine unpack77 diff --git a/lib/77bit/unpacktext77.f90 b/lib/77bit/unpacktext77.f90 new file mode 100644 index 000000000..35633fe83 --- /dev/null +++ b/lib/77bit/unpacktext77.f90 @@ -0,0 +1,22 @@ +subroutine unpacktext77(c71,c13) + + real*16 q,q1 + integer*8 n1,n2 + character*13 c13 + character*71 c71 + character*42 c + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-./?'/ + + read(c71,1001) n1,n2 +1001 format(b63,b8) + q=n1*256.q0 + n2 + + do i=13,1,-1 + q1=mod(q,42.q0) + j=q1+1.q0 + c13(i:i)=c(j:j) + q=(q-q1)/42.q0 + enddo + + return +end subroutine unpacktext77