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

@@ -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

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
 

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

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

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