.f95地震吸收带程序 - 调试

时间:2015-03-09 16:40:13

标签: fortran

我正在尝试编写一个程序来计算地震波的吸收带模型。整个计算基于3个方程。如果有兴趣,请参见第2页的公式3,4,5: http://www.eri.u-tokyo.ac.jp/people/takeuchi/publications/14EPSL-Iritani.pdf

但是,我已经多次调试过这个程序,但我似乎没有得到预期的答案。我特别试图在下面的程序中计算Q_1变量(地震衰减),它应该是10 ^ -3量级的REAL正值。但是,我得到负值。我需要一双新眼睛来看看程序,并检查我在哪里犯了错误。有人可以检查一下吗?非常感谢 !

PROGRAM absorp

! Calculate an absorption band model and output
! files for plotting. 
! Ref. Iritani et al. (2014), EPSL, 405, 231-243.

! Variable Definition
! Corners - cf1, cf2
! Frequency range - [10^f_strt, 10^(f_end-f_strt)]
! Number of points to be sampled - n
! Angular frequency - w
! Frequency dependent Attenuation 1/Q - Q_1
! Relaxation times - tau1=1/(2*pi*cf1), tau2=1/(2*pi*cf2) 
! Reference velocity - V0 (km/s)
! Attenuation (1/Q) at 1 Hz - Q1_1
! Frequency dependent peak Attenuation (1/Qm) - Qm_1
! Frequency dependent velocity - V_w
! D(omega) numerator - Dw1
! D(omega) denominator - Dw2
! D(omega) - D_w
! D(2pi) - D_2pi

IMPLICIT NONE
REAL ::   cf1 = 2.0e0, cf2 = 1.0e+5
REAL, PARAMETER :: f_strt=-5, f_end=12
INTEGER :: indx
INTEGER, PARAMETER :: n=1e3
REAL, PARAMETER :: pi=4.0*atan(1.0)
REAL, DIMENSION(1:n) :: w, Q_1 
REAL  :: tau1, tau2, V0, freq, pow
REAL :: Q1_1=0.003, Qm_1
COMPLEX, DIMENSION(1:n) :: V_w
COMPLEX, PARAMETER :: i=(0.0,1.0)
COMPLEX :: D_2pi, D_w, Dw1, Dw2

! Reference Velocity km/s
V0 = 12.0
print *, "F1=", cf1, "F2=", cf2, "V0=",V0

! Relaxation times from corners
tau1 = 1.0/(2.0*pi*cf1)
tau2 = 1.0/(2.0*pi*cf2)
PRINT*, "tau1=",tau1, "tau2=",tau2

! Populate angular frequency array (non-linear)
DO indx = 1,n+1
pow = f_strt + f_end*REAL(indx-1)/n
freq=10**pow
w(indx) = 2*pi*freq
print *, w(indx)
END DO

! D(2pi) value
D_2pi = LOG((i*2.0*pi + 1/tau1)/(i*2.0*pi + 1/tau2))

! Calculate 1/Q from eq. 3 and 4
DO indx=1,n

!D(omega)
Dw1 = (i*w(indx) + 1.0/tau1)
Dw2 = (i*w(indx) + 1.0/tau2)
D_w  = LOG(Dw1/Dw2)

!This is eq. 5 for 1/Qm
Qm_1 = 2.0*pi*Q1_1*IMAG(D_w)/                 &
     ((Q1_1**2-4)*IMAG(D_w)**2              &
       + 4*Q1_1*IMAG(D_w)*REAL(D_w))

!This is eq. 3 for Alpha(omega)
V_w(indx) = V0*(SQRT(1.0 + 2.0/pi*Qm_1*D_w)/       &
          REAL(SQRT(1.0 + 2.0/pi*Qm_1*D_2pi)))

!This is eq. 4 for 1/Q
Q_1(indx) = 2*IMAG(V_w(indx))/REAL(V_w(indx))

PRINT *, w(indx)/(2.0*pi), (V_w(indx)), Q_1(indx)
END DO

! write the results out
100 FORMAT(F12.3,3X,F7.3,3X,F8.5)
OPEN(UNIT=1, FILE='absorp.txt', STATUS='replace')

DO indx=1,n
WRITE(UNIT=1,FMT=100), w(indx)/(2.0*pi), REAL(V_w(indx)), Q_1(indx)
END DO
CLOSE(UNIT=1)

END PROGRAM

1 个答案:

答案 0 :(得分:0)

更多关于格式而不是答案的扩展评论......

我还没有检查过您所指的方程式,但我不会这样做,但查看您的代码会让我怀疑错位括号可能是导致错误的原因。当然,正如您在此处所展示的那样,代码的格式不足以显示其逻辑结构。无论你做什么,接下来都会投入一些缩进和一些较长的线来避免过于频繁的破坏。

我个人特别怀疑

!This is eq. 5 for 1/Qm
Qm_1 = 2.0*pi*Q1_1*IMAG(D_w)/                 &
     ((Q1_1**2-4)*IMAG(D_w)**2              &
       + 4*Q1_1*IMAG(D_w)*REAL(D_w))