SPEED
Functions/Subroutines
GET_NODE_DEPTH_AND_VS.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine get_node_depth_and_vs (loc_n_num, nn_elev, nn_elem, xx_elev, yy_elev, zz_elev, v
 Computes elevation from topography (XYZ.out), vs30 velocity and depth of sediments according to the input file VS_RS.out.
 

Function/Subroutine Documentation

◆ get_node_depth_and_vs()

subroutine get_node_depth_and_vs ( integer*4, dimension(nn_s)  loc_n_num,
integer*4  nn_elev,
integer*4  nn_elem,
real*8, dimension(nn_elev)  xx_elev,
real*8, dimension(nn_elev)  yy_elev,
real*8, dimension(nn_elev)  zz_elev,
real*8  v 
)

Computes elevation from topography (XYZ.out), vs30 velocity and depth of sediments according to the input file VS_RS.out.

Note
See MAKE_NOT_HONORING.f90
Author
Ilario Mazzieri
Date
September, 2013
Version
1.0
Parameters
[in]loc_n_numlocal numeration vector
[in]nn_elevnumber nodes in the triangular grid
[in]x_elevelevation values of local nodes
[in]y_elevelevation values of local nodes
[in]z_elevelevation values of local nodes
[in]nn_elemnumber of triangular elements
[in]node1_elemindex triangle vertex
[in]node2_elemindex triangle vertex
[in]node3_elemindex triangle vertex
[in]cs_nnx_loclength cs_loc
[in]cs_loclocal connectivity vector
[in]nmnumber of materials
[in]tmlabels for material vector
[in]sdpolynomial degree vector
[in]nn_snumber of local nodes
[in]xx_svertex x- coordinate of local nodes
[in]yy_svertex y- coordinate of local nodes
[in]zz_svertex z- coordinate of local nodes
[in]tagmatspecific material tag given in CASE option
[in]max_esmax topography spacing
[in]toltolerance given in CASE option
[in]zz_alluvialelevation of the nodes from alluvial soil
[out]zz_elevationelevation of the nodes from complex topography
[out]vsvs30 velocity for the nodes
[out]thicknessthickenss of sediments along z-direction

Definition at line 52 of file GET_NODE_DEPTH_AND_VS.f90.

54 node1_elem, node2_elem, node3_elem, &
55 cs_nnz_loc, cs_loc, nm, tm, sd, &
56 nn_s, xx_s, yy_s, zz_s, &
57 zz_elevation, zz_alluvial, vs, thickness, &
58 tagmat, max_es,tol)
59
60 implicit none
61
62 integer*4 :: im,ie,i,j,k,nn,ip,isn,ic
63 integer*4 :: nn_elev, nn_elem, cs_nnz_loc, nm, ne, nn_s
64 integer*4 :: h, h_sel
65 integer*4 :: tagmat
66
67 integer*4, dimension(nn_s) :: loc_n_num
68 integer*4, dimension(nn_elem) :: node1_elem,node2_elem,node3_elem
69 integer*4, dimension(nm) :: tm
70 integer*4, dimension(nm) :: sd
71 integer*4, dimension(0:cs_nnz_loc) :: cs_loc
72
73 real*8 :: x1,y1,z1
74 real*8 :: x2,y2,z2
75 real*8 :: x3,y3,z3
76 real*8 :: ux,uy,uz,vx,vy,vz
77 real*8 :: a,b,c
78 real*8 :: max_es
79 real*8 :: zz_interp
80 real*8 :: v0x,v0y,v1x,v1y,v2x,v2y
81 real*8 :: dot00,dot01,dot02,dot11,dot12
82 real*8 :: invdenom,u,v
83 real*8 :: d2min
84 real*8 :: zz_elev_min
85 real*8 :: dx,dy,dz,tol, dist, dist_min
86
87 real*8, dimension(:), allocatable :: ct,ww
88 real*8, dimension(nn_elev) :: xx_elev,yy_elev,zz_elev
89 real*8, dimension(nn_elem) :: vs_elev,sediments
90 real*8, dimension(nn_s) :: xx_s,yy_s,zz_s
91 real*8, dimension(nn_s) :: zz_elevation
92 real*8, dimension(nn_s) :: zz_alluvial
93 real*8, dimension(nn_s) :: vs, thickness
94
95 real*8, dimension(:,:), allocatable :: dd
96
97 d2min = (5 * max_es)**2
98
99 zz_elev_min = zz_elev(1)
100 do i = 1,nn_elev
101 if (zz_elev(i).lt.zz_elev_min) then
102 zz_elev_min = zz_elev(i)
103 endif
104 enddo
105 !write(*,*) d2min, max_es
106
107
108 ne = cs_loc(0) - 1
109
110 do ie = 1,ne
111
112 im = cs_loc(cs_loc(ie -1) +0)
113
114 if (im .eq. tagmat) then
115
116 nn = sd(im) +1
117 allocate(ct(nn),ww(nn),dd(nn,nn))
118 call make_lgl_nw(nn,ct,ww,dd)
119
120
121 do k = 1,nn
122 do j = 1,nn
123 do i = 1,nn
124
125 ip = nn*nn*(k -1) +nn*(j -1) +i
126 isn = cs_loc(cs_loc(ie -1) + ip)
127 ic = isn
128
129 dist_min = 1.d+30;
130 h_sel = 0;
131 do h = 1,nn_elem
132
133
134 x1 = xx_elev(node1_elem(h))
135 y1 = yy_elev(node1_elem(h))
136 z1 = zz_elev(node1_elem(h))
137
138 dist = (x1 - xx_s(ic))**2 + (y1 - yy_s(ic))**2
139 if (dist .le. dist_min) then
140 h_sel = h;
141 dist_min = dist;
142 endif
143 enddo
144
145 !write(*,*) h_sel
146 !read(*,*)
147 x1 = xx_elev(node1_elem(h_sel))
148 y1 = yy_elev(node1_elem(h_sel))
149 z1 = zz_elev(node1_elem(h_sel))
150
151 x2 = xx_elev(node2_elem(h_sel))
152 y2 = yy_elev(node2_elem(h_sel))
153 z2 = zz_elev(node2_elem(h_sel))
154
155 x3 = xx_elev(node3_elem(h_sel))
156 y3 = yy_elev(node3_elem(h_sel))
157 z3 = zz_elev(node3_elem(h_sel))
158
159
160 zz_interp = (z1 + z2 + z3)/3.d0
161 zz_elevation(ic) = ( zz_interp - zz_s(ic) )
162 vs(ic) = vs_elev(h_sel)
163 thickness(ic) = sediments(h_sel)
164
165 if(zz_elevation(ic) .le. tol) then
166 zz_elevation(ic) = 0.0d0
167 vs(ic) = vs_elev(h_sel)
168 thickness(ic) = sediments(h_sel)
169 endif
170
171
172
173
174 enddo !do k = 1,nn
175 enddo !do j = 1,nn
176 enddo !do i = 1,nn
177
178 deallocate(ct,ww,dd)
179
180 endif !if im.eq.tagmat
181 enddo
182
183
184 return
185
make_lgl_nw
subroutine make_lgl_nw(nb_pnt, xq, wq, dd)
Makes Gauss-Legendre-Lobatto nodes, weigths and spectral derivatives.
Definition MAKE_LGL_NW.f90:29

References make_lgl_nw().

Referenced by make_nothonoring().

Here is the call graph for this function:
Here is the caller graph for this function: