SPEED
MAKE_MECH_PROP_CASE_021.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_021(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
34 rho = 0.d0;
35 lambda = 0.d0;
36 mu = 0.d0;
37 gamma = 0.d0;
38 qs = 0.d0;
39 qp = 0.d0
40
41 if(zs .lt. -2000) then
42 vs = 2100
43 vp = 3500
44 rho = 2200
45 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
46 mu = rho * vs**2.d0;
47 qs = 0.1d0*vs;
48 gamma = 4.d0*datan(1.d0)/qs;
49 else
50 if( vs30 .gt. 600.d0) then
51 vs = vs30 + 5*dsqrt(depth)
52 vp = vs*1.6d0
53 rho = 1800.d0 + 5.d0*dsqrt(depth);
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
59 elseif( vs30 .le. 600.d0 .and. zs_all .ge. 0.d0) then
60 vs = vs30 + 10*dsqrt(depth);
61 vp = vs*1.6d0
62 rho = 1530.d0 + 5.d0*dsqrt(depth);
63 mu = rho * vs**2.d0;
64 qs = 0.1d0*vs;
65 gamma = 4.d0*datan(1.d0)/qs;
66
67 elseif( vs30 .le. 600.d0 .and. zs_all .lt. 0.d0) then
68 vs = 800 + 10*dsqrt(depth);
69 vp = 2000.d0 + 15.d0*dsqrt(depth);
70 rho = 1800.d0 + 5.d0*dsqrt(depth);
71 mu = rho * vs**2.d0;
72 qs = 0.1d0*vs;
73 gamma = 4.d0*datan(1.d0)/qs;
74 endif
75 endif
76
77 !left
78 if(dabs(xs - 415552) .le. 2000.d0) then
79 vs = 2100
80 vp = 3500
81 rho = 2200
82 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
83 mu = rho * vs**2.d0;
84 qs = 0.1d0*vs;
85 gamma = 4.d0*datan(1.d0)/qs;
86! !right
87 elseif(dabs(xs - 484516) .le. 2000.d0) then
88 vs = 2100
89 vp = 3500
90 rho = 2200
91 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
92 mu = rho * vs**2.d0;
93 qs = 0.1d0*vs;
94 gamma = 4.d0*datan(1.d0)/qs;
95! !up
96 elseif(dabs(ys - 4447869) .le. 2000.d0) then
97 vs = 2100
98 vp = 3500
99 rho = 2200
100 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
101 mu = rho * vs**2.d0;
102 qs = 0.1d0*vs;
103 gamma = 4.d0*datan(1.d0)/qs;
104! !down
105 elseif(dabs(ys - 4379160) .le. 2000.d0) then
106 vs = 2100
107 vp = 3500
108 rho = 2200
109 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
110 mu = rho * vs**2.d0;
111 qs = 0.1d0*vs;
112 gamma = 4.d0*datan(1.d0)/qs;
113 endif
114 !if (check_case .eq. 1) write(1000,*) xs,ys,zs, VS, VP
115
116
117
118
119
120 end subroutine make_mech_prop_case_021
make_mech_prop_case_021
subroutine make_mech_prop_case_021(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_021.f90:27