FrontISTR  5.7.1
Large-scale structural analysis program with finit element method
hecmw_adapt_new_cell.f90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
6 
7 !C
8 !C***
9 !C*** hecmw_adapt_NEW_CELL
10 !C***
11 !C
12 !C control NEW_CELL_TETRA/PRISM
13 !C
14 subroutine hecmw_adapt_new_cell (hecMESH)
15 
16  use hecmw_util
17  use hecmw_adapt_int_sr
18  implicit real*8 (a-h,o-z)
19  integer(kind=kint), dimension(:), allocatable :: WR, WS
20  integer(kind=kint), dimension(:), allocatable :: IW1, IW2
21  integer(kind=kint), dimension(:), allocatable :: IW3, IW4
22 
23  type (hecmwST_local_mesh) :: hecMESH
24 
25  !C
26  !C +-------+
27  !C | INIT. |
28  !C +-------+
29  !C===
30  hecmesh%n_adapt_elem_cur= hecmesh%n_elem
31  hecmesh%n_adapt_elem_old= hecmesh%n_elem
32 
33  hecmesh%n_adapt_elem_341_cur= hecmesh%n_adapt_elem_341
34  hecmesh%n_adapt_elem_351_cur= hecmesh%n_adapt_elem_351
35 
36  icoun= 0
37 
38  allocate (hecmesh%adapt_children_local(8*hecmesh%ne_array))
39  hecmesh%adapt_children_local= 0
40  !C===
41 
42  !C
43  !C +------------------+
44  !C | create NEW CELLs |
45  !C +------------------+
46  !C===
47  call hecmw_adapt_new_cell_341 (hecmesh, icoun, &
48  & hecmesh%n_adapt_elem_341_cur)
49  call hecmw_adapt_new_cell_351 (hecmesh, icoun, &
50  & hecmesh%n_adapt_elem_351_cur)
51  !C===
52 
53  !C
54  !C +---------------+
55  !C | GLOBAL CELL # |
56  !C +---------------+
57  !C===
58  hecmesh%n_elem = hecmesh%n_adapt_elem_cur
59  hecmesh%n_adapt_elem_341= hecmesh%n_adapt_elem_341_cur
60  hecmesh%n_adapt_elem_351= hecmesh%n_adapt_elem_351_cur
61 
62  !C
63  !C-- OLD/NEW global CELL #
64 
65  iceltotg_old= 0
66  iceltotg_cur= 0
67 
68  nnn1= hecmesh%ne_internal + icoun
69 
70  call mpi_allreduce (hecmesh%ne_internal, iceltotg_old, 1, &
71  & mpi_integer, mpi_sum, hecmesh%MPI_COMM, ierr)
72  call mpi_allreduce (nnn1 , iceltotg_cur, 1, &
73  & mpi_integer, mpi_sum, hecmesh%MPI_COMM, ierr)
74 
75  if (hecmesh%my_rank.eq.0) then
76  write (*,'(" total cell number (before)", i8 )') iceltotg_old
77  write (*,'(" total cell number (curr. )", i8,/)') iceltotg_cur
78  endif
79  !C===
80 
81  !C
82  !C +-------------------------+
83  !C | exchange CHILDREN-info. |
84  !C +-------------------------+
85  !C===
86  len= max(hecmesh%n_adapt_elem_old, &
87  & hecmesh%adapt_import_elem_index(hecmesh%n_neighbor_pe), &
88  & hecmesh%adapt_export_elem_index(hecmesh%n_neighbor_pe))
89 
90  allocate (iw1(len*8))
91  iw1= 0
92  do icel= 1, hecmesh%n_adapt_elem_old
93  ityp = hecmesh%adapt_type (icel)
94  is = hecmesh%adapt_children_index(icel-1)
95  is1= is + 1
96  is2= is + 2
97  is3= is + 3
98  is4= is + 4
99  is5= is + 5
100  is6= is + 6
101  is7= is + 7
102  is8= is + 8
103  !C
104  !C-- TETRAHEDRA
105  if (hecmesh%elem_type(icel).eq.341) then
106  if (ityp.ne.0) then
107  iw1(8*icel-7)= hecmesh%adapt_children_item(2*is1-1)
108  iw1(8*icel-6)= hecmesh%adapt_children_item(2*is2-1)
109  if (ityp.ge.7) then
110  iw1(8*icel-5)= hecmesh%adapt_children_item(2*is3-1)
111  iw1(8*icel-4)= hecmesh%adapt_children_item(2*is4-1)
112  if (ityp.eq.11) then
113  iw1(8*icel-3)= hecmesh%adapt_children_item(2*is5-1)
114  iw1(8*icel-2)= hecmesh%adapt_children_item(2*is6-1)
115  iw1(8*icel-1)= hecmesh%adapt_children_item(2*is7-1)
116  iw1(8*icel )= hecmesh%adapt_children_item(2*is8-1)
117  endif
118  endif
119  endif
120  endif
121  !C
122  !C-- PRISMs
123  if (hecmesh%elem_type(icel).eq.351) then
124  if (ityp.ne.0) then
125  iw1(8*icel-7)= hecmesh%adapt_children_item(2*is1-1)
126  iw1(8*icel-6)= hecmesh%adapt_children_item(2*is2-1)
127  if (ityp.eq.4) then
128  iw1(8*icel-5)= hecmesh%adapt_children_item(2*is3-1)
129  iw1(8*icel-4)= hecmesh%adapt_children_item(2*is4-1)
130  endif
131  endif
132  endif
133  enddo
134 
135  allocate (ws(8*len), wr(8*len))
136  ws= 0
137  wr= 0
138  call hecmw_adapt_int_send_recv &
139  & ( len, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
140  & hecmesh%adapt_import_elem_index, &
141  & hecmesh%adapt_import_elem_item , &
142  & hecmesh%adapt_export_elem_index, &
143  & hecmesh%adapt_export_elem_item , &
144  & ws, wr, iw1, hecmesh%MPI_COMM, hecmesh%my_rank, 8, len)
145  deallocate (ws, wr)
146 
147  do icel= 1, hecmesh%n_adapt_elem_old
148  ityp = hecmesh%adapt_type (icel)
149  is = hecmesh%adapt_children_index(icel-1)
150  is1= is + 1
151  is2= is + 2
152  is3= is + 3
153  is4= is + 4
154  is5= is + 5
155  is6= is + 6
156  is7= is + 7
157  is8= is + 8
158  if (ityp.ne.0 .and. &
159  & hecmesh%elem_ID(2*icel).ne.hecmesh%my_rank) then
160  !C
161  !C-- TETRAHEDRA
162  if (hecmesh%elem_type(icel).eq.341) then
163  hecmesh%adapt_children_item(2*is1-1)= iw1(8*icel-7)
164  hecmesh%adapt_children_item(2*is2-1)= iw1(8*icel-6)
165  if (ityp.ge.7) then
166  hecmesh%adapt_children_item(2*is3-1)= iw1(8*icel-5)
167  hecmesh%adapt_children_item(2*is4-1)= iw1(8*icel-4)
168  if (ityp.eq.11) then
169  hecmesh%adapt_children_item(2*is5-1)= iw1(8*icel-3)
170  hecmesh%adapt_children_item(2*is6-1)= iw1(8*icel-2)
171  hecmesh%adapt_children_item(2*is7-1)= iw1(8*icel-1)
172  hecmesh%adapt_children_item(2*is8-1)= iw1(8*icel )
173  endif
174  endif
175  endif
176  !C
177  !C-- PRISMs
178  if (hecmesh%elem_type(icel).eq.351) then
179  hecmesh%adapt_children_item(2*is1-1)= iw1(8*icel-7)
180  hecmesh%adapt_children_item(2*is2-1)= iw1(8*icel-6)
181  if (ityp.eq.4) then
182  hecmesh%adapt_children_item(2*is3-1)= iw1(8*icel-5)
183  hecmesh%adapt_children_item(2*is4-1)= iw1(8*icel-4)
184  endif
185  endif
186  endif
187  enddo
188  deallocate (iw1)
189 
190  allocate (iw1(len*8))
191  iw1= 0
192  do icel= 1, hecmesh%n_adapt_elem_old
193  ityp= hecmesh%adapt_type(icel)
194  is= hecmesh%adapt_children_index(icel-1)
195  is1= is + 1
196  is2= is + 2
197  is3= is + 3
198  is4= is + 4
199  is5= is + 5
200  is6= is + 6
201  is7= is + 7
202  is8= is + 8
203  !C
204  !C-- TETRAHEDRA
205  if (hecmesh%elem_type(icel).eq.341) then
206  if (ityp.ne.0) then
207  iw1(8*icel-7)= hecmesh%adapt_children_item(2*is1)
208  iw1(8*icel-6)= hecmesh%adapt_children_item(2*is2)
209  if (ityp.ge.7) then
210  iw1(8*icel-5)= hecmesh%adapt_children_item(2*is3)
211  iw1(8*icel-4)= hecmesh%adapt_children_item(2*is4)
212  if (ityp.eq.11) then
213  iw1(8*icel-3)= hecmesh%adapt_children_item(2*is5)
214  iw1(8*icel-2)= hecmesh%adapt_children_item(2*is6)
215  iw1(8*icel-1)= hecmesh%adapt_children_item(2*is7)
216  iw1(8*icel )= hecmesh%adapt_children_item(2*is8)
217  endif
218  endif
219  endif
220  endif
221  !C
222  !C-- PRISMs
223  if (hecmesh%elem_type(icel).eq.351) then
224  if (ityp.ne.0) then
225  iw1(8*icel-7)= hecmesh%adapt_children_item(2*is1)
226  iw1(8*icel-6)= hecmesh%adapt_children_item(2*is2)
227  if (ityp.eq.4) then
228  iw1(8*icel-5)= hecmesh%adapt_children_item(2*is3)
229  iw1(8*icel-4)= hecmesh%adapt_children_item(2*is4)
230  endif
231  endif
232  endif
233  enddo
234 
235  allocate (ws(8*len), wr(8*len))
236  ws= 0
237  wr= 0
238  call hecmw_adapt_int_send_recv &
239  & ( len, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
240  & hecmesh%adapt_import_elem_index, &
241  & hecmesh%adapt_import_elem_item , &
242  & hecmesh%adapt_export_elem_index, &
243  & hecmesh%adapt_export_elem_item , &
244  & ws, wr, iw1, hecmesh%MPI_COMM, hecmesh%my_rank, 8, len)
245  deallocate (ws, wr)
246 
247  do icel= 1, hecmesh%n_adapt_elem_old
248  ityp= hecmesh%adapt_type(icel)
249  is= hecmesh%adapt_children_index(icel-1)
250  is1= is + 1
251  is2= is + 2
252  is3= is + 3
253  is4= is + 4
254  is5= is + 5
255  is6= is + 6
256  is7= is + 7
257  is8= is + 8
258  if (ityp.ne.0 .and. &
259  & hecmesh%elem_ID(2*icel) .ne. hecmesh%my_rank) then
260  !C
261  !C-- TETRAHEDRA
262  if (hecmesh%elem_type(icel).eq.341) then
263  hecmesh%adapt_children_item(2*is1)= iw1(8*icel-7)
264  hecmesh%adapt_children_item(2*is2)= iw1(8*icel-6)
265  if (ityp.ge.7) then
266  hecmesh%adapt_children_item(2*is3)= iw1(8*icel-5)
267  hecmesh%adapt_children_item(2*is4)= iw1(8*icel-4)
268  if (ityp.eq.11) then
269  hecmesh%adapt_children_item(2*is5)= iw1(8*icel-3)
270  hecmesh%adapt_children_item(2*is6)= iw1(8*icel-2)
271  hecmesh%adapt_children_item(2*is7)= iw1(8*icel-1)
272  hecmesh%adapt_children_item(2*is8)= iw1(8*icel )
273  endif
274  endif
275  endif
276 
277  !C
278  !C-- PRISMs
279  if (hecmesh%elem_type(icel).eq.351) then
280  hecmesh%adapt_children_item(2*is1)= iw1(8*icel-7)
281  hecmesh%adapt_children_item(2*is2)= iw1(8*icel-6)
282  if (ityp.eq.4) then
283  hecmesh%adapt_children_item(2*is3)= iw1(8*icel-5)
284  hecmesh%adapt_children_item(2*is4)= iw1(8*icel-4)
285  endif
286  endif
287  endif
288  enddo
289  deallocate (iw1)
290  !C===
291 
292  !C
293  !C +---------------+
294  !C | INTERNAL CELL |
295  !C +---------------+
296  !C===
297  deallocate (hecmesh%elem_internal_list)
298  icou= 0
299  do icel= 1, hecmesh%n_elem
300  if (hecmesh%elem_ID(2*icel).eq.hecmesh%my_rank) icou= icou + 1
301  enddo
302 
303  hecmesh%ne_internal= icou
304  allocate (hecmesh%elem_internal_list(icou))
305  icou= 0
306  do icel= 1, hecmesh%n_elem
307  if (hecmesh%elem_ID(2*icel).eq.hecmesh%my_rank) then
308  icou= icou + 1
309  hecmesh%elem_internal_list(icou)= icel
310  endif
311  enddo
312  !C===
313 
314  !C
315  !C +------------+
316  !C | REORDERING |
317  !C +------------+
318  !C===
319  allocate (hecmesh%adapt_OLDtoNEW_elem(hecmesh%n_elem))
320  allocate (hecmesh%adapt_NEWtoOLD_elem(hecmesh%n_elem))
321  allocate (iw2(hecmesh%n_elem))
322  allocate (iw3(hecmesh%n_elem))
323  hecmesh%adapt_OLDtoNEW_elem= 0
324  hecmesh%adapt_NEWtoOLD_elem= 0
325  iw2= 0
326  iw3= 0
327 
328  icou_341= 0
329  icou_351= 0
330 
331  do icel= 1, hecmesh%n_elem
332  ityp= hecmesh%elem_type(icel)
333  if (ityp.eq.341) then
334  icou_341= icou_341 + 1
335  iw3(icou_341)= icel
336  endif
337  enddo
338 
339  do icel= 1, hecmesh%n_elem
340  ityp= hecmesh%elem_type(icel)
341  if (ityp.eq.351) then
342  icou_351= icou_351 + 1
343  iw3(icou_341+icou_351)= icel
344  endif
345  enddo
346 
347  do ic0= 1, hecmesh%n_elem
348  icel = iw3(ic0)
349  hecmesh%adapt_OLDtoNEW_elem(icel)= ic0
350  hecmesh%adapt_NEWtoOLD_elem(ic0 )= icel
351  enddo
352 
353  hecmesh%elem_type_index(1)= icou_341
354  hecmesh%elem_type_index(2)= icou_341 + icou_351
355 
356  deallocate (iw2, iw3)
357  !C===
358  return
359 end subroutine hecmw_adapt_new_cell
360 
361 
362 
hecmw_adapt_new_cell
subroutine hecmw_adapt_new_cell(hecMESH)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_new_cell.f90:15
hecmw_adapt_new_cell_341
subroutine hecmw_adapt_new_cell_341(hecMESH, icouN)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_new_cell_341.f90:15
hecmw_adapt_new_cell_351
subroutine hecmw_adapt_new_cell_351(hecMESH, icouN)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_new_cell_351.f90:15
hecmw_adapt_int_sr
Adaptive Mesh Refinement.
Definition: hecmw_adapt_int_sr.f90:7
hecmw_adapt_int_sr::hecmw_adapt_int_send_recv
subroutine hecmw_adapt_int_send_recv(N, NEIBPETOT, NEIBPE, STACK_IMPORT, NOD_IMPORT, STACK_EXPORT, NOD_EXPORT, WS, WR, X, SOLVER_COMM, my_rank, NB, m)
Definition: hecmw_adapt_int_sr.f90:18
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7