mirror of https://github.com/saitohirga/WSJT-X.git
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
This commit is contained in:
Joe Taylor
parent
ed95b6d373
commit
f6ddd2cd2e
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue