FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
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
14subroutine hecmw_adapt_new_cell (hecMESH)
15
16 use hecmw_util
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
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
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
359end subroutine hecmw_adapt_new_cell
360
361
362
subroutine hecmw_adapt_new_cell(hecmesh)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_new_cell_341(hecmesh, icoun)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_new_cell_351(hecmesh, icoun)
Adaptive Mesh Refinement.
Adaptive Mesh Refinement.
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)
I/O and Utility.
Definition: hecmw_util_f.F90:7