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 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 Win32 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 endif ! 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? if(syncshort.gt.1.0) 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 ! 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 enddo endif ! ########################### Search for Normal Messages ########### ! Is sync1 above threshold? thresh1=1.0 if(nqd.eq.1 .and. dftolerance.le.100) thresh1=0. !Lower thresh1 at fQSO if(sync1.gt.thresh1) 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 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) 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 write(11,1012) mousefqso,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) 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