59 type(
mesh_t),
intent(inout),
target :: msh
61 type(
stack_nh_t),
allocatable :: new_mesh_dist(:)
62 type(
stack_nz_t),
allocatable :: new_zone_dist(:)
63 type(
stack_nc_t),
allocatable :: new_curve_dist(:)
65 type(
nmsh_hex_t),
allocatable :: recv_buf_msh(:)
69 integer,
allocatable :: recv_buf_idx(:), send_buf_idx(:)
70 type(mpi_status) :: status
71 integer :: i, j, k, ierr, max_recv_idx, label
72 integer :: src, dst, recv_size, gdim, tmp, new_el_idx, new_pel_idx
73 integer :: max_recv(3)
82 call msh%reset_periodic_ids()
88 allocate(new_zone_dist(0:
pe_size - 1))
90 call new_zone_dist(i)%init()
93 call redist_zone(msh, msh%periodic, 5, parts, new_zone_dist)
97 call redist_zone(msh, msh%labeled_zones(j), 7, parts, &
104 allocate(new_curve_dist(0:
pe_size - 1))
106 call new_curve_dist(i)%init()
109 call redist_curve(msh, msh%curve, parts, new_curve_dist)
115 allocate(new_mesh_dist(0:(
pe_size - 1)))
117 call new_mesh_dist(i)%init()
121 ep => msh%elements(i)%e
124 el%v(j)%v_idx = ep%pts(j)%p%id()
125 el%v(j)%v_xyz = ep%pts(j)%p%x
127 call new_mesh_dist(parts%data(i))%push(el)
136 max_recv(1) =
max(max_recv(1), new_mesh_dist(i)%size())
137 max_recv(2) =
max(max_recv(2), new_zone_dist(i)%size())
138 max_recv(3) =
max(max_recv(3), new_curve_dist(i)%size())
141 call mpi_allreduce(mpi_in_place, max_recv, 3, mpi_integer, &
144 allocate(recv_buf_msh(max_recv(1)))
145 allocate(recv_buf_zone(max_recv(2)))
146 allocate(recv_buf_curve(max_recv(3)))
155 select type (nmd_array => new_mesh_dist(dst)%data)
157 call mpi_sendrecv(nmd_array, &
158 new_mesh_dist(dst)%size(),
mpi_nmsh_hex, dst, 0, recv_buf_msh, &
161 call mpi_get_count(status,
mpi_nmsh_hex, recv_size, ierr)
164 call new_mesh_dist(
pe_rank)%push(recv_buf_msh(j))
170 select type (nzd_array => new_zone_dist(dst)%data)
172 call mpi_sendrecv(nzd_array, &
173 new_zone_dist(dst)%size(),
mpi_nmsh_zone, dst, 1, recv_buf_zone,&
179 call new_zone_dist(
pe_rank)%push(recv_buf_zone(j))
182 call mpi_sendrecv(new_curve_dist(dst)%array(), &
183 new_curve_dist(dst)%size(),
mpi_nmsh_curve, dst, 2, recv_buf_curve,&
188 call new_curve_dist(
pe_rank)%push(recv_buf_curve(j))
192 deallocate(recv_buf_msh)
193 deallocate(recv_buf_zone)
194 deallocate(recv_buf_curve)
198 call new_mesh_dist(i)%free
199 call new_zone_dist(i)%free
200 call new_curve_dist(i)%free
207 call msh%init(gdim, new_mesh_dist(
pe_rank)%size())
209 call el_map%init(new_mesh_dist(
pe_rank)%size())
210 call glb_map%init(new_mesh_dist(
pe_rank)%size())
215 select type (np => new_mesh_dist(
pe_rank)%data)
217 do i = 1, new_mesh_dist(
pe_rank)%size()
219 p(j) =
point_t(np(i)%v(j)%v_xyz, np(i)%v(j)%v_idx)
221 call msh%add_element(i, np(i)%el_idx, &
222 p(1), p(2), p(3), p(4), p(5), p(6), p(7), p(8))
224 if (el_map%get(np(i)%el_idx, tmp) .gt. 0)
then
227 call el_map%set(np(i)%el_idx, tmp)
230 tmp = msh%elements(i)%e%id()
231 call glb_map%set(np(i)%el_idx, tmp)
233 call neko_error(
'Global element id already defined')
237 call new_mesh_dist(
pe_rank)%free()
248 select type(zp => new_zone_dist(
pe_rank)%data)
250 do i = 1, new_zone_dist(
pe_rank)%size()
251 if (zp(i)%type .eq. 5)
then
252 call pe_lst%push(zp(i)%p_e)
257 max_recv_idx = 2 * pe_lst%size()
258 call mpi_allreduce(mpi_in_place, max_recv_idx, 1, mpi_integer, &
260 allocate(recv_buf_idx(max_recv_idx))
261 allocate(send_buf_idx(max_recv_idx))
270 select type (pe_lst_array => pe_lst%data)
272 call mpi_sendrecv(pe_lst_array, &
273 pe_lst%size(), mpi_integer, dst, 0, recv_buf_idx, &
274 max_recv_idx, mpi_integer, src, 0,
neko_comm, status, ierr)
276 call mpi_get_count(status, mpi_integer, recv_size, ierr)
280 if (glb_map%get(recv_buf_idx(j), tmp) .eq. 0)
then
282 send_buf_idx(k) = recv_buf_idx(j)
284 send_buf_idx(k) = tmp
288 call mpi_sendrecv(send_buf_idx, k, mpi_integer, src, 1, &
289 recv_buf_idx, max_recv_idx, mpi_integer, dst, 1, &
291 call mpi_get_count(status, mpi_integer, recv_size, ierr)
293 do j = 1, recv_size, 2
294 call glb_map%set(recv_buf_idx(j), recv_buf_idx(j+1))
297 deallocate(recv_buf_idx)
298 deallocate(send_buf_idx)
304 select type (zp => new_zone_dist(
pe_rank)%data)
306 do i = 1, new_zone_dist(
pe_rank)%size()
307 if (el_map%get(zp(i)%e, new_el_idx) .gt. 0)
then
308 call neko_error(
'Missing element after redistribution')
310 select case(zp(i)%type)
312 if (glb_map%get(zp(i)%p_e, new_pel_idx) .gt. 0)
then
313 call neko_error(
'Missing periodic element after redistribution')
316 call msh%mark_periodic_facet(zp(i)%f, new_el_idx, &
317 zp(i)%p_f, zp(i)%p_e, zp(i)%glb_pt_ids)
319 call msh%mark_labeled_facet(zp(i)%f, new_el_idx, zp(i)%p_f)
322 do i = 1, new_zone_dist(
pe_rank)%size()
323 if (el_map%get(zp(i)%e, new_el_idx) .gt. 0)
then
324 call neko_error(
'Missing element after redistribution')
326 select case(zp(i)%type)
328 if (glb_map%get(zp(i)%p_e, new_pel_idx) .gt. 0)
then
329 call neko_error(
'Missing periodic element after redistribution')
332 call msh%apply_periodic_facet(zp(i)%f, new_el_idx, &
333 zp(i)%p_f, zp(i)%p_e, zp(i)%glb_pt_ids)
337 call new_zone_dist(
pe_rank)%free()
343 select type (cp => new_curve_dist(
pe_rank)%data)
345 do i = 1, new_curve_dist(
pe_rank)%size()
346 if (el_map%get(cp(i)%e, new_el_idx) .gt. 0)
then
347 call neko_error(
'Missing element after redistribution')
349 call msh%mark_curve_element(new_el_idx, cp(i)%curve_data, cp(i)%type)
352 call new_curve_dist(
pe_rank)%free()