SPEED
MAKE_MECH_PROP_CASE_016.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_016(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
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( vs30 .lt. 325.d0) then
42 if ( depth .le. 160.d0) then
43 vs = 250.d0 + 43.d0*depth**(0.5d0);
44 vp = 700.d0 + 45.d0*depth**(0.5d0);
45 rho = 1800.d0;
46 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
47 mu = rho * vs**2.d0;
48 qs = 0.1d0*vs;
49 gamma = 4.d0*datan(1.d0)/qs;
50 elseif(depth .le. 2000.d0) then
51 vs = 800.d0 + 37.13d0*(depth-160d0)**(0.5)
52 vp = vs*1.6;
53 rho = 1800 + 12.92d0*(depth-160d0)**(0.5);
54 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
55 mu = rho * vs**2.d0;
56 qs = 0.1d0*vs;
57 gamma = 4.d0*datan(1.d0)/qs;
58 else
59 vs = 1350.d0 + 23.33*(depth)**(0.5);
60 vp = vs*1.6;
61 rho = 2100 + 5.69*(depth)**(0.5);
62 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
63 mu = rho * vs**2.d0;
64 qs = 0.1*vs;
65 gamma = 4.d0*datan(1.d0)/qs;
66 endif
67
68 elseif (vs30 .lt. 500.d0) then
69
70 if ( depth .le. 80.d0) then
71 vs = 325.d0 + 30.74*depth**(0.5);
72 vp = 800.d0 + 42 *depth**(0.5);;
73 rho = 1850.d0;
74 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
75 mu = rho * vs**2.d0;
76 qs = 0.1*vs;
77 gamma = 4.d0*datan(1.d0)/qs;
78 elseif(depth .le. 120.d0) then
79 vs = 600.d0 + 31.62*(depth-80.d0)**(0.5);
80 vp = 1175.d0 + 26.72*(depth-80.d0)**(0.5);
81 rho = 1850.d0
82 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
83 mu = rho * vs**2.d0;
84 qs = 0.1*vs;
85 gamma = 4.d0*datan(1.d0)/qs;
86 elseif(depth .le. 250.d0) then
87 vs = 800.d0 + 40.75*(depth-120.d0)**(0.5);
88 vp = vs*1.6;
89 rho = 1850.d0 + 9.64*(depth-120.d0)**(0.5);
90 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
91 mu = rho * vs**2.d0;
92 qs = 0.1*vs;
93 gamma = 4.d0*datan(1.d0)/qs;
94 elseif(depth .le. 2000.d0) then
95 vs = 700.d0 + 38.14*(depth-30.d0)**(0.5);
96 vp = vs*1.6;
97 rho = 1960.d0 + 9.43*(depth-250.d0)**(0.5);
98 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
99 mu = rho * vs**2.d0;
100 qs = 0.1*vs;
101 gamma = 4.d0*datan(1.d0)/qs;
102
103 else
104 vs = 1350.d0 + 23.33*(depth)**(0.5);
105 vp = vs*1.6;
106 rho = 2100 + 5.69*(depth)**(0.5);
107 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
108 mu = rho * vs**2.d0;
109 qs = 0.1*vs;
110 gamma = 4.d0*datan(1.d0)/qs;
111 endif
112
113 elseif (vs30 .lt. 700.d0) then
114
115 if ( depth .le. 50.d0) then
116 vs = 500.d0 + 42.42*depth**(0.5);
117 vp = 900.d0 + 42.42*depth**(0.5);
118 rho = 1900.d0;
119 lambda = rho * (vp**2 - 2*vs**2);
120 mu = rho * vs**2;
121 qs = 0.1*vs;
122 gamma = 4.d0*datan(1.d0)/qs;
123 elseif ( depth .le. 250.d0) then
124 vs = 800.d0 + 33.1*(depth-50.d0)**(0.5);
125 vp = vs*1.6;
126 rho = 1900.d0 + 4.89*(depth-50.d0)**(0.5);
127 lambda = rho * (vp**2 - 2*vs**2);
128 mu = rho * vs**2;
129 qs = 0.1*vs;
130 gamma = 4.d0*datan(1.d0)/qs;
131
132 elseif(depth .le. 2000.d0) then
133 vs = 700.d0 + 38.14*(depth-30.d0)**(0.5);
134 vp = vs*1.6;
135 rho = 1960.d0 + 9.43*(depth-250.d0)**(0.5);
136 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
137 mu = rho * vs**2.d0;
138 qs = 0.1*vs;
139 gamma = 4.d0*datan(1.d0)/qs;
140 else
141 vs = 1350.d0 + 23.33*(depth)**(0.5);
142 vp = vs*1.6;
143 rho = 2100 + 5.69*(depth)**(0.5);
144 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
145 mu = rho * vs**2.d0;
146 qs = 0.1*vs;
147 gamma = 4.d0*datan(1.d0)/qs;
148 endif
149
150 elseif (vs30 .lt. 900.d0) then
151
152 if ( depth .le. 4000.d0) then
153 vs = 700.d0 + 37.9*(depth)**(0.5)
154 vp = vs*1.6;
155 rho = 1960.d0 + 8.885*(depth)**(0.5)
156 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
157 mu = rho * vs**2;
158 qs = 0.1*vs;
159 gamma = 4.d0*datan(1.d0)/qs;
160 else
161 vs = 1350.d0 + 23.33*(depth)**(0.5);
162 vp = vs*1.6;
163 rho = 2100 + 5.69*(depth)**(0.5);
164 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
165 mu = rho * vs**2.d0;
166 qs = 0.1*vs;
167 gamma = 4.d0*datan(1.d0)/qs;
168 endif
169
170 elseif (vs30 .lt. 1350.d0) then
171
172 if ( depth .le. 2000.d0) then
173 vs = 900.d0 + 33.38 * (depth)**(0.5);
174 vp = vs*1.6;
175 rho = 2050.d0 + 215.1*(depth*0.001)**(0.5);
176 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
177 mu = rho * vs**2.d0;
178 qs = 0.1*vs;
179 gamma = 4.d0*atan(1.d0)/qs;
180 else
181 vs = 1350.d0 + 23.33*(depth)**(0.5);
182 vp = vs*1.6;
183 rho = 2100 + 5.69*(depth)**(0.5);
184 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
185 mu = rho * vs**2.d0;
186 qs = 0.1*vs;
187 gamma = 4.d0*datan(1.d0)/qs;
188 endif
189
190 else
191 vs = 1350.d0 + 23.33*(depth)**(0.5);
192 vp = vs*1.6;
193 rho = 2100 + 5.69*(depth)**(0.5);
194 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
195 mu = rho * vs**2.d0;
196 qs = 0.1*vs;
197 gamma = 4.d0*datan(1.d0)/qs;
198
199 endif
200
201 ! specific for 2019.09.26 earthquake -- validation
202 !stat_id1_x = 6.3269e+05; stat_id1_y = 4.5422e+06;
203 !stat_id2_x = 6.5450e+05; stat_id2_y = 4.5376e+06;
204 !
205 !if( ((xs(ic)-stat_id1_x)**2.d0 + (ys(ic)-stat_id1_y)**2.d0) .le. 3000 .or. &
206 ! ((xs(ic)-stat_id2_x)**2.d0 + (ys(ic)-stat_id2_y)**2.d0) .le. 3000 ) then
207 ! if ( Depth .le. 150.d0) then
208 ! VS = 600.d0;
209 ! VP = 900.d0;
210 ! rho = 1900.d0;
211 ! lambda = rho * (VP**2 - 2*VS**2);
212 ! mu = rho * VS**2;
213 ! qs = 0.1*VS;
214 ! gamma = 4.d0*datan(1.d0)/qs;
215 ! elseif ( Depth .le. 250.d0) then
216 ! VS = 800.d0 + 33.1*(Depth-50.d0)**(0.5);
217 ! VP = VS*1.6;
218 ! rho = 1900.d0 + 4.89*(Depth-50.d0)**(0.5);
219 ! lambda = rho * (VP**2 - 2*VS**2);
220 ! mu = rho * VS**2;
221 ! qs = 0.1*VS;
222 ! gamma = 4.d0*datan(1.d0)/qs;
223 !
224 ! elseif(Depth .le. 2000.d0) then
225 ! VS = 700.d0 + 38.14*(Depth-30.d0)**(0.5);
226 ! VP = VS*1.6;
227 ! rho = 1960.d0 + 9.43*(Depth-250.d0)**(0.5);
228 ! lambda = rho * (VP**2.d0 - 2.d0*VS**2.d0);
229 ! mu = rho * VS**2.d0;
230 ! qs = 0.1*VS;
231 ! gamma = 4.d0*datan(1.d0)/qs;
232 ! else
233 ! VS = 1350.d0 + 23.33*(Depth)**(0.5);
234 ! VP = VS*1.6;
235 ! rho = 2100 + 5.69*(Depth)**(0.5);
236 ! lambda = rho * (VP**2.d0 - 2.d0*VS**2.d0);
237 ! mu = rho * VS**2.d0;
238 ! qs = 0.1*VS;
239 ! gamma = 4.d0*datan(1.d0)/qs;
240 ! endif
241 !
242 !
243 !endif
244
245
246 !left
247 if(dabs(xs - 576059.d0) .le. 2000.d0) then
248 vs = 3490.d0;
249 vp = 5770.d0;
250 rho = 2600.d0;
251 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
252 mu = rho * vs**2.d0;
253 qs = 0.1*vs;
254 gamma = 4.d0*atan(1.d0)/qs;
255 !right
256 elseif(dabs(xs - 740948.d0) .le. 2000.d0) then
257 vs = 3490.d0;
258 vp = 5770.d0;
259 rho = 2600.d0;
260 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
261 mu = rho * vs**2.d0;
262 qs = 0.1*vs;
263 gamma = 4.d0*atan(1.d0)/qs;
264 !up
265 elseif(dabs(ys - 4602206.d0) .le. 2000.d0) then
266 vs = 3490.d0;
267 vp = 5770.d0;
268 rho = 2600.d0;
269 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
270 mu = rho * vs**2.d0;
271 qs = 0.1*vs;
272 gamma = 4.d0*atan(1.d0)/qs;
273 !down
274 elseif(dabs(ys - 4502679.d0) .le. 2000.d0) then
275 vs = 3490.d0;
276 vp = 5770.d0;
277 rho = 2600.d0;
278 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
279 mu = rho * vs**2.d0;
280 qs = 0.1*vs;
281 gamma = 4.d0*atan(1.d0)/qs;
282 endif
283
284
285
286 end subroutine make_mech_prop_case_016
make_mech_prop_case_016
subroutine make_mech_prop_case_016(rho, lambda, mu, gamma, qs, qp, xs, ys, zs, depth, zs_all, vs30, thickness, sub_tag_all)
Makes not-honoring technique.
Definition MAKE_MECH_PROP_CASE_016.f90:26