2012-07-12 20:45:43 -04:00
|
|
|
subroutine specjtms(k,px,pxsmo,spk0,f0)
|
2012-07-09 12:00:08 -04:00
|
|
|
|
2012-07-13 11:54:03 -04:00
|
|
|
! Compute noise level and 2D spectra, for GUI display.
|
2012-07-09 12:00:08 -04:00
|
|
|
|
|
|
|
parameter (NSMAX=30*48000)
|
2012-07-12 20:45:43 -04:00
|
|
|
parameter (MAXFFT=8192)
|
2012-07-09 12:00:08 -04:00
|
|
|
integer*2 id
|
2012-07-12 20:45:43 -04:00
|
|
|
real x(MAXFFT)
|
|
|
|
complex cx(MAXFFT),cx2(MAXFFT)
|
|
|
|
logical first
|
2012-07-13 09:37:50 -04:00
|
|
|
common/mscom/id(1440000),s1(215),s2(215),kin,ndiskdat,kline
|
2012-07-09 12:00:08 -04:00
|
|
|
data first/.true./
|
|
|
|
save
|
2012-07-12 20:45:43 -04:00
|
|
|
|
2012-07-09 12:00:08 -04:00
|
|
|
if(first) then
|
|
|
|
pi=4.0*atan(1.0)
|
2012-07-10 09:43:16 -04:00
|
|
|
twopi=2.0*pi
|
2012-07-12 20:45:43 -04:00
|
|
|
kstep=2048
|
2012-07-09 12:00:08 -04:00
|
|
|
first=.false.
|
2012-07-12 20:45:43 -04:00
|
|
|
sqsmo=0.
|
2012-07-09 12:00:08 -04:00
|
|
|
endif
|
|
|
|
|
2012-07-13 12:45:26 -04:00
|
|
|
if(k.lt.kstep .or. k.gt.NSMAX) return
|
|
|
|
|
2012-07-12 20:45:43 -04:00
|
|
|
t=k/48000.0
|
|
|
|
nfft=4096
|
|
|
|
df=48000.0/nfft
|
|
|
|
nh=nfft/2
|
2012-07-09 12:00:08 -04:00
|
|
|
ib=k
|
2012-07-12 15:10:39 -04:00
|
|
|
ia=k-kstep+1
|
|
|
|
i0=k-nfft+1
|
2012-07-09 12:00:08 -04:00
|
|
|
sq=0.
|
|
|
|
do i=ia,ib
|
2012-07-12 20:45:43 -04:00
|
|
|
d=id(i)
|
|
|
|
sq=sq + d*d
|
2012-07-09 12:00:08 -04:00
|
|
|
enddo
|
2012-07-12 20:45:43 -04:00
|
|
|
sq=sq/2048.0
|
|
|
|
sqsmo=0.95*sqsmo + 0.05*sq
|
|
|
|
rms=sqrt(sq)
|
|
|
|
px=db(sq) - 23.0
|
|
|
|
pxsmo=db(sqsmo) - 23.0
|
2012-07-13 11:00:23 -04:00
|
|
|
|
2012-07-13 12:45:26 -04:00
|
|
|
if(i0.gt.0) then
|
|
|
|
do i=i0,ia-1
|
|
|
|
d=id(i)
|
|
|
|
sq=sq + d*d
|
|
|
|
enddo
|
|
|
|
endif
|
2012-07-13 11:00:23 -04:00
|
|
|
sq0=sq
|
2012-07-12 20:45:43 -04:00
|
|
|
! write(13,1010) t,rms,sq,px,pxsmo
|
|
|
|
!1010 format(5f12.3)
|
2012-07-12 15:10:39 -04:00
|
|
|
if(k.lt.nfft) return
|
2012-07-09 12:00:08 -04:00
|
|
|
|
|
|
|
|
2012-07-12 20:45:43 -04:00
|
|
|
x(1:nfft)=id(i0:ib)
|
|
|
|
fac=0.002/nfft
|
2012-07-09 12:00:08 -04:00
|
|
|
cx=fac*x
|
|
|
|
call four2a(cx,nfft,1,-1,1) !Forward c2c FFT
|
|
|
|
|
2012-07-12 20:45:43 -04:00
|
|
|
iz=nint(2500.0/df)
|
|
|
|
|
2012-07-09 12:00:08 -04:00
|
|
|
do i=1,iz !Save spectrum for plot
|
2012-07-12 20:45:43 -04:00
|
|
|
s1(i)=real(cx(i+1))**2 + aimag(cx(i+1))**2
|
2012-07-09 12:00:08 -04:00
|
|
|
enddo
|
|
|
|
|
|
|
|
cx(1)=0.5*cx(1)
|
|
|
|
cx(nh+2:nfft)=0.
|
|
|
|
call four2a(cx,nfft,1,1,1) !Inverse c2c FFT
|
|
|
|
|
2012-07-12 20:45:43 -04:00
|
|
|
cx2(1:nfft)=cx(1:nfft)*cx(1:nfft)
|
|
|
|
cx2(nfft+1:)=0.0
|
|
|
|
|
|
|
|
nfft=8192
|
|
|
|
df=48000.0/nfft
|
|
|
|
|
2012-07-09 12:00:08 -04:00
|
|
|
call four2a(cx2,nfft,1,-1,1) !Forward c2c FFT of cx2
|
|
|
|
|
2012-07-13 12:45:26 -04:00
|
|
|
! j0=nint(2.0*1428.57/df)
|
|
|
|
j0=nint(2.0*1500.0/df)
|
2012-07-12 20:45:43 -04:00
|
|
|
ja=j0-107
|
|
|
|
jb=j0+107
|
2012-07-09 12:00:08 -04:00
|
|
|
do j=ja,jb
|
2012-07-13 11:00:23 -04:00
|
|
|
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
|
2012-07-09 12:00:08 -04:00
|
|
|
f0=0.5*(f-3000.0)
|
2012-07-10 09:43:16 -04:00
|
|
|
phi0=0.5*atan2(aimag(cx2(j)),real(cx2(j)))
|
2012-07-09 12:00:08 -04:00
|
|
|
endif
|
|
|
|
enddo
|
2012-07-13 11:00:23 -04:00
|
|
|
|
2012-07-12 20:45:43 -04:00
|
|
|
spk0=0.5*db(spk0) - 7.0
|
2012-07-13 09:37:50 -04:00
|
|
|
kline=k/2048
|
2012-07-12 20:45:43 -04:00
|
|
|
! write(14,3001) k/2048,spk0,f0,phi0
|
|
|
|
!3001 format(i8,3f12.3)
|
2012-07-13 09:37:50 -04:00
|
|
|
! call flush(14)
|
2012-07-09 12:00:08 -04:00
|
|
|
|
2012-07-12 20:45:43 -04:00
|
|
|
return
|
2012-07-09 12:00:08 -04:00
|
|
|
end subroutine specjtms
|