SPEED
Functions/Subroutines
MAKE_MECH_PROP_CASE_045.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine make_mech_prop_case_045 (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_045()

subroutine make_mech_prop_case_045 ( 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, intent(in)  sub_tag_all 
)

Makes not-honoring technique.

Mechanical properties given node by node.

Definition at line 24 of file MAKE_MECH_PROP_CASE_045.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 real*8 :: ni, vs, vp, depth_real
32 integer*4, intent(in) :: sub_tag_all
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 ! + MATERIAL INSIDE THE CLAY BASIN - 1st Layer
45
46 if (sub_tag_all.eq.1) then
47
48 vs = 70.d0 + depth *((100.d0-70.d0)/(zs_all+depth+0.1d0));
49 vp = vs * 13.d0;
50 rho = 1400.d0 + depth *((1600.d0-1400.d0)/(zs_all+depth0+0.1d0));
51 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
52 mu = rho * vs**2.d0;
53 qs = 40.d0 + depth *((55.d0-40.d0)/(zs_all+depth+0.1d0));
54 qp = qs*2.d0;
55 gamma = 4.d0*datan(1.d0)/qs;
56
57 ! + MATERIAL INSIDE THE DEEP BASIN - 2nd Layer
58 elseif (sub_tag_all.eq.2) then
59 vs = 500.d0 + 9.6d0 * depth**(0.6d0);
60 vp = 1500.d0 + 19.2d0 * depth**(0.6d0);
61 rho = 1900.d0;
62 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
63 mu = rho * vs**2.d0;
64 qs = vs/6.d0;
65 qp = qs*2.d0;
66 gamma = 4.d0*datan(1.d0)/qs;
67 ! + First 200 m of BEDROCK LAYER
68 elseif (depth .le. 200.0d0) then
69 vs = 750.d0;
70 vp = 1700.d0;
71 rho = 2000.d0;
72 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
73 mu = rho * vs**2.d0;
74 qs = 100.d0;
75 qp = qs*2.d0;
76 gamma = 4.d0*datan(1.d0)/qs;
77 else ! (1st BEDROCK LAYER)
78 vs = 1550.d0;
79 vp = 2782.d0;
80 rho = 2200.d0;
81 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
82 mu = rho * vs**2.d0;
83 qs = vs/10.d0;
84 qp = qs*2.d0;
85 gamma = 4.d0*datan(1.d0)/qs;
86 endif
87
88

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: