From f6ddd2cd2e34c7189977957f857e7be886cbb82b Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Thu, 27 Jul 2017 20:17:30 +0000 Subject: [PATCH] Working on some features for NA VHF contests. Not finished! git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@7963 ab8295b8-cf94-4d9e-aec4-7959e3be5d79 --- lib/contest72.f90 | 91 +++++++++++++++++++++++++++++++++++++++++ lib/fix_contest_msg.f90 | 4 ++ lib/genmsk144.f90 | 15 ++----- lib/packjt.f90 | 15 ++++++- lib/to_contest_msg.f90 | 27 ++++++++++++ 5 files changed, 140 insertions(+), 12 deletions(-) create mode 100644 lib/contest72.f90 create mode 100644 lib/to_contest_msg.f90 diff --git a/lib/contest72.f90 b/lib/contest72.f90 new file mode 100644 index 000000000..2a23c1181 --- /dev/null +++ b/lib/contest72.f90 @@ -0,0 +1,91 @@ +program contest72 + + use packjt + integer dat(12) + logical text,bcontest,ok + character*22 msg,msg0,msg1 + character*72 ct1,ct2 + character*12 callsign1,callsign2 + character*1 c0 + character*42 c + character*6 mygrid + data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/ + data bcontest/.true./ + data mygrid/"EM48 "/ + +! itype Message Type +!-------------------- +! 1 Standardd message +! 2 Type 1 prefix +! 3 Type 1 suffix +! 4 Type 2 prefix +! 5 Type 2 suffix +! 6 Free text +! -1 Does not decode correctly + + nargs=iargc() + if(nargs.eq.0) open(10,file='contest_msgs.txt',status='old') + + nn=0 + do imsg=1,9999 + if(nargs.eq.1) then + if(imsg.gt.1) exit + call getarg(1,msg0) + else + read(10,1001,end=999) msg0 +1001 format(a22) + endif + msg=msg0 + if(bcontest) call to_contest_msg(msg0,msg) + call packmsg(msg,dat,itype) + call unpackmsg(dat,msg1) + call fix_contest_msg(mygrid,msg1) + ok=msg1.eq.msg0 + if(msg0.eq.' ') then + write(*,1002) + else + if(jt_c2(1:1).eq.'W') msg0=' '//msg0(1:20) + nn=nn+1 + write(*,1002) nn,msg0,ok,jt_itype,jt_nc1,jt_nc2,jt_ng,jt_k1,jt_k2 +1002 format(i1,'. ',a22,L2,i2,2i10,i6,2i8) + if(index(msg1,' 73 ').gt.4) nn=0 + endif + if(.not.ok) print*,msg0,msg1 + if(itype.lt.0 .or. itype.eq.6) cycle + + if(msg(1:3).eq.'CQ ') then + m=2 + write(ct1,1010) dat +1010 format(12b6.6) +! write(*,1014) ct1 +1014 format(a72) + cycle + endif + + i1=index(msg,'<') + if(i1.eq.1) then + m=0 + cycle + endif + + if(i.ge.5) then + m=3 + cycle + endif + + if(msg(1:6).eq.'73 CQ ') then + m=4 + cycle + endif + + call packmsg(msg,dat,itype) + write(ct1,1010) dat + call packtext(msg,nc1,nc2,ng) +! write(ct2,1012) nc1,nc2,ng+32768 +!1012 format(2b28.28,b16.16) +! write(*,1014) ct1 +! write(*,1014) ct2 +! write(*,1014) + enddo + +999 end program contest72 diff --git a/lib/fix_contest_msg.f90 b/lib/fix_contest_msg.f90 index 730e105e0..8c0345e87 100644 --- a/lib/fix_contest_msg.f90 +++ b/lib/fix_contest_msg.f90 @@ -8,6 +8,10 @@ subroutine fix_contest_msg(mygrid,msg) character*6 g1,g2 logical isgrid + isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & + g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & + g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73' + n=len(trim(msg)) if(n.lt.4) return diff --git a/lib/genmsk144.f90 b/lib/genmsk144.f90 index 9496e8837..b58196f4f 100644 --- a/lib/genmsk144.f90 +++ b/lib/genmsk144.f90 @@ -41,6 +41,10 @@ subroutine genmsk144(msg0,mygrid,ichk,bcontest,msgsent,i4tone,itype) data first/.true./ save + isgrid=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & + g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & + g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73' + if( first ) then first=.false. nsym=128 @@ -174,14 +178,3 @@ subroutine genmsk144(msg0,mygrid,ichk,bcontest,msgsent,i4tone,itype) 999 return end subroutine genmsk144 - -logical function isgrid(g1) - - character*4 g1 - - isgrid=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & - g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & - g1(4:4).ge.'0' .and. g1(4:4).le.'9' - - return -end function isgrid diff --git a/lib/packjt.f90 b/lib/packjt.f90 index 049af22ee..26a20cb94 100644 --- a/lib/packjt.f90 +++ b/lib/packjt.f90 @@ -1,5 +1,9 @@ module packjt +! These variables are accessible from outside via "use packjt": + integer jt_itype,jt_nc1,jt_nc2,jt_ng,jt_k1,jt_k2 + character*6 jt_c1,jt_c2,jt_c3 + contains subroutine packbits(dbits,nsymd,m0,sym) @@ -494,8 +498,17 @@ subroutine packbits(dbits,nsymd,m0,sym) ng=ng+32768 ! Encode data into 6-bit words - 20 continue +20 continue if(itype.ne.6) itype=max(nv2a,nv2b) + jt_itype=itype + jt_c1=c1 + jt_c2=c2 + jt_c3=c3 + jt_k1=k1 + jt_k2=k2 + jt_nc1=nc1 + jt_nc2=nc2 + jt_ng=ng dat(1)=iand(ishft(nc1,-22),63) !6 bits dat(2)=iand(ishft(nc1,-16),63) !6 bits dat(3)=iand(ishft(nc1,-10),63) !6 bits diff --git a/lib/to_contest_msg.f90 b/lib/to_contest_msg.f90 new file mode 100644 index 000000000..426919518 --- /dev/null +++ b/lib/to_contest_msg.f90 @@ -0,0 +1,27 @@ +subroutine to_contest_msg(msg0,msg) + +! If the message has "R grid4" istead of "grid4", remove the "R " +! and substitute the diametrically opposite grid. + + character*6 g1,g2 + character*22 msg0,msg + logical isgrid + isgrid(g1)=g1(1:1).ge.'A' .and. g1(1:1).le.'R' .and. g1(2:2).ge.'A' .and. & + g1(2:2).le.'R' .and. g1(3:3).ge.'0' .and. g1(3:3).le.'9' .and. & + g1(4:4).ge.'0' .and. g1(4:4).le.'9' .and. g1(1:4).ne.'RR73' + + i0=index(msg0,' R ') + 3 !Check for ' R ' in message + g1=msg0(i0:i0+3)//' ' + if(isgrid(g1)) then !Check for ' R grid' + call grid2deg(g1,dlong,dlat) + dlong=dlong+180.0 + if(dlong.gt.180.0) dlong=dlong-360.0 + dlat=-dlat + call deg2grid(dlong,dlat,g2) !g2=antipodes grid + msg=msg0(1:i0-3)//g2(1:4) !Send message with g2 + else + msg=msg0 + endif + + return +end subroutine to_contest_msg