25 xs, ys, zs, Depth, zs_all,&
26 vs30, thickness, sub_tag_all)
28 real*8,
intent(out) :: rho, lambda, mu, gamma, qs, qp
29 real*8,
intent(in) :: xs, ys, zs, depth, zs_all,&
31 integer*4 :: sub_tag_all
32 real*8 :: ni, vs, vp, depth_real
33 real*8,
dimension(1) :: val1
45 if (sub_tag_all.eq.1 .or. sub_tag_all.eq.2 )
then
47 if (dabs(zs) .le. 15.d0)
then
51 if (check_case .eq. 1) &
52 write(1000+mpi_id,*) xs,ys,zs, &
54 elseif (dabs(zs) .le. 30.d0)
then
58 if (check_case .eq. 1) &
59 write(1000+mpi_id,*) xs,ys,zs, &
61 elseif (dabs(zs) .le. 50.d0)
then
65 if (check_case .eq. 1) &
66 write(1000+mpi_id,*) xs,ys,zs, &
68 elseif (dabs(zs) .le. 80.d0)
then
72 elseif (dabs(zs) .le. 120.d0)
then
76 elseif (dabs(zs) .le. 180.d0)
then
86 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
90 gamma = 4.d0*datan(1.d0)*5.d0/qs;
94 elseif (sub_tag_all.eq.3)
then
98 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
102 gamma = 4.d0*datan(1.d0)*5.d0/qs;
107 elseif (sub_tag_all.eq.4)
then
110 if (dabs(zs) .le. 1200.d0) vs = 1515.d0
114 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
118 gamma = 4.d0*datan(1.d0)*5.d0/qs;
121 elseif (sub_tag_all.eq.5)
then
125 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
129 gamma = 4.d0*datan(1.d0)*5.d0/qs;
132 elseif (sub_tag_all.eq.6)
then
136 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
140 gamma = 4.d0*datan(1.d0)*5.d0/qs;
145 lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
149 gamma = 4.d0*datan(1.d0)*5.d0/qs;
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.