SPEED
MAKE_MECH_PROP_CASE_010.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine make_mech_prop_case_010 (rho, lambda, mu, gamma, qs, qp, xs, ys, zs, depth, zs_all, vs30, thickness, sub_tag_all)
 Makes not-honoring technique.
 

Function/Subroutine Documentation

◆ make_mech_prop_case_010()

subroutine make_mech_prop_case_010 ( real*8, intent(out)  rho,
real*8, intent(out)  lambda,
real*8, intent(out)  mu,
real*8, intent(out)  gamma,
real*8, intent(out)  qs,
real*8, intent(out)  qp,
real*8, intent(in)  xs,
real*8, intent(in)  ys,
real*8, intent(in)  zs,
real*8, intent(in)  depth,
real*8, intent(in)  zs_all,
real*8, intent(in)  vs30,
real*8, intent(in)  thickness,
integer*4  sub_tag_all 
)

Makes not-honoring technique.

Mechanical properties given node by node.

Definition at line 23 of file MAKE_MECH_PROP_CASE_010.f90.

26
27 real*8, intent(out) :: rho, lambda, mu, gamma, qs, qp
28 real*8, intent(in) :: xs, ys, zs, depth, zs_all,&
29 vs30, thickness
30 integer*4 :: sub_tag_all
31 real*8 :: ni, vs, vp, depth_real
32
33 rho = 0.d0;
34 lambda = 0.d0;
35 mu = 0.d0;
36 gamma = 0.d0;
37 qs = 0.d0;
38 qp = 0.d0
39
40
41 if ((depth .ge. 0.0d0) .and. (zs_all .ge. 0.0d0)) then
42 if (depth.le.300.0d0) then ! 0 < z < 300
43 rho = 1700.0d0
44 lambda = 2.9700e+08 !Vs = 300 m/s
45 mu = 1.5300e+08 !Vp = 596 m/s
46 gamma = 2.9920e-02 ! Qs = 70 (2 Hz)
47
48 elseif ((depth.gt.300.0d0).and.(depth.le.700.0d0)) then ! 300 < z < 700
49 rho = 2000.0d0
50 lambda = 3.0000e+09 !Vs = 1000 m/s
51 mu = 2.0000e+09 !Vp = 1871 m/s
52 gamma = 2.0944e-02 ! Qs = 100 (2 Hz)
53
54 elseif ((depth.gt.700.0d0)) then ! 700 < z < 1500
55 rho = 2300.0d0
56 lambda = 1.1178e+10 !Vs = 1800 m/s
57 mu = 7.4520e+09 !Vp = 3368 m/s
58 gamma = 2.0944e-02 ! Qs = 100 (2 Hz)
59 endif
60 else
61 ! + MATERIAL INSIDE THE BEDROCK (Vs=3175 m/s)
62 lambda = 2.6217e+10
63 mu = 2.6217e+10
64 rho = 2600.0d0
65 gamma = 1.0472e-02
66 endif
67
68
69

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: