mirror of https://github.com/saitohirga/WSJT-X.git
301 lines
8.1 KiB
Fortran
301 lines
8.1 KiB
Fortran
subroutine wsjt1(d,jz0,istart,samfacin,FileID,ndepth,MinSigdB,
|
|
+ NQRN,DFTolerance,NSaveCum,MouseButton,NClearAve,
|
|
+ Mode,NFreeze,NAFC,NZap,AppDir,utcdate,mode441,mode65,
|
|
+ MyCall,HisCall,HisGrid,neme,nsked,naggressive,ntx2,s2,
|
|
+ ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg,
|
|
+ MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2)
|
|
|
|
parameter (NP2=1024*1024)
|
|
|
|
integer*2 d(jz0) !Buffer for raw one-byte data
|
|
integer istart !Starting location in original d() array
|
|
character FileID*40 !Name of file being processed
|
|
integer MinSigdB !Minimum ping strength, dB
|
|
integer NQRN !QRN rejection parameter
|
|
integer DFTolerance !Defines DF search range
|
|
integer NSaveCum !Set to 1 if cumulative file is to be saved
|
|
integer NSyncOK !Set to 1 if JT65 file synchronized OK
|
|
character AppDir*80 !Installation directory for WSJT
|
|
character*12 utcdate
|
|
character*12 mycall
|
|
character*12 hiscall
|
|
character*6 hisgrid
|
|
real ps0(431) !Spectrum of best ping
|
|
integer npkept !Number of pings kept and decoded
|
|
integer lumsg !Logical unit for decoded.txt
|
|
real basevb !Baseline signal level, dB
|
|
integer nslim2 !Minimum strength for single-tone pings, dB
|
|
real psavg(450) !Average spectrum of the whole file
|
|
integer Nseg !First or second Tx sequence?
|
|
integer MouseDF !Freeze position for DF
|
|
logical pick !True if this is a mouse-picked ping
|
|
logical stbest !True if the best decode was Single-Tone
|
|
logical STfound !True if at least one ST decode
|
|
logical LDecoded !True if anything was decoded
|
|
real s2(64,3100) !2D spectral array
|
|
real ccf(-5:540) !X-cor function in JT65 mode (blue line)
|
|
real red(512)
|
|
real ss1(-224:224) !Lower magenta curve (for JT65 shorthands)
|
|
real ss2(-224:224) !Upper magenta curve (for JT65 shorthands)
|
|
real yellow(216)
|
|
real yellow0(216)
|
|
real fzap(200)
|
|
|
|
integer resample
|
|
real*8 samfacin,samratio
|
|
real dat2(NP2)
|
|
|
|
integer*1 dtmp
|
|
character msg3*3
|
|
character cfile6*6
|
|
character fname*99,fcum*99
|
|
logical lcum
|
|
integer indx(100)
|
|
character*90 line
|
|
character*24 today
|
|
|
|
common/avecom/dat(NP2),labdat,jza,modea
|
|
common/avecom2/f0a
|
|
common/ccom/nline,tping(100),line(100)
|
|
common/limcom/ nslim2a
|
|
common/clipcom/ nclip
|
|
equivalence (dtmp,ntmp)
|
|
save
|
|
|
|
lcum=.true.
|
|
jz=jz0
|
|
modea=Mode
|
|
nclip=NQRN-5
|
|
nslim2a=nclip
|
|
MinWidth=40 !Minimum width of pings, ms
|
|
call zero(psavg,450)
|
|
rewind 11
|
|
rewind 12
|
|
|
|
do i=1,40
|
|
if(FileID(i:i).eq.'.') go to 3
|
|
enddo
|
|
i=4
|
|
3 ia=max(1,i-6)
|
|
cfile6=FileID(ia:i-1)
|
|
|
|
nline=0
|
|
ndiag=0
|
|
! If file "/wsjt.reg" exists, set ndiag=1
|
|
open(16,file='/wsjt.reg',status='old',err=4)
|
|
ndiag=1
|
|
close(16)
|
|
|
|
4 if(jz.gt.655360) jz=655360
|
|
if(mode.eq.4 .and. jz.gt.330750) jz=330750 !### Fix this!
|
|
|
|
sum=0.
|
|
do j=1,jz !Convert raw data from byte to real, remove DC
|
|
dat(j)=0.1*d(j)
|
|
sum=sum + dat(j)
|
|
enddo
|
|
ave=sum/jz
|
|
samratio=1.d0/samfacin
|
|
if(samratio.eq.1.d0) then
|
|
do j=1,jz
|
|
dat(j)=dat(j)-ave
|
|
enddo
|
|
else
|
|
do j=1,jz
|
|
dat2(j)=dat(j)-ave
|
|
enddo
|
|
|
|
#ifdef Win32
|
|
ierr=resample(dat2,dat,samratio,jz)
|
|
if(ierr.ne.0) print*,'Resample error.',samratio
|
|
#endif
|
|
|
|
endif
|
|
|
|
if(mode.ne.2 .and. nzap.ne.0) then
|
|
if(jz.gt.100000) call avesp2(dat,jz,2,f0a,NFreeze,MouseDF,
|
|
+ DFTolerance,fzap)
|
|
nadd=1
|
|
call bzap(dat,jz,nadd,mode,fzap)
|
|
endif
|
|
|
|
sq=0.
|
|
do j=1,jz !Compute power level for whole array
|
|
sq=sq + dat(j)**2
|
|
enddo
|
|
avesq=sq/jz
|
|
basevb=dB(avesq) - 44 !Base power level to send back to GUI
|
|
|
|
nz=600
|
|
nstep=jz/nz
|
|
sq=0.
|
|
k=0
|
|
do j=1,nz
|
|
sum=0.
|
|
do n=1,nstep
|
|
k=k+1
|
|
sum=sum+dat(k)**2
|
|
enddo
|
|
sum=sum/nstep
|
|
sq=sq + (sum-avesq)**2
|
|
enddo
|
|
rmspower=sqrt(sq/nz)
|
|
|
|
pick=.false.
|
|
if(istart.gt.1) pick=.true. !This is a mouse-picked decoding
|
|
if(.not.pick .and. (basevb.lt.-15.0 .or. basevb.gt.20.0)) goto 900
|
|
nchan=64 !Save 64 spectral channels
|
|
nstep=221 !Set step size to ~20 ms
|
|
nz=jz/nstep - 1 !# of spectra to compute
|
|
if(.not.pick) then
|
|
MouseButton=0
|
|
jza=jz
|
|
labdat=labdat+1
|
|
endif
|
|
tbest=0.
|
|
NsyncOK=0
|
|
|
|
! If we're in JT65 mode, call the decode65 routines.
|
|
if(mode.eq.2) then
|
|
! if(rmspower.gt.34000.0) go to 900 !Reject very noisy data
|
|
! Check for a JT65 shorthand message
|
|
nstest=0
|
|
if(ntx2.ne.1) call short65(dat,jz,NFreeze,MouseDF,
|
|
+ DFTolerance,mode65,nspecial,nstest,dfsh,iderrsh,
|
|
+ idriftsh,snrsh,ss1,ss2,nwsh)
|
|
! Lowpass filter and decimate by 2
|
|
call lpf1(dat,jz,jz2)
|
|
jz=jz2
|
|
nadd=1
|
|
fzap(1)=0.
|
|
if(nzap.eq.1) call avesp2(dat,jz,nadd,f0a,NFreeze,MouseDF,
|
|
+ DFTolerance,fzap)
|
|
if(nzap.eq.1.and.nstest.eq.0) call bzap(dat,jz,nadd,mode,fzap)
|
|
|
|
i=index(MyCall,char(0))
|
|
if(i.le.0) i=index(MyCall,' ')
|
|
mycall=MyCall(1:i-1)//' '
|
|
i=index(HisCall,char(0))
|
|
if(i.le.0) i=index(HisCall,' ')
|
|
hiscall=HisCall(1:i-1)//' '
|
|
|
|
! Offset data by about 1 s.
|
|
if(jz.ge.126*2048) call wsjt65(dat(4097),jz-4096,cfile6,
|
|
+ NClearAve,MinSigdB,DFTolerance,NFreeze,NAFC,mode65,Nseg,
|
|
+ MouseDF,NAgain,naggressive,ndepth,neme,nsked,
|
|
+ mycall,hiscall,hisgrid,lumsg,lcum,nspecial,ndf,
|
|
+ nstest,dfsh,iderrsh,idriftsh,snrsh,
|
|
+ NSyncOK,ccf,psavg,ndiag,nwsh)
|
|
goto 900
|
|
endif
|
|
|
|
! If we're in JT6M mode, call the 6M decoding routines.
|
|
if(mode.eq.4) then
|
|
do i=1,jz !### Why is it level-sensitive?
|
|
dat(i)=dat(i)/25.0
|
|
enddo
|
|
! For waterfall plot
|
|
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
|
|
if(jz/11025.0.lt.3.9) go to 900
|
|
call syncf0(dat,jz,DFTolerance,jstart,f0,smax)
|
|
if(NFreeze.eq.1) f0=1076.66
|
|
call synct(dat,jz,jstart,f0,smax)
|
|
call syncf1(dat,jz,jstart,f0,NFreeze,smax,red)
|
|
|
|
f0a=f0
|
|
do i=1,512
|
|
ccf(i-6)=dB(red(i))
|
|
enddo
|
|
df=11025./256.
|
|
do i=1,64
|
|
sum=0.
|
|
do k=8*i-7,8*i
|
|
sum=sum+red(k)
|
|
enddo
|
|
psavg(i)=5.0*sum
|
|
fac=1.0
|
|
freq=i*df
|
|
if(freq.gt.2500.0) fac=((freq-2500.)/20.0)**(-1.0)
|
|
psavg(i)=fac*psavg(i)
|
|
psavg(i+64)=0.001
|
|
enddo
|
|
|
|
jz=jz-jstart+1
|
|
nslim=MinSigdB
|
|
NFixLen=0
|
|
call decode6m(dat(jstart),jz,cfile6,nslim,istart,
|
|
+ NFixLen,lcum,f0,lumsg,npkept,yellow)
|
|
if(npkept.eq.0) f0a=0.
|
|
|
|
if(pick) then
|
|
do i=1,216
|
|
ps0(i)=yellow0(i)
|
|
enddo
|
|
else
|
|
ps0(216)=yellow(216)
|
|
yellow0(216)=yellow(216)
|
|
do i=1,215
|
|
ps0(i)=2*yellow(i)
|
|
yellow0(i)=ps0(i)
|
|
enddo
|
|
endif
|
|
goto 800
|
|
endif
|
|
|
|
! We're in FSK441 mode. Compute the 2D spectrum.
|
|
df=11025.0/256.0 !FFT resolution ~43 Hz
|
|
dtbuf=nstep/11025.0
|
|
stlim=nslim2 !Single-tone threshold
|
|
call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma)
|
|
nline0=nline
|
|
STfound=.false.
|
|
npkept=0
|
|
|
|
C Look for single-tone messages
|
|
if((.not.pick) .or. MouseButton.eq.1) then
|
|
call stdecode(s2,nchan,nz,sigma,dtbuf,df,stlim,
|
|
+ DFTolerance,cfile6,pick,istart)
|
|
endif
|
|
if(nline.gt.nline0) STfound=.true. !ST message(s) found
|
|
|
|
C Now the multi-tone decoding
|
|
call mtdecode(dat,jz,s2,nchan,nz,MinSigdB,MinWidth,
|
|
+ NQRN,DFTolerance,istart,pick,MouseButton,NSaveCum,
|
|
+ cfile6,ps0)
|
|
|
|
npkept=nline !Number of pings that were kept
|
|
call indexx(npkept,tping,indx) !Merge the ST and MT decodes
|
|
smax=0.
|
|
stbest=.false.
|
|
do i=1,npkept
|
|
j=indx(i)
|
|
if(pick .and. STFound .and.
|
|
+ line(j)(29:31).eq.' ') goto 10
|
|
write(lumsg,1050) line(j) !Write to decoded.txt
|
|
1050 format(a79)
|
|
if(lcum) write(21,1050) line(j) !Write to decoded.cum
|
|
read(line(j),1060) sig,msg3
|
|
1060 format(16x,f3.0,9x,a3)
|
|
if(sig.gt.smax) then
|
|
smax=sig
|
|
tbest=tping(j)
|
|
stbest = (msg3.ne.' ')
|
|
endif
|
|
10 enddo
|
|
|
|
dt=1.0/11025.0 !Compute spectrum for pink curve
|
|
if(stbest) then
|
|
jj=nint(tbest/dt)
|
|
call spec441(dat(jj),1102,ps0,f0)
|
|
endif
|
|
|
|
800 continue
|
|
call s2shape(s2,nchan,nz,tbest)
|
|
|
|
900 continue
|
|
end file 11
|
|
LDecoded = ((NSyncOK.gt.0) .or. npkept.gt.0)
|
|
|
|
return
|
|
end
|