FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_adapt_extemb.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_EXTEMB
10!C***
11!C
12!C extend EMBEDDED region to NEIGHBORING region
13!C
14subroutine hecmw_adapt_extemb (hecMESH)
15 use hecmw_util
18 implicit real*8 (a-h,o-z)
19
20 integer(kind=kint), dimension(:), allocatable :: WR, WS
21 dimension ndiv(6)
22
23 type (hecmwST_local_mesh) :: hecMESH
24
25 nrow= 0
26 !C
27 !C +-------+
28 !C | INIT. |
29 !C +-------+
30 !C===
31 do iedg= 1, hecmesh%n_adapt_edge
32 if (hecmesh%adapt_iemb(iedg).eq.1) hecmesh%adapt_iemb(iedg)=2
33 enddo
34
35 !C
36 !C-- TETRAHEDRA
37 do icel0= 1, hecmesh%n_adapt_act_elem_341
38 icel= hecmesh%adapt_act_elem_341(icel0)
39 is= hecmesh%elem_node_index(icel-1)
40 n1= hecmesh%elem_node_item (is+1)
41 n2= hecmesh%elem_node_item (is+2)
42 n3= hecmesh%elem_node_item (is+3)
43 n4= hecmesh%elem_node_item (is+4)
44
45 call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
46 call hecmw_adapt_edge_info ( hecmesh, n1, n3, ie2, 1 )
47 call hecmw_adapt_edge_info ( hecmesh, n1, n4, ie3, 1 )
48 call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie4, 1 )
49 call hecmw_adapt_edge_info ( hecmesh, n2, n4, ie5, 1 )
50 call hecmw_adapt_edge_info ( hecmesh, n3, n4, ie6, 1 )
51
52 ndiv(1)= 0
53 ndiv(2)= 0
54 ndiv(3)= 0
55 ndiv(4)= 0
56 ndiv(5)= 0
57 ndiv(6)= 0
58
59 if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
60 if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
61 if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
62 if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
63 if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
64 if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
65
66 ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
67
68 if (ndivsum.ge.1) then
69 if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
70 if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
71 if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
72 if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
73 if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
74 if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
75 endif
76 enddo
77
78 !C
79 !C-- PRISMs
80 do icel0= 1, hecmesh%n_adapt_act_elem_351
81 icel= hecmesh%adapt_act_elem_351(icel0)
82 is= hecmesh%elem_node_index(icel-1)
83 n1= hecmesh%elem_node_item (is+1)
84 n2= hecmesh%elem_node_item (is+2)
85 n3= hecmesh%elem_node_item (is+3)
86 n4= hecmesh%elem_node_item (is+4)
87 n5= hecmesh%elem_node_item (is+5)
88 n6= hecmesh%elem_node_item (is+6)
89
90 call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
91 call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie2, 1 )
92 call hecmw_adapt_edge_info ( hecmesh, n3, n1, ie3, 1 )
93 call hecmw_adapt_edge_info ( hecmesh, n4, n5, ie4, 1 )
94 call hecmw_adapt_edge_info ( hecmesh, n5, n6, ie5, 1 )
95 call hecmw_adapt_edge_info ( hecmesh, n6, n4, ie6, 1 )
96
97 ndiv(1)= 0
98 ndiv(2)= 0
99 ndiv(3)= 0
100 ndiv(4)= 0
101 ndiv(5)= 0
102 ndiv(6)= 0
103
104 if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
105 if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
106 if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
107 if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
108 if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
109 if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
110
111 ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
112
113 if (ndivsum.ge.1) then
114 if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
115 if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
116 if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
117 if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
118 if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
119 if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
120 endif
121 enddo
122 !C===
123
124 !C
125 !C-- exchange IEMB
126 n1= hecmesh%adapt_import_edge_index(hecmesh%n_neighbor_pe)
127 n2= hecmesh%adapt_export_edge_index(hecmesh%n_neighbor_pe)
128 m = max(n1, n2)
129 allocate (ws(m), wr(m))
130
131 ws= 0
132 wr= 0
134 & ( hecmesh%n_adapt_edge, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
135 & hecmesh%adapt_import_edge_index, &
136 & hecmesh%adapt_import_edge_item , &
137 & hecmesh%adapt_export_edge_index, &
138 & hecmesh%adapt_export_edge_item , &
139 & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
140 & hecmesh%my_rank, 1, m)
141
142 ws= 0
143 wr= 0
145 & ( hecmesh%n_adapt_edge, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
146 & hecmesh%adapt_import_edge_index, &
147 & hecmesh%adapt_import_edge_item , &
148 & hecmesh%adapt_export_edge_index, &
149 & hecmesh%adapt_export_edge_item , &
150 & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
151 & hecmesh%my_rank, 1, m)
152
153 do iedg= 1, hecmesh%n_adapt_edge
154 if (hecmesh%adapt_iemb(iedg).eq.1) hecmesh%adapt_iemb(iedg)=2
155 enddo
156
157 !C
158 !C +----------------------+
159 !C | extend embedded zone |
160 !C +----------------------+
161 !C RULE : set all EDGEs IEMB(ie)=1 if at least ONE
162 !C EDGE of the TETRAHEDRON is marked as IEMB(ie)=2
163 !C===
164 do irow= 1, nrow
165 !C
166 !C== set IEMB(ie) = 1
167
168 !C
169 !C-- TETRAHEDRA
170 do icel0= 1, hecmesh%n_adapt_act_elem_341
171 icel= hecmesh%adapt_act_elem_341(icel0)
172 is= hecmesh%elem_node_index(icel-1)
173 n1= hecmesh%elem_node_item (is+1)
174 n2= hecmesh%elem_node_item (is+2)
175 n3= hecmesh%elem_node_item (is+3)
176 n4= hecmesh%elem_node_item (is+4)
177
178 call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
179 call hecmw_adapt_edge_info ( hecmesh, n1, n3, ie2, 1 )
180 call hecmw_adapt_edge_info ( hecmesh, n1, n4, ie3, 1 )
181 call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie4, 1 )
182 call hecmw_adapt_edge_info ( hecmesh, n2, n4, ie5, 1 )
183 call hecmw_adapt_edge_info ( hecmesh, n3, n4, ie6, 1 )
184
185 ndiv(1)= 0
186 ndiv(2)= 0
187 ndiv(3)= 0
188 ndiv(4)= 0
189 ndiv(5)= 0
190 ndiv(6)= 0
191
192 if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
193 if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
194 if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
195 if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
196 if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
197 if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
198
199 ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
200
201 if (ndivsum.ge.1) then
202 if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
203 if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
204 if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
205 if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
206 if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
207 if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
208 endif
209 enddo
210
211 !C
212 !C-- PRISMs
213 do icel0= 1, hecmesh%n_adapt_act_elem_351
214 icel= hecmesh%adapt_act_elem_351(icel0)
215 is= hecmesh%elem_node_index(icel-1)
216 n1= hecmesh%elem_node_item (is+1)
217 n2= hecmesh%elem_node_item (is+2)
218 n3= hecmesh%elem_node_item (is+3)
219 n4= hecmesh%elem_node_item (is+4)
220 n5= hecmesh%elem_node_item (is+5)
221 n6= hecmesh%elem_node_item (is+6)
222
223 call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
224 call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie2, 1 )
225 call hecmw_adapt_edge_info ( hecmesh, n3, n1, ie3, 1 )
226 call hecmw_adapt_edge_info ( hecmesh, n4, n5, ie4, 1 )
227 call hecmw_adapt_edge_info ( hecmesh, n5, n6, ie5, 1 )
228 call hecmw_adapt_edge_info ( hecmesh, n6, n4, ie6, 1 )
229
230 ndiv(1)= 0
231 ndiv(2)= 0
232 ndiv(3)= 0
233 ndiv(4)= 0
234 ndiv(5)= 0
235 ndiv(6)= 0
236
237 if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
238 if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
239 if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
240 if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
241 if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
242 if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
243
244 ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
245
246 if (ndivsum.ge.1) then
247 if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
248 if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
249 if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
250 if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
251 if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
252 if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
253 endif
254 enddo
255 !C==
256
257 !C
258 !C-- exchange IEMB
259 ws= 0
260 wr= 0
262 & ( hecmesh%n_adapt_edge, &
263 & hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
264 & hecmesh%adapt_import_edge_index, &
265 & hecmesh%adapt_import_edge_item , &
266 & hecmesh%adapt_export_edge_index, &
267 & hecmesh%adapt_export_edge_item , &
268 & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
269 & hecmesh%my_rank, 1, m)
270
271 ws= 0
272 wr= 0
274 & ( hecmesh%n_adapt_edge, &
275 & hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
276 & hecmesh%adapt_import_edge_index, &
277 & hecmesh%adapt_import_edge_item , &
278 & hecmesh%adapt_export_edge_index, &
279 & hecmesh%adapt_export_edge_item , &
280 & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
281 & hecmesh%my_rank, 1, m)
282
283 !C
284 !C-- set IEMB(ie) = 2
285 do iedg= 1, hecmesh%n_adapt_edge
286 if ( hecmesh%adapt_iemb(iedg).eq.1 ) then
287 hecmesh%adapt_iemb(iedg)= 2
288 endif
289 enddo
290
291 enddo
292
293 deallocate (ws, wr)
294 !C===
295
296 !C
297 !C-- LOOP OVER ALL EDGEs
298 do iedg= 1, hecmesh%n_adapt_edge
299 if ( hecmesh%adapt_iemb(iedg).eq.2 ) hecmesh%adapt_iemb(iedg)= 1
300 enddo
301
302 return
303end
subroutine hecmw_adapt_edge_info(hecmesh, nod1, nod2, iedge, nflag)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_extemb(hecmesh)
Adaptive Mesh Refinement.
Adaptive Mesh Refinement.
subroutine hecmw_adapt_int_send_recv_rev(n, neibpetot, neibpe, stack_export, nod_export, stack_import, nod_import, ws, wr, x, solver_comm, my_rank, nb, m)
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