SPEED
MAKE_MECH_PROP_CASE_011.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_011(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 ((depth .ge. 0.0d0) .and. (zs_all .ge. 0.0d0)) then
42
43 if (depth .lt. 15.0d0) then
44
45 vs = 270.d0
46 ni = 0.45d0
47 vp = (((2.0d0*(1.0d0 - ni))/(1.0d0-2.0d0*ni))**0.5)*vs
48 rho = 1700.d0
49 lambda = rho * (vp**2 - 2*vs**2)
50 mu = rho * vs**2
51 gamma = (3.1415*(2/3))/(70.d0)
52
53 elseif (depth .lt. 50.0d0) then
54
55 vs = 270.d0+11.5d0*(depth-15.d0)
56 ni = 0.45 - 0.0025*(depth-15.d0)
57 vp = (((2.0d0*(1.0d0 - ni))/(1.0d0-2.0d0*ni))**0.5)*vs
58 rho = 1700.d0 + 5.d0*(depth-15.d0)
59 lambda = rho * (vp**2 - 2*vs**2)
60 mu = rho * vs**2
61 gamma = (3.1415*(2/3))/(70.d0+0.5d0*(depth-15.d0))
62
63 else
64
65 vs= 270.d0 + 11.5d0*(50.d0-15.d0) + 0.7d0*(depth-50)
66 ni= 0.45d0 - 0.0025d0*(50.d0-15.d0) - 0.000075d0*(depth-50)
67 vp = (((2.0d0*(1.0d0 - ni))/(1.0d0-2.0d0*ni))**0.5)*vs
68 rho= 1700.d0 - 5.d0*(50.d0-15.d0) +0.5d0*(depth-50)
69 lambda = rho * (vp**2 - 2*vs**2)
70 mu = rho * vs**2
71 gamma = (3.1415*(2/3))/(70.d0 + 0.5d0*(50.d0-15.d0) + 0.0775d0*(depth-50))
72
73 endif
74
75 else
76 depth_real = abs(zs)
77
78 if (depth_real .lt. 15.0d0) then
79
80 vs = 750.d0
81 ni = 0.30d0
82 vp = (((2.0d0*(1.0d0 - ni))/(1.0d0-2.0d0*ni))**0.5)*vs
83 rho = 2000.d0
84 lambda = rho * (vp**2 - 2*vs**2)
85 mu = rho * vs**2
86 gamma = (3.1415*(2/3))/(100.d0)
87
88 elseif (depth_real .lt. 50.0d0) then
89
90 vs = 750.d0+14.d0*(depth_real-15.d0)
91 ni = 0.30d0 - 0.0005d0*(depth_real-15.d0)
92 vp = (((2.0d0*(1.0d0 - ni))/(1.0d0-2.0d0*ni))**0.5)*vs
93 rho = 2000.d0 + 6.5d0*(depth_real-15.d0)
94 lambda = rho * (vp**2 - 2*vs**2)
95 mu = rho * vs**2
96 gamma = (3.1415*(2/3))/(100.d0+0.8d0*(depth_real-15.d0))
97
98 else
99
100 vs= 750.d0 + 14.d0*(50.d0-15.d0) + 1.1d0*(depth_real-50)
101 ni= 0.30d0 - 0.0005d0*(50.d0-15.d0) - 0.000022d0*(depth_real-50)
102 vp = (((2.0d0*(1.0d0 - ni))/(1.0d0-2.0d0*ni))**0.5)*vs
103 rho= 2000.d0 + 6.5d0*(50.d0-15.d0) + 0.26d0*(depth_real-50)
104 lambda = rho * (vp**2 - 2*vs**2)
105 mu = rho * vs**2
106 gamma = (3.1415*(2/3))/(100.d0 + 0.8d0*(50.d0-15.d0) + 0.049d0*(depth_real-50))
107
108 endif
109 endif
110
111
112 end subroutine make_mech_prop_case_011
make_mech_prop_case_011
subroutine make_mech_prop_case_011(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_011.f90:26