diff --git a/lib/77bit/chk77_3.f90 b/lib/77bit/chk77_3.f90 deleted file mode 100644 index 1e20d51bb..000000000 --- a/lib/77bit/chk77_3.f90 +++ /dev/null @@ -1,29 +0,0 @@ -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/encode77.f90 b/lib/77bit/encode77.f90 index 06ddd2e3b..fad8e12df 100644 --- a/lib/77bit/encode77.f90 +++ b/lib/77bit/encode77.f90 @@ -13,9 +13,10 @@ program encode77 do iline=1,999 read(10,1002,end=999) i3a,n3a,msg0 1002 format(i1,i4,1x,a37) + if(msg0.eq.' ') exit i3=i3a n3=n3a - if(i3a.gt.1 .or. n3a.gt.5) cycle +! if(i3a.gt.1 .or. n3a.gt.5) cycle call pack77(msg0,i3,n3,c77) call unpack77(c77,msg) cerr=' ' @@ -36,7 +37,7 @@ include 'pack77_01.f90' include 'pack77_02.f90' include 'pack77_03.f90' include 'pack77_1.f90' -include 'chk77_2.f90' -include 'chk77_3.f90' +include 'pack77_3.f90' +include 'pack77_4.f90' include 'packtext77.f90' include 'unpacktext77.f90' diff --git a/lib/77bit/g2 b/lib/77bit/g2 index d4d6f2073..4ad4846ef 100644 --- a/lib/77bit/g2 +++ b/lib/77bit/g2 @@ -2,4 +2,4 @@ gfortran -c ../packjt.f90 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 + ihashcall.f90 hash10.f90 hash13.f90 hash24.f90 packjt.o diff --git a/lib/77bit/g8 b/lib/77bit/g8 index 60c34b765..d17c11aae 100644 --- a/lib/77bit/g8 +++ b/lib/77bit/g8 @@ -1 +1,2 @@ -gfortran -o test28 test28.f90 pack28.f90 unpack28.f90 ihashcall.f90 hash24.f90 +gfortran -o test28 -fbounds-check -Wall -Wno-conversion test28.f90 pack28.f90 \ + unpack28.f90 ihashcall.f90 hash24.f90 diff --git a/lib/77bit/hash13.f90 b/lib/77bit/hash13.f90 new file mode 100644 index 000000000..09118ba23 --- /dev/null +++ b/lib/77bit/hash13.f90 @@ -0,0 +1,34 @@ +subroutine hash13(n13,c13,isave) + + parameter (NMAX=20) + character*13 c13,callsign(NMAX) + integer ihash(NMAX) + logical first + data first/.true./ + save first,ihash,callsign + + if(first) then + ihash=-1 + callsign=' ' + first=.false. + endif + + if(isave.ge.0) then + do i=1,NMAX + if(ihash(i).eq.n13) go to 900 !This one is already in the list + enddo + ihash(NMAX:2:-1)=ihash(NMAX-1:1:-1) + callsign(NMAX:2:-1)=callsign(NMAX-1:1:-1) + ihash(1)=n13 + callsign(1)=c13 + else + do i=1,NMAX + if(ihash(i).eq.n13) then + c13=callsign(i) + go to 900 + endif + enddo + endif + +900 return +end subroutine hash13 diff --git a/lib/77bit/msgtypes.txt b/lib/77bit/msgtypes.txt index 3b19d9ea5..dc1568f40 100644 --- a/lib/77bit/msgtypes.txt +++ b/lib/77bit/msgtypes.txt @@ -6,6 +6,7 @@ i3 n3 0 2 PA3XYZ 520093 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 3 WA9XYZ KA1ABC 7D EMA 28 28 1 4 3 7 3 71 ARRL Field Day +0 3 WA9XYZ G8ABC 1D DX 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 123456789ABCDEF012 71 71 Telemetry (18 hex) 0 5 7123456789ABCDEF01 71 71 Telemetry (18 hex) @@ -13,6 +14,9 @@ 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 -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 -4 PA3XYZ/P GM4ABC/P R IO91 28 1 28 1 1 15 74 EU VHF contest +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) +4 PJ4/KA1ABC RR73 13 58 1 2 74 Nonstandard call +4 PJ4/KA1ABC 13 58 1 2 74 Nonstandard call +4 PJ4/KA1ABC RRR 13 58 1 2 74 Nonstandard call diff --git a/lib/77bit/pack77.f90 b/lib/77bit/pack77.f90 index 96cd5c468..d0996c68e 100644 --- a/lib/77bit/pack77.f90 +++ b/lib/77bit/pack77.f90 @@ -47,21 +47,19 @@ subroutine pack77(msg,i3,n3,c77) if(i3.ge.0) go to 900 ! Check Type 3 (ARRL RTTY contest exchange) - call chk77_2(nwords,w,i3,n3) + call pack77_3(nwords,w,i3,n3,c77) if(i3.ge.0) go to 900 ! Check Type 4 (One nonstandard call and one hashed call) - call chk77_3(nwords,w,i3,n3) + call pack77_4(nwords,w,i3,n3,c77) if(i3.ge.0) go to 900 -! By default, it's free text +! It defaults to free text 800 i3=0 n3=0 msg(14:)=' ' call packtext77(msg(1:13),c77(1:71)) write(c77(72:77),'(2b3.3)') n3,i3 - -900 continue - return +900 return end subroutine pack77 diff --git a/lib/77bit/chk77_2.f90 b/lib/77bit/pack77_3.f90 similarity index 61% rename from lib/77bit/chk77_2.f90 rename to lib/77bit/pack77_3.f90 index 2dc0d6d42..b2ffbe04d 100644 --- a/lib/77bit/chk77_2.f90 +++ b/lib/77bit/pack77_3.f90 @@ -1,15 +1,15 @@ -subroutine chk77_2(nwords,w,i3,n3) +subroutine pack77_3(nwords,w,i3,n3,c77) ! 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*77 c77 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 ", & @@ -27,22 +27,40 @@ subroutine chk77_2(nwords,w,i3,n3) 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 + nserial=0 + read(w(nwords),*,err=1) nserial +!1 i3=3 +! n3=0 endif +1 mult=' ' + imult=-1 do i=1,NUSCAN if(cmult(i).eq.w(nwords)) then + imult=i mult=cmult(i) exit endif enddo - if(mult.ne.' ') then - i3=2 + nexch=0 + if(nserial.gt.0) nexch=nserial + if(imult.gt.0) nexch=8000+imult + if(mult.ne.' ' .or. nserial.gt.0) then + i3=3 n3=0 + itu=0 + if(trim(w(1)).eq.'TU;') itu=1 + call pack28(w(1+itu),n28a) + call pack28(w(2+itu),n28b) + ir=0 + if(w(3+itu)(1:2).eq.'R ') ir=1 + read(w(3+itu+ir),*) irpt + irpt=(irpt-509)/10 - 2 +! 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 +1010 format(b1,2b28.28,b1,b3.3,b13.13,b3.3) endif endif return -end subroutine chk77_2 +end subroutine pack77_3 diff --git a/lib/77bit/pack77_4.f90 b/lib/77bit/pack77_4.f90 new file mode 100644 index 000000000..798dd6983 --- /dev/null +++ b/lib/77bit/pack77_4.f90 @@ -0,0 +1,50 @@ +subroutine pack77_4(nwords,w,i3,n3,c77) +! Check Type 3 (One nonstandard call and one hashed call) + + integer*8 n58 + logical ok1,ok2 + character*13 w(19) + character*77 c77 + character*13 call_1,call_2 + character*11 c11 + character*6 bcall_1,bcall_2 + character*38 c + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/ + + if(nwords.eq.2 .or. 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) + if(ok1 .and. ok2) then + i3=4 + n3=0 + endif + + if(w(1)(1:1).eq.'<') then + iflip=0 + n13=ihashcall(w(1),13) + call hash13(n13,w(1),0) !Save this hash and its callsign + c11=adjustr(call_2(1:11)) + else if(w(2)(1:1).eq.'<') then + iflip=1 + n13=ihashcall(w(2),13) + call hash13(n13,w(2),0) !Save this hash and its callsign + c11=adjustr(call_1(1:11)) + endif + n58=0 + do i=1,11 + n58=n58*38 + index(c,c11(i:i)) - 1 + enddo + 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 + write(c77,1010) n13,n58,iflip,nrpt,i3 +1010 format(b13.13,b58.58,b1,b2.2,b3.3) + endif + + return +end subroutine pack77_4 diff --git a/lib/77bit/test28.f90 b/lib/77bit/test28.f90 index ad51827ad..5666f857f 100644 --- a/lib/77bit/test28.f90 +++ b/lib/77bit/test28.f90 @@ -1,4 +1,4 @@ -program t8 +program test28 character*13 call_0,call_1,base_call_1 character*1 cerr @@ -14,8 +14,8 @@ program t8 base_call_1=call_1(2:i-1)//' ' endif if(call_0.eq.base_call_1) cerr=' ' - write(*,1010) call_0,n28,len(trim(call_0)),len(trim(call_1)),cerr,call_1 -1010 format(a13,i12,2i5,2x,a1,2x,a13a13) + write(*,1010) call_0,n28,cerr,call_1 +1010 format(a13,i12,2x,a1,2x,a13a13) enddo -999 end program t8 +999 end program test28 diff --git a/lib/77bit/unpack28.f90 b/lib/77bit/unpack28.f90 index 38a7d94ec..c095ae847 100644 --- a/lib/77bit/unpack28.f90 +++ b/lib/77bit/unpack28.f90 @@ -35,7 +35,7 @@ subroutine unpack28(n28_0,c13) i4=n-27*i3 c13=c4(i1+1:i1+1)//c4(i2+1:i2+1)//c4(i3+1:i3+1)//c4(i4+1:i4+1) c13=adjustl(c13) - c13='CQ_'//c13 + c13='CQ_'//c13(1:10) go to 900 endif endif diff --git a/lib/77bit/unpack77.f90 b/lib/77bit/unpack77.f90 index c2c72f6b6..4d497f57b 100644 --- a/lib/77bit/unpack77.f90 +++ b/lib/77bit/unpack77.f90 @@ -1,14 +1,21 @@ subroutine unpack77(c77,msg) parameter (NSEC=84) !Number of ARRL Sections + parameter (NUSCAN=65) !Number of US states and Canadian provinces + integer*8 n58 integer ntel(3) character*77 c77 character*37 msg character*13 call_1,call_2,call_3 + character*11 c11 character*3 crpt,cntx + character*3 cmult(NUSCAN) character*6 cexch,grid6 - character*4 grid4 + character*4 grid4,cserial character*3 csec(NSEC) + character*38 c + + data c/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ/'/ data csec/ & "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB ", & "EMA","ENY","EPA","EWA","GA ","GTA","IA ","ID ","IL ","IN ", & @@ -19,6 +26,14 @@ subroutine unpack77(c77,msg) "SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX","SV ","TN ", & "UT ","VA ","VI ","VT ","WCF","WI ","WMA","WNY","WPA","WTX", & "WV ","WWA","WY ","DX "/ + 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 "/ read(c77(72:77),'(2b3)') n3,i3 msg=repeat(' ',37) @@ -102,7 +117,8 @@ subroutine unpack77(c77,msg) enddo msg=adjustl(msg) - else if(i3.eq.1 .or. i3.eq.3) then + else if(i3.eq.1 .or. i3.eq.2) then +! Standard message (Type 1) or "/P" form of standard message for EU VHF contest (Type 2) !### Here and elsewhere, must enable rpt/RRR/RR73/73 in igrid4 read(c77,1000) n28a,ipa,n28b,ipb,ir,igrid4,i3 1000 format(2(b28,b1),b1,b15,b3) @@ -110,9 +126,9 @@ subroutine unpack77(c77,msg) call unpack28(n28b,call_2) 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.3) call_1(i:i+1)='/P' + 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.3) call_2(i:i+1)='/P' + 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) @@ -127,6 +143,67 @@ subroutine unpack77(c77,msg) 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 if(i3.eq.3) then +! Type 3: ARRL RTTY Contest + read(c77,1040) itu,n28a,n28b,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') + nserial=nexch + imult=-1 + if(nexch.gt.8000) then + imult=nexch-8000 + nserial=-1 + endif + call unpack28(n28a,call_1) + call unpack28(n28b,call_2) + imult=0 + nserial=0 + if(nexch.gt.8000) imult=nexch-8000 + if(nexch.lt.8000) nserial=nexch + + if(imult.ge.1 .and.imult.le.NUSCAN) then + if(itu.eq.0 .and. ir.eq.0) msg=trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cmult(imult) + if(itu.eq.1 .and. ir.eq.0) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cmult(imult) + if(itu.eq.0 .and. ir.eq.1) msg=trim(call_1)//' '//trim(call_2)// & + ' R '//crpt//' '//cmult(imult) + if(itu.eq.1 .and. ir.eq.1) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' R '//crpt//' '//cmult(imult) + else if(nserial.ge.1 .and. nserial.le.7999) then + write(cserial,'(i4.4)') nserial + if(itu.eq.0 .and. ir.eq.0) msg=trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cserial + if(itu.eq.1 .and. ir.eq.0) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' '//crpt//' '//cserial + if(itu.eq.0 .and. ir.eq.1) msg=trim(call_1)//' '//trim(call_2)// & + ' R '//crpt//' '//cserial + if(itu.eq.1 .and. ir.eq.1) msg='TU; '//trim(call_1)//' '//trim(call_2)// & + ' 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 + j=mod(n58,38)+1 + c11(i:i)=c(j:j) + n58=n58/38 + enddo + call hash13(n13,call_3,-1) + if(iflip.eq.0) then + call_1=call_3 + call_2=adjustl(c11)//' ' + else + call_1=adjustl(c11)//' ' + call_2=call_3 + endif + if(nrpt.eq.0) msg=trim(call_1)//' '//trim(call_2) + if(nrpt.eq.1) msg=trim(call_1)//' '//trim(call_2)//' RRR' + if(nrpt.eq.2) msg=trim(call_1)//' '//trim(call_2)//' RR73' + if(nrpt.eq.3) msg=trim(call_1)//' '//trim(call_2)//' 73' endif return