SPEED
MAKE_MECH_PROP_CASE_013.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_013(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 if ((depth.ge.0.0d0).and.(zs_all.ge.0.0d0)) then
41 ! + MATERIAL INSIDE THE BASIN
42 if(depth .le. 150.0d0) then
43 vs = 340.d0
44 vp = 1500.d0
45 rho = 1800.d0
46 lambda = rho * (vp**2 - 2*vs**2)
47 mu = rho * vs**2
48 gamma = (3.1415*(2.d0/3.d0))/(35.d0) !hy: fpeak = 2/3 Hz
49
50 elseif (depth .le. 500.0d0) then
51 vs = 800.d0
52 vp = 1800.d0
53 rho = 2100.d0
54 lambda = rho * (vp**2 - 2*vs**2)
55 mu = rho * vs**2
56 gamma = (3.1415*(2/3))/(80.d0)
57
58 elseif(depth .le. 1000.0d0) then
59 vs = 1200.d0
60 vp = 2300.d0
61 rho = 2100.d0
62 lambda = rho * (vp**2 - 2*vs**2)
63 mu = rho * vs**2
64 gamma = (3.1415*(2/3))/(250.d0)
65
66 elseif(depth .le. 3000.0d0) then
67 vs = 2100.d0
68 vp = 3500.d0
69 rho = 2200.d0
70 lambda = rho * (vp**2 - 2*vs**2)
71 mu = rho * vs**2
72 gamma = (3.1415*(2/3))/(200.d0)
73 elseif(depth .le. 6000.0d0) then
74 vs = 2750.d0
75 vp = 4750.d0
76 rho = 2400.d0
77 lambda = rho * (vp**2 - 2*vs**2)
78 mu = rho * vs**2
79 gamma = (3.1415*(2/3))/(250.d0)
80
81 else
82 vs = 3670.d0
83 vp = 6340.d0
84 rho = 2800.d0
85 lambda = rho * (vp**2 - 2*vs**2)
86 mu = rho * vs**2
87 gamma = (3.1415*(2/3))/(350.d0)
88 endif
89
90 endif
91
92
93
94
95
96 end subroutine make_mech_prop_case_013
make_mech_prop_case_013
subroutine make_mech_prop_case_013(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_013.f90:26