WSJT-X/libm65/specjtms.f90

subroutine specjtms(k,px,pxsmo,spk0,f0)

! Compute noise level and 2D spectra, for GUI display.

  parameter (NSMAX=30*48000)
  parameter (MAXFFT=8192)
  integer*2 id
  real x(MAXFFT)
  complex cx(MAXFFT),cx2(MAXFFT)
  logical first
  common/mscom/id(1440000),s1(215),s2(215),kin,ndiskdat,kline,nutc
  common/jt8com/nn(1800*12000),ss(184,32768),savg(32768)
  data first/.true./
  save
 
  if(first) then
     pi=4.0*atan(1.0)
     twopi=2.0*pi
     kstep=2048
     first=.false.
     sqsmo=0.
  endif

  if(k.lt.kstep .or. k.gt.NSMAX) return

  t=k/48000.0
  nfft=4096
  df=48000.0/nfft
  nh=nfft/2
  ib=k
  ia=k-kstep+1
  i0=k-nfft+1
  sq=0.
  do i=ia,ib
     d=id(i)
     sq=sq + d*d
  enddo
  sq=sq/2048.0
  sqsmo=0.95*sqsmo + 0.05*sq
  rms=sqrt(sq)
  px=db(sq) - 23.0
  pxsmo=db(sqsmo) - 23.0

  if(i0.gt.0) then
     do i=i0,ia-1
        d=id(i)
        sq=sq + d*d
     enddo
  endif
  sq0=sq
!  write(13,1010) t,rms,sq,px,pxsmo
!1010 format(5f12.3)
  if(k.lt.nfft) return


  x(1:nfft)=id(i0:ib)
  fac=0.002/nfft
  cx=fac*x
  call four2a(cx,nfft,1,-1,1)                    !Forward c2c FFT

  iz=nint(2500.0/df)

  do i=1,iz                                      !Save spectrum for plot
     s1(i)=real(cx(i+1))**2 + aimag(cx(i+1))**2
  enddo

  cx(1)=0.5*cx(1)
  cx(nh+2:nfft)=0.
  call four2a(cx,nfft,1,1,1)                     !Inverse c2c FFT

  cx2(1:nfft)=cx(1:nfft)*cx(1:nfft)
  cx2(nfft+1:)=0.0

  nfft=8192
  df=48000.0/nfft
  
  call four2a(cx2,nfft,1,-1,1)                   !Forward c2c FFT of cx2

!  j0=nint(2.0*1428.57/df)
  j0=nint(2.0*1500.0/df)
  ja=j0-107
  jb=j0+107
  do j=ja,jb
     s2(j-ja+1)=1.e-4*(real(cx2(j))**2 + aimag(cx2(j))**2)
  enddo

  spk0=0.
  fac=(5e8/sq0)**2
  s2=fac*s2
  do j=1,215
     if(s2(j).gt.spk0) then
        spk0=s2(j)
        f=(j+ja-1)*df
        f0=0.5*(f-3000.0)
        phi0=0.5*atan2(aimag(cx2(j)),real(cx2(j)))
     endif
  enddo

  spk0=0.5*db(spk0) - 7.0
  kline=k/2048
!  write(14,3001) k/2048,spk0,f0,phi0
!3001 format(i8,3f12.3)
!  call flush(14)

  return
end subroutine specjtms