$ IF ( x( 2 ) < 5000.0 ) THEN $ ELSE $ ! Homogeneous half-space $ xt = 2.0 * ( 5000.0 - 1300.0 ) / 1300.0 $ c = C0 * ( 1.0 + 0.00737 * ( xt - 1.0 + EXP( -xt ) ) ) $ cimag = 0.0 $ cz = 0.0 $ czz = 0.0 $ END IF
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=8), | intent(in) | :: | x(2) | |||
real(kind=8), | intent(in) | :: | t(2) | |||
real(kind=8), | intent(out) | :: | c | |||
real(kind=8), | intent(out) | :: | cimag | |||
real(kind=8), | intent(out) | :: | gradc(2) | |||
real(kind=8), | intent(out) | :: | crr | |||
real(kind=8), | intent(out) | :: | crz | |||
real(kind=8), | intent(out) | :: | czz | |||
real(kind=8), | intent(out) | :: | rho |
SUBROUTINE Analytic( x, t, c, cimag, gradc, crr, crz, czz, rho ) REAL (KIND=8), INTENT( IN ) :: x( 2 ) REAL (KIND=8), INTENT( IN ) :: t( 2 ) ! ray tangent; for edge cases of updating segments REAL (KIND=8), INTENT( OUT ) :: c, cimag, gradc( 2 ), crr, crz, czz, rho REAL (KIND=8) :: c0, cr, cz, DxtDz, xt iSegz = 1 c0 = 1500.0 rho = 1.0 ! homogeneous halfspace was removed since BELLHOP needs to get gradc just a little below the boundaries, on ray reflection !!$ IF ( x( 2 ) < 5000.0 ) THEN xt = 2.0 * ( x( 2 ) - 1300.0 ) / 1300.0 DxtDz = 2.0 / 1300.0 c = C0 * ( 1.0 + 0.00737*( xt - 1.0 + EXP( -xt ) ) ) cimag = 0. cz = C0 * 0.00737 * ( 1.0 - EXP( -xt ) ) * DxtDz czz = C0 * 0.00737 * EXP( -xt ) * DxtDz ** 2 !!$ ELSE !!$ ! Homogeneous half-space !!$ xt = 2.0 * ( 5000.0 - 1300.0 ) / 1300.0 !!$ c = C0 * ( 1.0 + 0.00737 * ( xt - 1.0 + EXP( -xt ) ) ) !!$ cimag = 0.0 !!$ cz = 0.0 !!$ czz = 0.0 !!$ END IF cr = 0.0 gradc = [ cr, cz ] crz = 0.0 crr = 0.0 RETURN END SUBROUTINE Analytic