SPEED
MAKE_MECH_PROP_CASE_032.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
24 subroutine make_mech_prop_case_032(rho, lambda, mu, gamma, qs, qp, & !outputs
25 xs, ys, zs, Depth, zs_all,&
26 vs30, thickness, sub_tag_all)
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 if (sub_tag_all.eq.1 .or. sub_tag_all.eq.2 ) then
46
47 if (dabs(zs) .le. 15.d0) then
48 vs = 150.d0;
49 vp = 1064.d0;
50 rho = 1800.d0;
51 if (check_case .eq. 1) &
52 write(1000+mpi_id,*) xs,ys,zs, &
53 vs, vp, rho
54 elseif (dabs(zs) .le. 30.d0) then
55 vs = 294.d0;
56 vp = 1321.d0;
57 rho = 1800.d0;
58 if (check_case .eq. 1) &
59 write(1000+mpi_id,*) xs,ys,zs, &
60 vs, vp, rho
61 elseif (dabs(zs) .le. 50.d0) then
62 vs = 332.d0;
63 vp = 1494.d0;
64 rho = 1800.d0;
65 if (check_case .eq. 1) &
66 write(1000+mpi_id,*) xs,ys,zs, &
67 vs, vp, rho
68 elseif (dabs(zs) .le. 80.d0) then
69 vs = 370.d0;
70 vp = 1664.d0;
71 rho = 1800.d0;
72 elseif (dabs(zs) .le. 120.d0) then
73 vs = 408.d0;
74 vp = 1838.d0;
75 rho = 1800.d0;
76 elseif (dabs(zs) .le. 180.d0) then
77 vs = 450.d0;
78 vp = 2024.d0;
79 rho = 1800.d0;
80 else ! NU_B
81 vs = 523.d0;
82 vp = 1988.d0;
83 rho = 2050.d0;
84 endif
85
86 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
87 mu = rho * vs**2.d0;
88 qs = vs/10.d0;
89 qp = vp/10.d0
90 gamma = 4.d0*datan(1.d0)*5.d0/qs;
91
92 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 3rd Layer
93 ! from NU_B to NS_B
94 elseif (sub_tag_all.eq.3) then
95 vs = 600.d0;
96 vp = vs * 3.2d0;
97 rho = 2050.d0;
98 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
99 mu = rho * vs**2.d0;
100 qs = vs/10.d0;
101 qp = vp/10.d0
102 gamma = 4.d0*datan(1.d0)*5.d0/qs;
103
104
105 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 4th Layer
106 ! CK
107 elseif (sub_tag_all.eq.4) then
108
109 vs = 2090.d0;
110 if (dabs(zs) .le. 1200.d0) vs = 1515.d0
111
112 vp = vs * 2.d0;
113 rho = 2400.d0;
114 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
115 mu = rho * vs**2.d0;
116 qs = vs/10.d0;
117 qp = vp/10.d0
118 gamma = 4.d0*datan(1.d0)*5.d0/qs;
119 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 5th Layer
120 ! ZE
121 elseif (sub_tag_all.eq.5) then
122 vs = 2850.d0;
123 vp = 5100.d0;
124 rho = 2450.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 ! + MATERIAL INSIDE THE ALLUVIAL BASIN - 6th Layer
131 ! RO (reservoir)
132 elseif (sub_tag_all.eq.6) then
133 vs = 2300.d0;
134 vp = 3900.d0;
135 rho = 2450.d0;
136 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
137 mu = rho * vs**2.d0;
138 qs = vs/10.d0;
139 qp = vp/10.d0
140 gamma = 4.d0*datan(1.d0)*5.d0/qs;
141 else ! LI (halfspace)
142 vs = 2600.d0;
143 vp = 4500.d0;
144 rho = 2650.d0;
145 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
146 mu = rho * vs**2.d0;
147 qs = vs/10.d0;
148 qp = vp/10.d0
149 gamma = 4.d0*datan(1.d0)*5.d0/qs;
150 endif
151
152
153 end subroutine make_mech_prop_case_032
subroutine make_mech_prop_case_032(rho, lambda, mu, gamma, qs, qp, xs, ys, zs, depth, zs_all, vs30, thickness, sub_tag_all)
Makes not-honoring technique.