WSJT-X/map65a.F90
Joe Taylor 5f66aff299 1. Center frequency send by Linrad is now used to set frequency scale in
SpecJT and frequency labels on lines of decoded text.  (Needs checking!)
2. Corrected logic for Rx buffer assignment on program startup, and
   for when a transmission is started late.  (Needs checking!)
3. Diagnostic display of kbuf, kk, and kxp/96000 in status-bar msg7.


git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/map65@943 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2008-07-12 18:11:36 +00:00

400 lines
13 KiB
Fortran

subroutine map65a(newdat)
! Processes timf2 data from Linrad to find and decode JT65 signals.
parameter (MAXMSG=1000) !Size of decoded message list
real tavg(-50:50) !Temp for finding local base level
real base(4) !Local basel level at 4 pol'ns
real tmp (200) !Temp storage for pctile sorting
real sig(MAXMSG,30) !Parameters of detected signals
real a(5)
character*22 msg(MAXMSG)
character*3 shmsg0(4),shmsg
integer indx(MAXMSG),nsiz(MAXMSG)
logical done(MAXMSG)
character decoded*22,blank*22
include 'spcom.f90'
real short(3,NFFT) !SNR dt ipol for potential shorthands
real qphi(12)
include 'gcom2.f90'
include 'datcom.f90'
data blank/' '/
data shmsg0/'ATT','RO ','RRR','73 '/
data nfile/0/,nutc0/-999/,nid/0/,ip000/1/,ip001/1/,mousefqso0/-999/
save
nfoffset=nint(1000*(fcenter-144.125d0))
if(mousefqso.ne.mousefqso0 .and. nagain.eq.1) newspec=2
mousefqso0=mousefqso
pctlost=nlost/331.03
if(ndebug.eq.2) write(29,3001) nutc,mod(int(sec_midn()),60),nlost,pctlost
3001 format('m1:',i5.4,i3.2,i8,f7.2,' %')
rewind 11
rewind 12
if(nrw26.ne.0) then
endfile (26) !Compiler bug? Don't write "end file 26" !!!
rewind 26
nrw26=0
endif
#ifdef CVF
open(23,file='CALL3.TXT',status='unknown',share='denynone')
#else
open(23,file='CALL3.TXT',status='unknown')
#endif
if(nutc.ne.nutc0) nfile=nfile+1
nutc0=nutc
nutcdata=nutc
df=96000.0/NFFT !df = 96000/NFFT = 2.930 Hz
ftol=0.020 !Frequency tolerance (kHz)
foffset=0.001*(1270 + nfcal)
fselect=mousefqso + foffset
nfilt=1
dphi=idphi/57.2957795
do i=12,3,-1
if(hiscall(i:i).ne.' ') go to 1
enddo
i=0
1 len_hiscall=i
iloop=0
2 if(ndphi.eq.1) dphi=30*iloop/57.2957795
do nqd=1,0,-1
if(nqd.eq.1) then !Quick decode, at fQSO
fa=1000.0*(fselect+0.001*mousedf-100.0) - dftolerance
fb=1000.0*(fselect+0.001*mousedf-100.0) + dftolerance + 4*53.8330078
ia=nint((fa+23000.0)/df + 1.0) ! 23000 = 48000 - 25000
ib=nint((fb+23000.0)/df + 1.0)
else !Wideband decode at all freqs
fa=1000*(nfa-100)
fb=1000*(nfb-100)
ia=nint((fa+23000.0)/df + 1.0) ! 23000 = 48000 - 25000
ib=nint((fb+23000.0)/df + 1.0)
endif
km=0
nkm=1
nz=n/8
do i=1,NFFT
short(1,i)=0.
short(2,i)=0.
short(3,i)=0.
enddo
freq0=-999.
sync10=-999.
fshort0=-999.
sync20=-999.
ntry=0
do i=ia,ib !Search over freq range
call sleep_msec(0)
freq=0.001*((i-1)*df - 23000) + 100.0
! Find the local base level for each polarization; update every 10 bins.
if(mod(i-ia,10).eq.0) then
do jp=1,4
do ii=-50,50
tavg(ii)=savg(jp,i+ii)
enddo
call pctile(tavg,tmp,101,50,base(jp))
enddo
bmax=max(base(1),base(2),base(3),base(4))
endif
! Do not process extremely strong signals
if(nqd.eq.0 .and. bmax.gt.500.0) go to 70
! Find max signal at this frequency
smax=0.
do jp=1,4
if(savg(jp,i)/base(jp).gt.smax) smax=savg(jp,i)/base(jp)
enddo
if(smax.gt.1.1) then
ntry=ntry+1
! Look for JT65 sync patterns and shorthand square-wave patterns.
call ccf65(ss(1,1,i),nhsym,sync1,ipol,dt,flipk, &
syncshort,snr2,ipol2,dt2)
! ########################### Search for Shorthand Messages #################
shmsg=' '
! Is there a shorthand tone above threshold?
thresh0=1.0
! Use lower thresh0 at fQSO
if(nqd.eq.1 .and. dftolerance.le.100) thresh0=0.
if(syncshort.gt.thresh0) then
! ### Do shorthand AFC here (or maybe after finding a pair?) ###
short(1,i)=syncshort
short(2,i)=dt2
short(3,i)=ipol2
! Check to see if lower tone of shorthand pair was found.
do j=2,4
i0=i-nint(j*53.8330078/df)
! Should this be i0 +/- 1, or just i0?
! Should we also insist that difference in DT be either 1.5 or -1.5 s?
if(short(1,i0).gt.1.0) then
fshort=0.001*((i0-1)*df - 23000) + 100.0
noffset=0
if(nqd.eq.1) noffset=nint(1000.0* &
(fshort-foffset-mousefqso)-mousedf)
if(abs(noffset).le.dftolerance) then
! Keep only the best candidate within ftol.
!### NB: sync2 was not defined here!
sync2=syncshort !### try this ???
if(fshort-fshort0.le.ftol .and. sync2.gt.sync20 &
.and. nkm.eq.2) km=km-1
if(fshort-fshort0.gt.ftol .or. &
sync2.gt.sync20) then
km=km+1
sig(km,1)=nfile
sig(km,2)=nutc
sig(km,3)=fshort
sig(km,4)=syncshort
sig(km,5)=dt2
sig(km,6)=45*(ipol2-1)/57.2957795
sig(km,7)=0
sig(km,8)=snr2
sig(km,9)=0
sig(km,10)=0
! sig(km,11)=rms0
sig(km,12)=savg(ipol2,i)
sig(km,13)=0
sig(km,14)=0
sig(km,15)=0
sig(km,16)=0
! sig(km,17)=0
sig(km,18)=0
msg(km)=shmsg0(j)
fshort0=fshort
sync20=sync2
nkm=2
endif
endif
endif
enddo
endif
! ########################### Search for Normal Messages ###########
! Is sync1 above threshold?
thresh1=1.0
! Use lower thresh1 at fQSO
if(nqd.eq.1 .and. dftolerance.le.100) thresh1=0.
noffset=0
if(nqd.eq.1) noffset=nint(1000.0*(freq-foffset-mousefqso)-mousedf)
if(sync1.gt.thresh1 .and. abs(noffset).le.dftolerance) then
! Keep only the best candidate within ftol.
! (Am I deleting any good decodes by doing this?)
if(freq-freq0.le.ftol .and. sync1.gt.sync10 .and. &
nkm.eq.1) km=km-1
if(freq-freq0.gt.ftol .or. sync1.gt.sync10) then
nflip=nint(flipk)
call decode1a(id(1,1,kbuf),newdat,nfilt,freq,nflip, &
mycall,hiscall,hisgrid,neme,ndepth,nqd,dphi,ndphi, &
ipol,sync2,a,dt,pol,nkv,nhist,qual,decoded)
! If hiscall or hisgrid is in decoded message, save the pol'n angle.
i1=index(decoded,hiscall(1:len_hiscall))
i2=index(decoded,hisgrid(1:4))
if(i1.ge.5 .or. i2.ge.9) then
nhispol=nint(57.2957795*pol)
endif
km=km+1
sig(km,1)=nfile
sig(km,2)=nutc
sig(km,3)=freq
sig(km,4)=sync1
sig(km,5)=dt
sig(km,6)=pol
sig(km,7)=flipk
sig(km,8)=sync2
sig(km,9)=nkv
sig(km,10)=qual
! sig(km,11)=idphi
sig(km,12)=savg(ipol,i)
sig(km,13)=a(1)
sig(km,14)=a(2)
sig(km,15)=a(3)
sig(km,16)=a(4)
! sig(km,17)=a(5)
sig(km,18)=nhist
msg(km)=decoded
freq0=freq
sync10=sync1
nkm=1
endif
endif
endif
70 continue
enddo
if(nqd.eq.1) then
nwrite=0
do k=1,km
decoded=msg(k)
if(decoded.ne.' ') then
nutc=sig(k,2)
freq=sig(k,3)
sync1=sig(k,4)
dt=sig(k,5)
npol=nint(57.2957795*sig(k,6))
flip=sig(k,7)
sync2=sig(k,8)
nkv=sig(k,9)
nqual=sig(k,10)
! idphi=nint(sig(k,11))
if(flip.lt.0.0) then
do i=22,1,-1
if(decoded(i:i).ne.' ') go to 8
enddo
stop 'Error in message format'
8 if(i.le.18) decoded(i+2:i+4)='OOO'
endif
nkHz=nint(freq-foffset) + nfoffset
f0=144.0+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-nkHz))
! ndf0=nint(a(1))
! ndf1=nint(a(2))
! ndf2=nint(a(3))
nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6
nw=0 !### Fix this! ###
nwrite=nwrite+1
if(ndphi.eq.0) then
write(11,1010) nkHz,ndf,npol,nutc,dt,nsync2,decoded,nkv,nqual
1010 format(i3,i5,i4,i5.4,f5.1,i4,2x,a22,i5,i4,i4)
else
if(iloop.ge.1) qphi(iloop)=sig(k,10)
write(11,1010) nkHz,ndf,npol,nutc,dt,nsync2,decoded,nkv, &
nqual,30*iloop
write(27,1011) 30*iloop,nkHz,ndf,npol,nutc, &
dt,sync2,nkv,nqual,decoded
1011 format(i3,i4,i5,i4,i5.4,f5.1,f7.1,i3,i5,2x,a22)
endif
endif
enddo
if(nwrite.eq.0) then
nfqso=mousefqso + nfoffset
write(11,1012) nfqso,nutc
1012 format(i3,9x,i5.4)
endif
endif
if(ndphi.eq.1 .and.iloop.lt.12) then
iloop=iloop+1
go to 2
endif
if(ndphi.eq.1 .and.iloop.eq.12) call getdphi(qphi)
if(nqd.eq.1) then
write(11,*) '$EOF'
call flushqqq(11)
ndecdone=1
t2=sec_midn()
if(ndebug.eq.2) write(29,3002) mod(int(t2),60)
3002 format('m2:'i8.2)
endif
if(nagain.eq.1) go to 999
enddo
! Trim the list and produce a sorted index and sizes of groups.
! (Should trimlist remove all but best SNR for given UTC and message content?)
call trimlist(sig,km,indx,nsiz,nz)
do i=1,km
done(i)=.false.
enddo
j=0
ilatest=-1
do n=1,nz
ifile0=0
do m=1,nsiz(n)
i=indx(j+m)
ifile=sig(i,1)
if(ifile.gt.ifile0 .and.msg(i).ne.blank) then
ilatest=i
ifile0=ifile
endif
enddo
i=ilatest
if(i.ge.1) then
if(.not.done(i)) then
done(i)=.true.
nutc=sig(i,2)
freq=sig(i,3)
sync1=sig(i,4)
dt=sig(i,5)
npol=nint(57.2957795*sig(i,6))
flip=sig(i,7)
sync2=sig(i,8)
nkv=sig(i,9)
nqual=min(sig(i,10),10.0)
! rms0=sig(i,11)
nsavg=sig(i,12) !Was used for diagnostic ...
do k=1,5
a(k)=sig(i,12+k)
enddo
nhist=sig(i,18)
decoded=msg(i)
if(flip.lt.0.0) then
do i=22,1,-1
if(decoded(i:i).ne.' ') go to 10
enddo
stop 'Error in message format'
10 if(i.le.18) decoded(i+2:i+4)='OOO'
endif
nkHz=nint(freq-foffset) + nfoffset
f0=144.0+0.001*nkHz
ndf=nint(1000.0*(freq-foffset-nkHz))
ndf0=nint(a(1))
ndf1=nint(a(2))
ndf2=nint(a(3))
nsync1=sync1
nsync2=nint(10.0*log10(sync2)) - 40 !### empirical ###
if(decoded(1:4).eq.'RO ' .or. decoded(1:4).eq.'RRR ' .or. &
decoded(1:4).eq.'73 ') nsync2=nsync2-6
write(26,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist
write(21,1014) f0,ndf,ndf0,ndf1,ndf2,dt,npol,nsync1, &
nsync2,nutc,decoded,nkv,nqual,nhist
1014 format(f7.3,i5,3i3,f5.1,i5,i3,i4,i5.4,2x,a22,3i3)
endif
endif
j=j+nsiz(n)
enddo
write(26,1015) nutc
1015 format(39x,i4.4)
call flushqqq(26)
call display(nkeep,ncsmin)
ndecdone=2
if(nsave.gt.0 .and. ndiskdat.eq.0) call savetf2(id(1,1,kbuf),nsave, &
ntime,nutc,savedir)
999 close(23)
ndphi=0
if(kbuf.eq.1) kkdone=60*96000
if(kbuf.eq.2 .or. ndiskdat.eq.1) kkdone=0
kk=kkdone
if(nagain.eq.0) then
t3=sec_midn()
if(ndebug.eq.2) write(29,3003) mod(int(t3),60)
3003 format('m3:'i8.2)
if(ndebug.eq.1) write(*,3004) nutc,mod(t2,60.0),mod(t3,60.0), &
nlost,pctlost
3004 format('map65:',i5.4,1x,2f6.1,i6,f8.2,' %')
endif
nagain=0
return
end subroutine map65a