program fspg
use MKL_DFTI
integer i,j,n1,n2
complex,allocatable ::sp(:),tt(:),xx(:,:)
double precision,allocatable ::amp(:),ff(:),fst(:),freal(:),aw(:),spg(:),spl(:)
double precision temp,p0,fs,finala,sensitivity
type(DFTI_DESCRIPTOR), POINTER :: My_Desc1_Handle
integer :: Status
open(unit=1,file='data.dat',status='old',access='sequential',form='formatted')
open(unit=2,file='awei.dat',status='old',access='sequential',form='formatted')
open(unit=3,file='aweighting.dat',status='old',access='sequential',form='formatted')
write(*,*)'请输入采集数据总数'
read(*,*)n1
write(*,*)'请输入灵敏度(mV/Pa)'
read(*,*)sensitivity
allocate(xx(n1,2),sp(n1),tt(n1),amp(n1),ff(n1),fst(n2),freal(n2*2),aw(n2),spg(n2),spl(n1))
do 100,i=1,n1,1
read(1,*)xx(i,1),xx(i,2)
tt(i)=xx(i,2)/sensitivity
sp(i)=0.0
100 continue
fs=n1/(xx(n1,1)-xx(1,1))
write(*,*)'信号采样频率为',fs,'Hz'
do 110,i=1,34,1
read(2,*)fst(i),aw(i)
110 continue
n2=0
do 120,i=1,34,1
if(fs/2.0 .gt. fst(i))then
n2=n2+1
endif
120 continue
temp=0.0
p0=2.0*10**(-5.0)
do 130,i=1,n1,1
temp=temp+tt(i)
130 continue
do 140,i=1,n1,1
tt(i)=tt(i)-temp/n1
140 continue
Status=DftiCreateDescriptor(My_Desc1_Handle,DFTI_SINGLE,DFTI_COMPLEX,1,n1)
Status=DftiSetValue(My_Desc1_Handle,DFTI_PLACEMENT,DFTI_NOT_INPLACE)
Status=DftiCommitDescriptor(My_Desc1_Handle)
Status=DftiComputeForward(My_Desc1_Handle,tt,sp)
Status=DftiFreeDescriptor(My_Desc1_Handle)
do 150,i=1,n1/2,1
amp(i)=abs(sp(i))*2.0/n1
ff(i)=(i-1.0)*fs/n1
150 continue
temp=0.0
do 160,j=1,n2,1
freal(2*j-1)=(1.0/2.0**(1.0/6.0))*fst(j)
freal(2*j)=2.0**(1.0/6.0)*fst(j)
do 170,i=1,n1/2,1
if(freal(2*j-1) .lt. ff(i) .and. freal(2*j) .gt. ff(i))then
temp=temp+amp(i)**2/2.0
endif
170 continue
write(*,*)temp/p0**2
spg(j)=10*log(temp/p0**2)+aw(j)
temp=0.0
160 continue
do 180,i=1,n2,1
write(*,*)fst(i),spg(i)
write(3,*)fst(i),spg(i)
180 continue
temp=0.0
do 190,i=1,n2,1
temp=temp+10.0**(0.1*(spg(i)))
190 continue
finala=10.0*log(temp)
write(*,*)'合成A声级'
write(*,*)finala
deallocate(xx,sp,tt,amp,ff,fst,freal,aw,spg,spl)
close(1)
close(2)
close(3)
pause
end program fspg
|