WSJT-X/lib/hspec.f90
Bill Somerville 2131414791 Add reference spectrum to equalization plots and more plotting enhancements
Use  a header  format for  polynomial coefficients  that includes  the
valid  X  range  in  scaled  terms  and  a  count  of  the  number  of
coefficients.

Use double  precision consistently  for polynomial  coefficients. This
includes formatting with sufficient DPs when writing to files.

Many changes to the equalization plots, more to come.

Add  error   handling  for   reading  coefficient,  plot   and  filter
files.  This  includes  being  backward  compatible  for  old  format
refspec.dat files with no header.

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@7578 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
2017-02-23 16:21:26 +00:00

98 lines
2.5 KiB
Fortran

subroutine hspec(id2,k,nutc0,ntrpdepth,nrxfreq,ntol,bmsk144,bcontest, &
btrain,pcoeffs,ingain,mycall,hiscall,bshmsg,bswl,datadir,green,s,jh,line1, &
mygrid)
! Input:
! k pointer to the most recent new data
! nutc0 UTC for display of decode(s)
! ntrpdepth TR period and 1000*ndepth
! nrxfreq Rx audio center frequency
! ntol Decoding range is +/- ntol
! bmsk144 Boolean, true if in MSK144 mode
! btrain Boolean, turns on training in MSK144 mode
! ingain Relative gain for spectra
! Output:
! green() power
! s() spectrum for horizontal spectrogram
! jh index of most recent data in green(), s()
parameter (JZ=703)
character*80 line1
character*512 datadir
character*12 mycall,hiscall
character*6 mygrid
integer*2 id2(0:120*12000-1)
logical*1 bmsk144,bcontest,bshmsg,btrain,bswl
real green(0:JZ-1)
real s(0:63,0:JZ-1)
real x(512)
real*8 pcoeffs(5)
complex cx(0:256)
data rms/999.0/,k0/99999999/
equivalence (x,cx)
save ja,rms0
ndepth=ntrpdepth/1000
ntrperiod=ntrpdepth - 1000*ndepth
gain=10.0**(0.1*ingain)
nfft=512
nstep=nfft
nblks=7
if(ntrperiod.lt.30) then
nstep=256
nblks=14
endif
if(k.gt.30*12000) go to 900
if(k.lt.nfft) then
jh=0
go to 900 !Wait for enough samples to start
endif
if(k.lt.k0) then !Start a new data block
ja=-nstep
jh=-1
rms0=0.0
endif
do iblk=1,nblks
if(jh.lt.JZ-1) jh=jh+1
ja=ja+nstep
jb=ja+nfft-1
x=id2(ja:jb)
sq=dot_product(x,x)
rms=sqrt(gain*sq/nfft)
green(jh)=0.
if(rms.gt.0.0) green(jh)=20.0*log10(rms)
call four2a(x,nfft,1,-1,0) !Real-to-complex FFT
df=12000.0/nfft
fac=(1.0/nfft)**2
do i=1,64
j=2*i
sx=real(cx(j))**2 + aimag(cx(j))**2 + real(cx(j-1))**2 + &
aimag(cx(j-1))**2
s(i-1,jh)=fac*gain*sx
enddo
if(ja+2*nfft.gt.k) exit
enddo
k0=k
if(bmsk144) then
if(k.ge.7168) then
tsec=(k-7168)/12000.0
k0=k-7168
tt1=sum(float(abs(id2(k0:k0+3583))))
k0=k-3584
tt2=sum(float(abs(id2(k0:k0+3583))))
if(tt1.ne.0.0 .and. tt2.ne.0) then
call mskrtd(id2(k-7168+1:k),nutc0,tsec,ntol,nrxfreq,ndepth, &
mycall,mygrid,hiscall,bshmsg,bcontest,btrain,pcoeffs,bswl,&
datadir,line1)
endif
endif
endif
900 return
end subroutine hspec