SPEED
Functions/Subroutines
MAKE_MECH_PROP_CASE_033.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine make_mech_prop_case_033 (rho, lambda, mu, gamma, qs, qp, xs, ys, zs, depth, zs_all, vs30, thickness, sub_tag_all)
 Makes not-honoring technique.
 

Function/Subroutine Documentation

◆ make_mech_prop_case_033()

subroutine make_mech_prop_case_033 ( real*8, intent(out)  rho,
real*8, intent(out)  lambda,
real*8, intent(out)  mu,
real*8, intent(out)  gamma,
real*8, intent(out)  qs,
real*8, intent(out)  qp,
real*8, intent(in)  xs,
real*8, intent(in)  ys,
real*8, intent(in)  zs,
real*8, intent(in)  depth,
real*8, intent(in)  zs_all,
real*8, intent(in)  vs30,
real*8, intent(in)  thickness,
integer*4  sub_tag_all 
)

Makes not-honoring technique.

Mechanical properties given node by node.

Definition at line 24 of file MAKE_MECH_PROP_CASE_033.f90.

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
46 if ((depth .ge. 0.0d0) .and. (zs_all .ge. 0.0d0)) then
47 ! I am between -300 meter and the ZE surface
48
49 !- between -300 and -800 metri
50 if(dabs(zs) .le. 800.d0) then
51 vs = 523.d0;
52 vp = 1988.d0;
53 rho = 2050.d0;
54 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
55 mu = rho * vs**2.d0;
56 qs = vs/10.d0;
57 qp = vp/10.d0
58 gamma = 4.d0*datan(1.d0)*5.d0/qs;
59
60 ! between -800 and -1200
61 elseif(dabs(zs) .le. 1200.d0) then
62 vs = 600.d0;
63 vp = vs * 3.2d0;
64 rho = 2050.d0;
65 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
66 mu = rho * vs**2.d0;
67 qs = vs/10.d0;
68 qp = vp/10.d0
69 gamma = 4.d0*datan(1.d0)*5.d0/qs;
70
71 ! between -1200 and -1800
72 elseif(dabs(zs) .le. 1800.d0) then
73 vs = 1515.d0;
74 vp = vs * 2.d0;
75 rho = 2400.d0;
76 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
77 mu = rho * vs**2.d0;
78 qs = vs/10.d0;
79 qp = vp/10.d0
80 gamma = 4.d0*datan(1.d0)*5.d0/qs;
81
82 ! betweeen -1800 and -2800
83 elseif(dabs(zs) .le. 2800.d0) then
84 vs = 2850.d0;
85 vp = 5100.d0;
86 rho = 2450.d0;
87 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
88 mu = rho * vs**2.d0;
89 qs = vs/10.d0;
90 qp = vp/10.d0
91 gamma = 4.d0*datan(1.d0)*5.d0/qs;
92
93 ! between -2800 and -3100
94 elseif(dabs(zs) .le. 3100.d0) then
95 vs = 2300.d0;
96 vp = 3900.d0;
97 rho = 2450.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 ! else
105 else
106 vs = 2600.d0;
107 vp = 4500.d0;
108 rho = 2650.d0;
109 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
110 mu = rho * vs**2.d0;
111 qs = vs/10.d0;
112 qp = vp/10.d0
113 gamma = 4.d0*datan(1.d0)*5.d0/qs;
114 endif
115
116 else ! I am under the ZE surface
117 ! between -1800 and -2800
118 if(dabs(zs) .le. 2800.d0) then
119 vs = 2850.d0;
120 vp = 5100.d0;
121 rho = 2450.d0;
122 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
123 mu = rho * vs**2.d0;
124 qs = vs/10.d0;
125 qp = vp/10.d0
126 gamma = 4.d0*datan(1.d0)*5.d0/qs;
127
128 ! between -2800 and -3100
129 elseif(dabs(zs) .le. 3100.d0) then
130 vs = 2300.d0;
131 vp = 3900.d0;
132 rho = 2450.d0;
133 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
134 mu = rho * vs**2.d0;
135 qs = vs/10.d0;
136 qp = vp/10.d0
137 gamma = 4.d0*datan(1.d0)*5.d0/qs;
138
139 ! else
140 else
141 vs = 2600.d0;
142 vp = 4500.d0;
143 rho = 2650.d0;
144 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
145 mu = rho * vs**2.d0;
146 qs = vs/10.d0;
147 qp = vp/10.d0
148 gamma = 4.d0*datan(1.d0)*5.d0/qs;
149
150 endif
151
152 endif
153
154
155

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: