WSJT-X/lib/hint65.f90
Bill Somerville dd1362b69a Rationalize NA contest mode
Generic message packing and unpacking routines now understand antipode
grid contest messages.  These messages  are now recognized as standard
messages in  message response processing and  dealt with appropriately
when contest mode is selected and applicable (currently FT8 and MSK144
only).

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@8062 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2017-09-01 20:10:35 +00:00

167 lines
4.8 KiB
Fortran

subroutine hint65(s3,mrs,mrs2,nadd,nflip,mycall,hiscall,hisgrid,qual,decoded)
use packjt
use prog_args
parameter (MAXCALLS=10000,MAXRPT=63)
parameter (MAXMSG=2*MAXCALLS + 2 + MAXRPT)
real s3(64,63)
integer*1 sym1(0:62,MAXMSG)
integer*1 sym2(0:62,MAXMSG)
integer mrs(63),mrs2(63)
integer dgen(12),sym(0:62),sym_rev(0:62)
character*6 mycall,hiscall,hisgrid,call2(MAXCALLS)
character*4 grid2(MAXCALLS),rpt(MAXRPT)
character callsign*12,grid*4
character*180 line
character ceme*3,msg*22,msg00*22
character*22 msg0(MAXMSG),decoded
logical*1 eme(MAXCALLS)
logical first
data first/.true./
data rpt/'-01','-02','-03','-04','-05', &
'-06','-07','-08','-09','-10', &
'-11','-12','-13','-14','-15', &
'-16','-17','-18','-19','-20', &
'-21','-22','-23','-24','-25', &
'-26','-27','-28','-29','-30', &
'R-01','R-02','R-03','R-04','R-05', &
'R-06','R-07','R-08','R-09','R-10', &
'R-11','R-12','R-13','R-14','R-15', &
'R-16','R-17','R-18','R-19','R-20', &
'R-21','R-22','R-23','R-24','R-25', &
'R-26','R-27','R-28','R-29','R-30', &
'RO','RRR','73'/
save first,sym1,nused,msg0,sym2
first=.true. !### For now, at least: always recompute hypothetical messages
if(first) then
neme=0
open(23,file=trim(data_dir)//'/CALL3.TXT',status='unknown')
icall=0
j=0
do i=1,MAXCALLS
read(23,1002,end=10) line
1002 format(a80)
if(line(1:4).eq.'ZZZZ') cycle
if(line(1:2).eq.'//') cycle
i1=index(line,',')
if(i1.lt.4) cycle
i2=index(line(i1+1:),',')
if(i2.lt.5) cycle
i2=i2+i1
i3=index(line(i2+1:),',')
if(i3.lt.1) i3=index(line(i2+1:),' ')
i3=i2+i3
callsign=line(1:i1-1)
grid=line(i1+1:i1+4)
ceme=line(i2+1:i3-1)
eme(i)=ceme.eq.'EME'
if(neme.eq.1 .and. (.not.eme(i))) cycle
j=j+1
call2(j)=callsign(1:6) !### Fix for compound callsigns!
grid2(j)=grid
enddo
10 ncalls=j
if(ncalls.lt.10) then
write(*,1010) ncalls
1010 format('CALL3.TXT very short (N =',i2,') or missing?')
endif
close(23)
! NB: generation of test messages is not yet complete!
j=0
do i=-1,ncalls
if(i.eq.0 .and. hiscall.eq.' ' .and. hisgrid(1:4).eq.' ') cycle
mz=2
if(i.eq.-1) mz=1
if(i.eq.0) mz=65
do m=1,mz
j=j+1
if(i.eq.-1) then
msg='0123456789ABC'
else if(i.eq.0) then
if(m.eq.1) msg=mycall//' '//hiscall//' '//hisgrid(1:4)
if(m.eq.2) msg='CQ '//hiscall//' '//hisgrid(1:4)
if(m.ge.3) msg=mycall//' '//hiscall//' '//rpt(m-2)
else
if(m.eq.1) msg=mycall//' '//call2(i)//' '//grid2(i)
if(m.eq.2) msg='CQ '//call2(i)//' '//grid2(i)
endif
call fmtmsg(msg,iz)
call packmsg(msg,dgen,itype,.false.) !Pack message into 72 bits
call rs_encode(dgen,sym_rev) !RS encode
sym(0:62)=sym_rev(62:0:-1)
sym1(0:62,j)=sym
call interleave63(sym_rev,1) !Interleave channel symbols
call graycode(sym_rev,63,1,sym_rev) !Apply Gray code
sym2(0:62,j)=sym_rev(0:62)
msg0(j)=msg
enddo
enddo
nused=j
first=.false.
endif
ref0=0.
do j=1,63
ref0=ref0 + s3(mrs(j)+1,j)
enddo
u1=0.
u1=-99.0
u2=u1
! Find u1 and u2 (best and second-best) codeword from a list, using
! a bank of matched filters on the symbol spectra s3(i,j).
ipk=1
ipk2=0
msg00=' '
do k=1,nused
if(k.ge.2 .and. k.le.64 .and. nflip.lt.0) cycle
! Test all messages if nflip=+1; skip the CQ messages if nflip=-1.
if(nflip.gt.0 .or. msg0(k)(1:3).ne.'CQ ') then
psum=0.
ref=ref0
do j=1,63
i=sym2(j-1,k)+1
psum=psum + s3(i,j)
if(i.eq.mrs(j)+1) ref=ref - s3(i,j) + s3(mrs2(j)+1,j)
enddo
p=psum/ref
if(p.gt.u1) then
if(msg0(k).ne.msg00) then
ipk2=ipk
u2=u1
endif
u1=p
ipk=k
msg00=msg0(k)
endif
if(msg0(k).ne.msg00 .and. p.gt.u2) then
u2=p
ipk2=k
endif
endif
enddo
!### Just in case ???
! rewind 77
! write(77,*) u1,u2,ipk,ipk2
! call flush(77)
!###
decoded=' '
bias=max(1.12*u2,0.35)
if(nadd.ge.4) bias=max(1.08*u2,0.45)
if(nadd.ge.8) bias=max(1.04*u2,0.60)
qual=100.0*(u1-bias)
! write(*,3301) u1,u2,u1/u2,bias,qual,nadd,ipk,ipk2
!3301 format(5f6.2,i3,2i6)
qmin=1.0
if(qual.ge.qmin) decoded=msg0(ipk)
return
end subroutine hint65