SPEED
MAKE_MECH_PROP_CASE_035.f90
Go to the documentation of this file.
1! Copyright (C) 2012 The SPEED FOUNDATION
2! Author: Ilario Mazzieri
3!
4! This file is part of SPEED.
5!
6! SPEED is free software; you can redistribute it and/or modify it
7! under the terms of the GNU Affero General Public License as
8! published by the Free Software Foundation, either version 3 of the
9! License, or (at your option) any later version.
10!
11! SPEED is distributed in the hope that it will be useful, but
12! WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14! Affero General Public License for more details.
15!
16! You should have received a copy of the GNU Affero General Public License
17! along with SPEED. If not, see <http://www.gnu.org/licenses/>.
18
19
21
22
23 subroutine make_mech_prop_case_035(rho, lambda, mu, gamma, qs, qp, & !outputs
24 xs, ys, zs, Depth, zs_all,&
25 vs30, thickness, sub_tag_all)
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 real*8 :: vsini, vsfin, zini, zfin, rini, rfin
33 real*8 :: yref
34
35
36 rho = 0.d0;
37 lambda = 0.d0;
38 mu = 0.d0;
39 gamma = 0.d0;
40 qs = 0.d0;
41 qp = 0.d0;
42
43
44 yref = -0.7825*xs + 5032308.5 ! reference line to identify sub basin
45
46 if (vs30 .le. 300.0d0) then
47 vp30 = 1800
48 else
49 vp30 = 2000
50 endif
51
52
53 if ((depth.ge.0.0d0).and.(zs_all.ge.0.0d0)) then
54
55 if (ys .le. yref) then
56
57 ! + MATERIAL INSIDE THE THESS BASIN
58
59 vs = vs30 + (2000.0d0-vs30)*(depth/1000.0d0)**(0.70d0)
60 vp = vp30 + (4500.0d0-vp30)*(depth/1000.0d0)**(0.70d0)
61 rho = 2000.d0 + 0.40d0*depth
62
63
64 if (depth .le. 50.0d0) then
65 qs = 20
66 elseif (depth .le. 200.0d0) then
67 qs = 50
68 elseif (depth .le. 500.0d0) then
69 qs = 100
70 else
71 qs = 150
72 endif
73
74 lambda = rho * (vp**2 - 2*vs**2)
75 mu = rho * vs**2
76 gamma = (3.1415*(2/3))/qs ! max freq of 2 Hz
77
78
79 else
80
81 ! + MATERIAL INSIDE THE MYGDONIAN BASIN
82 ! VS = 150 + 1.625 * (Depth)
83 ! VP = 1500 + 3.00 * (Depth)
84 ! rho = 2075 + 0.4375 * (Depth)
85
86 vs = 200 + 15.0 * (depth)**0.63
87 vp = 1500 + 32.8 * (depth)**0.63
88 rho = 2075 + 0.55 * (depth)
89 lambda = rho * (vp**2 - 2*vs**2)
90 mu = rho * vs**2
91 qs = 0.1*vs
92! gamma = (3.1415*(2/3))/qs
93 gamma = (3.1415*(1))/qs
94 endif
95
96 else
97 ! + MATERIAL INSIDE THE BEDROCK
98
99 ! generic bedrock outcrop with Vs30 = 1500 m/s - from Cotton et al. 2006
100 if (depth .le. 1) then
101 vs = 1144
102 elseif(depth .le. 30) then
103 vsini = 1144
104 vsfin = 1696
105 zini = 1
106 zfin = 30
107 vs = vsini + (vsfin-vsini)*((depth-zini)/(zfin-zini))**0.50 !VS: S velocity in m/s
108 elseif(depth .le. 190) then
109 vsini = 1696
110 vsfin = 2381
111 zini = 30
112 zfin = 190
113 vs = vsini + (vsfin-vsini)*((depth-zini)/(zfin-zini))**0.50 !VS: S velocity in m/s
114 elseif(depth .le. 4000) then
115 vsini = 2381
116 vsfin = 3454
117 zini = 190
118 zfin = 4000
119 vs = vsini + (vsfin-vsini)*((depth-zini)/(zfin-zini))**0.50 !VS: S velocity in m/s
120 else
121 vs = 3440
122 endif
123
124 vp = 2.25*vs !VP: P velocity in m/s - (Poisson = 0.3 approx)
125
126
127 if (depth .le. 100) then
128 rini = 2200;
129 rfin = 2400;
130 zini = 0;
131 zfin = 100;
132 rho = rini + (rfin-rini)*((depth-zini)/(zfin-zini))**0.50 !RHO: MASS DENSITY in kg/m^3
133 elseif(depth .le. 1000) then
134 rini = 2400;
135 rfin = 2700;
136 zini = 100;
137 zfin = 1000;
138 rho = rini + (rfin-rini)*((depth-zini)/(zfin-zini))**0.50 !RHO: MASS DENSITY in kg/m^3
139 else
140 rho = 2700.0d0
141 endif
142
143
144
145 qs = 0.1d0*vs
146
147
148! VS = 2000.d0
149! VP = 4500.d0
150! rho = 2400.d0
151! qs = 200.d0
152
153 lambda = rho * (vp**2 - 2*vs**2)
154 mu = rho * vs**2
155 gamma = (3.1415*(2/3))/qs
156
157
158 endif
159
160
161 end subroutine make_mech_prop_case_035
subroutine make_mech_prop_case_035(rho, lambda, mu, gamma, qs, qp, xs, ys, zs, depth, zs_all, vs30, thickness, sub_tag_all)
Makes not-honoring technique.