FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_adapt_new_cell_341.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_341
10!C***
11!C
12!C create new TET.
13!C
14subroutine hecmw_adapt_new_cell_341 (hecMESH, icouN)
15
16 use hecmw_util
17 implicit real*8 (a-h,o-z)
18
19 dimension ndiv(6), nntyp(0:11)
20
21 integer(kind=kint) :: PAR_CEL_TYP
22 type (hecmwST_local_mesh) :: hecMESH
23
24 !C
25 !C +----------------+
26 !C | embedding TET. |
27 !C +----------------+
28 !C===
29 do i= 0, 11
30 nntyp(i)= 0
31 enddo
32
33 do icel0= 1, hecmesh%n_adapt_act_elem_341
34 icel_par= hecmesh%adapt_act_elem_341(icel0)
35 npar= icel_par
36
37 if (hecmesh%elem_ID(2*icel_par).eq.hecmesh%my_rank) then
38 inc= 1
39 else
40 inc= 0
41 endif
42
43 is= hecmesh%elem_node_index(icel_par-1)
44 n1= hecmesh%elem_node_item (is+1)
45 n2= hecmesh%elem_node_item (is+2)
46 n3= hecmesh%elem_node_item (is+3)
47 n4= hecmesh%elem_node_item (is+4)
48 n5= 0
49 n6= 0
50 n7= 0
51 n8= 0
52 n9= 0
53 n0= 0
54
55 nnn= hecmesh%n_adapt_edge
56 call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
57 call hecmw_adapt_edge_info ( hecmesh, n1, n3, ie2, 1 )
58 call hecmw_adapt_edge_info ( hecmesh, n1, n4, ie3, 1 )
59 call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie4, 1 )
60 call hecmw_adapt_edge_info ( hecmesh, n2, n4, ie5, 1 )
61 call hecmw_adapt_edge_info ( hecmesh, n3, n4, ie6, 1 )
62
63 ndiv(1)= hecmesh%adapt_iemb(ie1)
64 ndiv(2)= hecmesh%adapt_iemb(ie2)
65 ndiv(3)= hecmesh%adapt_iemb(ie3)
66 ndiv(4)= hecmesh%adapt_iemb(ie4)
67 ndiv(5)= hecmesh%adapt_iemb(ie5)
68 ndiv(6)= hecmesh%adapt_iemb(ie6)
69
70 ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
71 par_cel_typ= hecmesh%elem_type(npar)
72 !C
73 !C-- init. CHILD. cell array
74 is= hecmesh%adapt_children_index(npar-1)
75 is1= is + 1
76 is2= is + 2
77 is3= is + 3
78 is4= is + 4
79 is5= is + 5
80 is6= is + 6
81 is7= is + 7
82 is8= is + 8
83
84 hecmesh%adapt_children_item(2*is1)= -1
85 hecmesh%adapt_children_item(2*is2)= -1
86 hecmesh%adapt_children_item(2*is3)= -1
87 hecmesh%adapt_children_item(2*is4)= -1
88 hecmesh%adapt_children_item(2*is5)= -1
89 hecmesh%adapt_children_item(2*is6)= -1
90 hecmesh%adapt_children_item(2*is7)= -1
91 hecmesh%adapt_children_item(2*is8)= -1
92
93 hecmesh%adapt_children_item(2*is1-1)= 0
94 hecmesh%adapt_children_item(2*is2-1)= 0
95 hecmesh%adapt_children_item(2*is3-1)= 0
96 hecmesh%adapt_children_item(2*is4-1)= 0
97 hecmesh%adapt_children_item(2*is5-1)= 0
98 hecmesh%adapt_children_item(2*is6-1)= 0
99 hecmesh%adapt_children_item(2*is7-1)= 0
100 hecmesh%adapt_children_item(2*is8-1)= 0
101
102 !C
103 !C== embedding TYPE
104 if (ndivsum.eq.0) ntyp= 0
105 !C
106 !C-- TYP-1
107 if (ndivsum.eq.1 .and. ndiv(1).eq.1) then
108 ntyp= 1
109 n5 = hecmesh%adapt_IWK(ie1)
110
111 hecmesh%adapt_type(npar)= ntyp
112 call hecmw_adapt_create_new_tetra (n1, n5, n3, n4, 1)
113 call hecmw_adapt_create_new_tetra (n5, n2, n3, n4, 2)
114 endif
115 !C
116 !C-- TYP-2
117 if (ndivsum.eq.1 .and. ndiv(2).eq.1) then
118 ntyp= 2
119 n5 = hecmesh%adapt_IWK(ie2)
120
121 hecmesh%adapt_type(npar)= ntyp
122 call hecmw_adapt_create_new_tetra (n1, n2, n5, n4, 1)
123 call hecmw_adapt_create_new_tetra (n5, n2, n3, n4, 2)
124 endif
125 !C
126 !C-- TYP-3
127 if (ndivsum.eq.1 .and. ndiv(3).eq.1) then
128 ntyp= 3
129 n5 = hecmesh%adapt_IWK(ie3)
130
131 hecmesh%adapt_type(npar)= ntyp
132 call hecmw_adapt_create_new_tetra (n1, n2, n3, n5, 1)
133 call hecmw_adapt_create_new_tetra (n5, n2, n3, n4, 2)
134 endif
135 !C
136 !C-- TYP-4
137 if (ndivsum.eq.1 .and. ndiv(4).eq.1) then
138 ntyp= 4
139 n5 = hecmesh%adapt_IWK(ie4)
140
141 hecmesh%adapt_type(npar)= ntyp
142 call hecmw_adapt_create_new_tetra (n1, n2, n5, n4, 1)
143 call hecmw_adapt_create_new_tetra (n1, n5, n3, n4, 2)
144 endif
145 !C
146 !C-- TYP-5
147 if (ndivsum.eq.1 .and. ndiv(5).eq.1) then
148 ntyp= 5
149 n5 = hecmesh%adapt_IWK(ie5)
150
151 hecmesh%adapt_type(npar)= ntyp
152 call hecmw_adapt_create_new_tetra (n1, n2, n3, n5, 1)
153 call hecmw_adapt_create_new_tetra (n1, n5, n3, n4, 2)
154 endif
155 !C
156 !C-- TYP-6
157 if (ndivsum.eq.1 .and. ndiv(6).eq.1) then
158 ntyp= 6
159 n5 = hecmesh%adapt_IWK(ie6)
160
161 hecmesh%adapt_type(npar)= ntyp
162 call hecmw_adapt_create_new_tetra (n1, n2, n3, n5, 1)
163 call hecmw_adapt_create_new_tetra (n1, n2, n5, n4, 2)
164 endif
165 !C
166 !C-- TYP-7
167 if (ndivsum.eq.3 .and. ndiv(1).eq.1 .and. &
168 & ndiv(3).eq.1 .and. ndiv(5).eq.1) then
169 ntyp= 7
170 n5 = hecmesh%adapt_IWK(ie1)
171 n6 = hecmesh%adapt_IWK(ie3)
172 n7 = hecmesh%adapt_IWK(ie5)
173
174 hecmesh%adapt_type(npar)= ntyp
175 call hecmw_adapt_create_new_tetra (n1, n5, n3, n6, 1)
176 call hecmw_adapt_create_new_tetra (n5, n2, n3, n7, 2)
177 call hecmw_adapt_create_new_tetra (n6, n7, n3, n4, 3)
178 call hecmw_adapt_create_new_tetra (n6, n5, n3, n7, 4)
179 endif
180 !C
181 !C-- TYP-8
182 if (ndivsum.eq.3 .and. ndiv(2).eq.1 .and. &
183 & ndiv(3).eq.1 .and. ndiv(6).eq.1) then
184 ntyp= 8
185 n5 = hecmesh%adapt_IWK(ie2)
186 n6 = hecmesh%adapt_IWK(ie3)
187 n7 = hecmesh%adapt_IWK(ie6)
188
189 hecmesh%adapt_type(npar)= ntyp
190 call hecmw_adapt_create_new_tetra (n1, n2, n5, n6, 1)
191 call hecmw_adapt_create_new_tetra (n5, n2, n3, n7, 2)
192 call hecmw_adapt_create_new_tetra (n6, n2, n7, n4, 3)
193 call hecmw_adapt_create_new_tetra (n6, n2, n5, n7, 4)
194 endif
195 !C
196 !C-- TYP-9
197 if (ndivsum.eq.3 .and. ndiv(1).eq.1 .and. &
198 & ndiv(2).eq.1 .and. ndiv(4).eq.1) then
199 ntyp= 9
200 n5 = hecmesh%adapt_IWK(ie1)
201 n6 = hecmesh%adapt_IWK(ie2)
202 n7 = hecmesh%adapt_IWK(ie4)
203
204 hecmesh%adapt_type(npar)= ntyp
205 call hecmw_adapt_create_new_tetra (n1, n5, n6, n4, 1)
206 call hecmw_adapt_create_new_tetra (n5, n2, n7, n4, 2)
207 call hecmw_adapt_create_new_tetra (n6, n7, n3, n4, 3)
208 call hecmw_adapt_create_new_tetra (n5, n7, n6, n4, 4)
209 endif
210 !C
211 !C-- TYP-10
212 if (ndivsum.eq.3 .and. ndiv(4).eq.1 .and. &
213 & ndiv(5).eq.1 .and. ndiv(6).eq.1) then
214 ntyp= 10
215 n5 = hecmesh%adapt_IWK(ie4)
216 n6 = hecmesh%adapt_IWK(ie5)
217 n7 = hecmesh%adapt_IWK(ie6)
218
219 hecmesh%adapt_type(npar)= ntyp
220 call hecmw_adapt_create_new_tetra (n1, n2, n5, n6, 1)
221 call hecmw_adapt_create_new_tetra (n1, n5, n3, n7, 2)
222 call hecmw_adapt_create_new_tetra (n1, n6, n7, n4, 3)
223 call hecmw_adapt_create_new_tetra (n1, n5, n7, n6, 4)
224 endif
225 !C
226 !C-- TYP-11
227 if (ndivsum.eq.6) then
228 ntyp= 11
229 n5 = hecmesh%adapt_IWK(ie1)
230 n6 = hecmesh%adapt_IWK(ie2)
231 n7 = hecmesh%adapt_IWK(ie3)
232 n8 = hecmesh%adapt_IWK(ie4)
233 n9 = hecmesh%adapt_IWK(ie5)
234 n0 = hecmesh%adapt_IWK(ie6)
235
236 hecmesh%adapt_type(npar)= ntyp
237 call hecmw_adapt_create_new_tetra (n1, n5, n6, n7, 1)
238 call hecmw_adapt_create_new_tetra (n5, n2, n8, n9, 2)
239 call hecmw_adapt_create_new_tetra (n6, n8, n3, n0, 3)
240 call hecmw_adapt_create_new_tetra (n7, n9, n0, n4, 4)
241 call hecmw_adapt_create_new_tetra (n5, n8, n6, n7, 5)
242 call hecmw_adapt_create_new_tetra (n5, n8, n7, n9, 6)
243 call hecmw_adapt_create_new_tetra (n0, n8, n7, n6, 7)
244 call hecmw_adapt_create_new_tetra (n0, n8, n9, n7, 8)
245 endif
246 !C==
247
248 !C
249 !C-- TYPE of EMBEDDING
250 nntyp(ntyp)= nntyp(ntyp) + 1
251 enddo
252 !C===
253
254 return
255
256contains
257 subroutine hecmw_adapt_create_new_tetra (in1, in2, in3, in4, IDchi)
258
259 hecmesh%n_adapt_elem_341_cur= hecmesh%n_adapt_elem_341_cur + 1
260 hecmesh%n_adapt_elem_cur = hecmesh%n_adapt_elem_cur + 1
261
262 icel = hecmesh%n_adapt_elem_cur
263 icoun= icoun + inc
264
265 if (icel.gt.hecmesh%ne_array) then
266 call hecmw_adapt_error_exit (hecmesh, 61)
267 endif
268
269 hecmesh%when_i_was_refined_elem(icel)= hecmesh%n_adapt
270 hecmesh%elem_node_index(icel)= hecmesh%elem_node_index(icel-1) + 4
271
272 is= hecmesh%elem_node_index(icel-1)
273 hecmesh%elem_node_item(is+1)= in1
274 hecmesh%elem_node_item(is+2)= in2
275 hecmesh%elem_node_item(is+3)= in3
276 hecmesh%elem_node_item(is+4)= in4
277
278 hecmesh%adapt_parent(2*icel-1)= hecmesh%elem_ID(2*npar-1)
279 hecmesh%adapt_parent(2*icel )= hecmesh%elem_ID(2*npar )
280
281 hecmesh%elem_ID(2*icel-1)= icoun + hecmesh%ne_internal
282 hecmesh%elem_ID(2*icel )= hecmesh%elem_ID(2*npar )
283
284 hecmesh%elem_mat_ID_item(icel)= hecmesh%elem_mat_ID_item(npar)
285 hecmesh%section_ID (icel)= hecmesh%section_ID (npar)
286
287 hecmesh%adapt_type(icel)= 0
288
289 if (ndivsum.eq.6) then
290 hecmesh%adapt_level(icel)= hecmesh%adapt_level(npar) + 2
291 else
292 hecmesh%adapt_level(icel)= hecmesh%adapt_level(npar) + 1
293 endif
294
295 is= hecmesh%adapt_children_index(npar-1)
296 hecmesh%adapt_children_item(2*(is+idchi)-1)= icel
297 hecmesh%adapt_children_item(2*(is+idchi)-1)= icoun + hecmesh%ne_internal
298 hecmesh%adapt_children_item(2*(is+idchi) )= hecmesh%my_rank
299
300
301
302 hecmesh%adapt_children_local(is+idchi)= icel
303
304 is= hecmesh%adapt_children_index(icel-1)
305 hecmesh%adapt_children_index(icel)= is + 8
306
307 is1= is + 1
308 is2= is + 2
309 is3= is + 3
310 is4= is + 4
311 is5= is + 5
312 is6= is + 6
313 is7= is + 7
314 is8= is + 8
315
316 hecmesh%adapt_children_item(2*is1)= -1
317 hecmesh%adapt_children_item(2*is2)= -1
318 hecmesh%adapt_children_item(2*is3)= -1
319 hecmesh%adapt_children_item(2*is4)= -1
320 hecmesh%adapt_children_item(2*is5)= -1
321 hecmesh%adapt_children_item(2*is6)= -1
322 hecmesh%adapt_children_item(2*is7)= -1
323 hecmesh%adapt_children_item(2*is8)= -1
324
325 hecmesh%adapt_children_item(2*is1-1)= 0
326 hecmesh%adapt_children_item(2*is2-1)= 0
327 hecmesh%adapt_children_item(2*is3-1)= 0
328 hecmesh%adapt_children_item(2*is4-1)= 0
329 hecmesh%adapt_children_item(2*is5-1)= 0
330 hecmesh%adapt_children_item(2*is6-1)= 0
331 hecmesh%adapt_children_item(2*is7-1)= 0
332 hecmesh%adapt_children_item(2*is8-1)= 0
333
334 hecmesh%elem_type (icel)= par_cel_typ
335 hecmesh%adapt_parent_type(icel)= hecmesh%adapt_type(npar)
336
337
338 end subroutine hecmw_adapt_create_new_tetra
339end subroutine hecmw_adapt_new_cell_341
340
341
342
subroutine hecmw_adapt_edge_info(hecmesh, nod1, nod2, iedge, nflag)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_error_exit(hecmesh, iflag)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_new_cell_341(hecmesh, icoun)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_create_new_tetra(in1, in2, in3, in4, idchi)
I/O and Utility.
Definition: hecmw_util_f.F90:7