Initial Commit
This commit is contained in:
Jordan Sherer
@@ -0,0 +1,166 @@
|
||||
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
|
||||
Reference in New Issue
Block a user