SPEED
MAKE_MECH_PROP_CASE_040.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine make_mech_prop_case_040 (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_040()

subroutine make_mech_prop_case_040 ( 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 24 of file MAKE_MECH_PROP_CASE_040.f90.

27
28 real*8, intent(out) :: rho, lambda, mu, gamma, qs, qp
29 real*8, intent(in) :: xs, ys, zs, depth, zs_all,&
30 vs30, thickness
31 integer*4 :: sub_tag_all
32 real*8 :: ni, vs, vp, depth_real
33
34 rho = 0.d0;
35 lambda = 0.d0;
36 mu = 0.d0;
37 gamma = 0.d0;
38 qs = 0.d0;
39 qp = 0.d0
40
41
42
43
44 if ((depth .ge. 0.0d0).and.(zs_all .ge. 0.0d0)) then
45 ! + MATERIAL INSIDE THE BASIN
46 vs = 1
47 vp = 1
48 rho = 1
49 lambda = rho * (vp**2 - 2*vs**2)
50 mu = rho * vs**2
51 qs = 0.1*vs
52 gamma = (pig*(2.d0/3.d0))/qs
53
54 else
55 ! + MATERIAL INSIDE THE BEDROCK
56 depth_real = zs
57 if (depth_real .ge. -500.0d0) then
58 vs = 1
59 vp = 1
60 rho = 1
61 lambda = rho * (vp**2 - 2*vs**2)
62 mu = rho * vs**2
63 qs = 0.1*vs
64 gamma = (pig*(2.d0/3.d0))/qs
65
66
67 elseif (depth_real .le. -500.d0 .and. depth_real .ge. -1000.0d0) then
68 vs = 1
69 vp = 1
70 rho = 1
71 lambda = rho * (vp**2 - 2*vs**2)
72 mu = rho * vs**2
73 qs = 0.1*vs
74 gamma = (pig*(2.d0/3.d0))/qs
75
76
77 else
78 vs = 1;
79 vp = 1;
80 rho = 1;
81 lambda = rho * (vp**2 - 2*vs**2)
82 mu = rho * vs**2
83 qs = 0.1*vs
84 gamma = (pig*(2.d0/3.d0))/qs
85
86
87 endif
88 endif
89
90
91

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: