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