FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
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
14 subroutine 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 
256 contains
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
339 end subroutine hecmw_adapt_new_cell_341
340 
341 
342 
hecmw_adapt_error_exit
subroutine hecmw_adapt_error_exit(hecMESH, IFLAG)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_error_exit.f90:8
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_create_new_tetra
subroutine hecmw_adapt_create_new_tetra(in1, in2, in3, in4, IDchi)
Definition: hecmw_adapt_new_cell_341.f90:258
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7
hecmw_adapt_edge_info
subroutine hecmw_adapt_edge_info(hecMESH, nod1, nod2, iedge, NFLAG)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_edge_info.f90:13