SPEED
MAKE_MECH_PROP_CASE_031.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine make_mech_prop_case_031 (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_031()

subroutine make_mech_prop_case_031 ( 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_031.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 real*8, dimension(1) :: val1
34
35 rho = 0.d0;
36 lambda = 0.d0;
37 mu = 0.d0;
38 gamma = 0.d0;
39 qs = 0.d0;
40 qp = 0.d0
41
42 !-------------------------------------------------------------------
43 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 1st Layer
44 ! from ground surface to PE_B
45
46 if (sub_tag_all.eq.1) then
47
48 !val1(1) = maxval((/ 200.d0, 90.d0 + 80.d0*dabs(zs)**0.30/))
49 vs = 150 + 40*dabs(zs)**(0.4);
50 vp = vs*4.5d0;
51 rho = 1800.d0;
52 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
53 mu = rho * vs**2.d0;
54 qs = vs/10.d0;
55 qp = vp/10.d0
56 gamma = 4.d0*datan(1.d0)*5.d0/qs; !CHECK f0 = 5Hz => FMAX in file.mate
57
58 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 2nd Layer
59 ! from PE_B to NU_B
60 elseif (sub_tag_all.eq.2) then
61 val1(1) = minval((/ 600.d0,360.d0+0.68*dabs(zs) /));
62 vs = val1(1);
63 vp = vs * 3.8d0;
64 rho = 2050.d0;
65 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
66 mu = rho * vs**2.d0;
67 qs = vs/10.d0;
68 qp = vp/10.d0
69 gamma = 4.d0*datan(1.d0)*5.d0/qs;
70
71
72 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 3rd Layer
73 ! from NU_B to NS_B
74 elseif (sub_tag_all.eq.3) then
75 vs = 600.d0;
76 vp = vs * 3.2d0;
77 rho = 2050.d0;
78 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
79 mu = rho * vs**2.d0;
80 qs = vs/10.d0;
81 qp = vp/10.d0
82 gamma = 4.d0*datan(1.d0)*5.d0/qs;
83
84
85 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 4th Layer
86 ! CK
87 elseif (sub_tag_all.eq.4) then
88 !VS = 365.d0 + 1.15*dabs(zs);
89 vs = 2090.d0;
90 if (dabs(zs) .le. 1200.d0) vs = 1515.d0
91
92 vp = vs * 2.d0;
93 rho = 2400.d0;
94 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
95 mu = rho * vs**2.d0;
96 qs = vs/10.d0;
97 qp = vp/10.d0
98 gamma = 4.d0*datan(1.d0)*5.d0/qs;
99 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 5th Layer
100 ! ZE
101 elseif (sub_tag_all.eq.5) then
102 vs = 2850.d0;
103 vp = 5100.d0;
104 rho = 2450.d0;
105 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
106 mu = rho * vs**2.d0;
107 qs = vs/10.d0;
108 qp = vp/10.d0
109 gamma = 4.d0*datan(1.d0)*5.d0/qs;
110 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 6th Layer
111 ! RO (reservoir)
112 elseif (sub_tag_all.eq.6) then
113 vs = 2300.d0;
114 vp = 3900.d0;
115 rho = 2450.d0;
116 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
117 mu = rho * vs**2.d0;
118 qs = vs/10.d0;
119 qp = qp/10.d0
120 gamma = 4.d0*datan(1.d0)*5.d0/qs;
121 else ! LI (halfspace)
122 vs = 2600.d0;
123 vp = 4500.d0;
124 rho = 2650.d0;
125 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
126 mu = rho * vs**2.d0;
127 qs = vs/10.d0;
128 qp = vp/10.d0
129 gamma = 4.d0*datan(1.d0)*5.d0/qs;
130 endif
131
132 !
133 !-------------------------------------------------------------------
134
135
136

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: