Makes not-honoring technique.
Mechanical properties given node by node.
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
44
45
46 if (sub_tag_all.eq.1) then
47
48
49 vs = 150 + 40*dabs(zs)**(0.4);
50 vp = vs*4.5d0;
51 rho = 1800.d0;
52 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
53 mu = rho * vs**2.d0;
54 qs = vs/10.d0;
55 qp = vp/10.d0
56 gamma = 4.d0*datan(1.d0)*5.d0/qs;
57
58
59
60 elseif (sub_tag_all.eq.2) then
61 val1(1) = minval((/ 600.d0,360.d0+0.68*dabs(zs) /));
62 vs = val1(1);
63 vp = vs * 3.8d0;
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
72
73
74 elseif (sub_tag_all.eq.3) then
75 vs = 600.d0;
76 vp = vs * 3.2d0;
77 rho = 2050.d0;
78 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
79 mu = rho * vs**2.d0;
80 qs = vs/10.d0;
81 qp = vp/10.d0
82 gamma = 4.d0*datan(1.d0)*5.d0/qs;
83
84
85
86
87 elseif (sub_tag_all.eq.4) then
88
89 vs = 2090.d0;
90 if (dabs(zs) .le. 1200.d0) vs = 1515.d0
91
92 vp = vs * 2.d0;
93 rho = 2400.d0;
94 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
95 mu = rho * vs**2.d0;
96 qs = vs/10.d0;
97 qp = vp/10.d0
98 gamma = 4.d0*datan(1.d0)*5.d0/qs;
99
100
101 elseif (sub_tag_all.eq.5) then
102 vs = 2850.d0;
103 vp = 5100.d0;
104 rho = 2450.d0;
105 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
106 mu = rho * vs**2.d0;
107 qs = vs/10.d0;
108 qp = vp/10.d0
109 gamma = 4.d0*datan(1.d0)*5.d0/qs;
110
111
112 elseif (sub_tag_all.eq.6) then
113 vs = 2300.d0;
114 vp = 3900.d0;
115 rho = 2450.d0;
116 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
117 mu = rho * vs**2.d0;
118 qs = vs/10.d0;
119 qp = qp/10.d0
120 gamma = 4.d0*datan(1.d0)*5.d0/qs;
121 else
122 vs = 2600.d0;
123 vp = 4500.d0;
124 rho = 2650.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 endif
131
132
133
134
135
136