MODULE MOD_FUNC
! module contains functions for P and S-wave velocities, density and
! quality factors in sediments (1st layer)
IMPLICIT NONE
CONTAINS
!==================== 1D INHOMOGENEOUS MEDIUM =========================
!------------------------------------------------- P or S-wave velocity
FUNCTION FUNCV (Z)
USE NRTYPE, ONLY: WP
REAL(WP), INTENT(IN) :: Z
REAL(WP) :: FUNCV
if (z<5) then
!layer
funcv = 180
else if(5<=z<18) then
!layer
funcv = 200
else if(18<=z<54) then
!layer
funcv = 360
else if(54<=z<92) then
!layer
funcv = 400
else if(92<=z<130) then
!layer
funcv = 440
else if(130<=z<165) then
!layer
funcv = 460
else
!halfspace
funcv = 970
end if
END FUNCTION FUNCV
!--------------------------------------------------------------- Density
FUNCTION FUNCRHO (Z)
USE NRTYPE, ONLY: WP
REAL(WP), INTENT(IN) :: Z
REAL(WP) :: FUNCRHO
if(z<5) then
!layer
funcrho = 1220
else if(5<=z<18) then
!layer
funcrho = 1487
else if(18<=z<54) then
!layer
funcrho = 1945
else if(54<=z<92) then
!layer
funcrho = 1966
else if(92<=z<130) then
!layer
funcrho = 1966
else if(130<=z<165) then
!layer
funcrho = 1966
else
!halfspace
funcrho = 2123
end if
END FUNCTION FUNCRHO
!------------------------------------------- P or S-wave quality factor
FUNCTION FUNCQ (Z)
USE NRTYPE, ONLY: WP
REAL(WP), INTENT(IN) :: Z
REAL(WP) :: FUNCQ
if(z<165) then
!layer
funcq = 50
else
!halfspace
funcq = 10000
end if
END FUNCTION FUNCQ
END MODULE
2019-11-13 19-02-53 的屏幕截图.png (69.85 KB, 下载次数: 329)
出现这种错误
FUNCTION FUNCRHO (Z)
USE NRTYPE, ONLY: WP
REAL(WP), INTENT(IN) :: Z
REAL(WP) :: FUNCRHO
Real(WP) , parameter :: zList(*) = [-huge(z),5._WP,18._WP,54._WP,92._WP,130._WP,165._WP,huge(z)]
Real(WP) , parameter :: fList(*) = [1220._WP,1487._WP,1945._WP,1966._WP,1966._WP,1966._WP,2123._WP]
integer :: i
Do i = 1 , size(zList)-1
if( zList(i) <= z .and. z < zList(i+1) ) then
funcRho = fList(i)
return
end if
End Do
END FUNCTION FUNCRHO
fcode 发表于 2019-11-14 09:01
其实你的函数可以简化一下。
[mw_shl_code=fortran,true] FUNCTION FUNCRHO (Z)
USE NRTYPE, ONLY: WP ...
欢迎光临 Fortran Coder (http://bbs.fcode.cn/) | Powered by Discuz! X3.2 |