SPEED
Functions/Subroutines
MAKE_MECH_PROP_CASE_038.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine make_mech_prop_case_038 (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_038()

subroutine make_mech_prop_case_038 ( 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,
real*8, intent(in)  sub_tag_all 
)

Makes not-honoring technique.

Mechanical properties given node by node.

Definition at line 24 of file MAKE_MECH_PROP_CASE_038.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, sub_tag_all
31 real*8 :: ni, vs, vp, depth_real
32 real*8 :: vs_ini, vs_fin, z_ini, z_fin, vp_ini, vp_fin, rho_ini, rho_fin
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 ((depth .ge. 0.0d0).and.(zs_all .ge. 0.0d0)) then
42
43 ! + MATERIAL INSIDE THE BASIN
44
45 z_ini=0
46 z_fin=500
47
48 vs_ini=300
49 vs_fin=1500
50 vs=vs_ini+(vs_fin-vs_ini)*((depth-z_ini)/(z_fin-z_ini))**(1/2)
51
52 vp_ini=550
53 vp_fin=2300
54 vp=vp_ini+(vp_fin-vp_ini)*((depth-z_ini)/(z_fin-z_ini))**(1/2)
55
56 rho = 1950
57
58 lambda = rho * (vp**2 - 2*vs**2)
59 mu = rho * vs**2
60 qs = vs/10
61 gamma = (3.1415*1.0)/qs
62
63 else
64 ! + MATERIAL INSIDE THE BEDROCK - FIRST LAYER OF CRUSTAL MODEL
65 ! Depth_real = zs
66
67 vs = 2100
68 vp = 3400
69 rho = 2000
70 lambda = rho * (vp**2 - 2*vs**2)
71 mu = rho * vs**2
72 qs = 200
73 gamma = (3.1415*1.0)/qs
74
75 endif
76
77
78
79

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: