FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
hecmw_adapt_new_cell_351.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_351
10 !C***
11 !C
12 !C create new PRISMs
13 !C
14 subroutine hecmw_adapt_new_cell_351 (hecMESH, icouN)
15 
16  use hecmw_util
17 
18  implicit real*8 (a-h,o-z)
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_351
34  icel_par= hecmesh%adapt_act_elem_351(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  n01= hecmesh%elem_node_item (is+1)
45  n02= hecmesh%elem_node_item (is+2)
46  n03= hecmesh%elem_node_item (is+3)
47  n11= hecmesh%elem_node_item (is+4)
48  n12= hecmesh%elem_node_item (is+5)
49  n13= hecmesh%elem_node_item (is+6)
50 
51  call hecmw_adapt_edge_info ( hecmesh, n01, n02, ie01, 1 )
52  call hecmw_adapt_edge_info ( hecmesh, n02, n03, ie02, 1 )
53  call hecmw_adapt_edge_info ( hecmesh, n03, n01, ie03, 1 )
54  call hecmw_adapt_edge_info ( hecmesh, n11, n12, ie11, 1 )
55  call hecmw_adapt_edge_info ( hecmesh, n12, n13, ie12, 1 )
56  call hecmw_adapt_edge_info ( hecmesh, n13, n11, ie13, 1 )
57 
58  ndiv(1)= hecmesh%adapt_iemb(ie01)
59  ndiv(2)= hecmesh%adapt_iemb(ie02)
60  ndiv(3)= hecmesh%adapt_iemb(ie03)
61  ndiv(4)= hecmesh%adapt_iemb(ie11)
62  ndiv(5)= hecmesh%adapt_iemb(ie12)
63  ndiv(6)= hecmesh%adapt_iemb(ie13)
64 
65  ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
66  par_cel_typ= hecmesh%elem_type(npar)
67 
68  !C
69  !C-- init. CHILD. cell array
70  is = hecmesh%adapt_children_index(npar-1)
71  is1= is + 1
72  is2= is + 2
73  is3= is + 3
74  is4= is + 4
75  is5= is + 5
76  is6= is + 6
77  is7= is + 7
78  is8= is + 8
79 
80  hecmesh%adapt_children_item(2*is1-1)= 0
81  hecmesh%adapt_children_item(2*is2-1)= 0
82  hecmesh%adapt_children_item(2*is3-1)= 0
83  hecmesh%adapt_children_item(2*is4-1)= 0
84  hecmesh%adapt_children_item(2*is5-1)= 0
85  hecmesh%adapt_children_item(2*is6-1)= 0
86  hecmesh%adapt_children_item(2*is7-1)= 0
87  hecmesh%adapt_children_item(2*is8-1)= 0
88 
89  hecmesh%adapt_children_item(2*is1)= -1
90  hecmesh%adapt_children_item(2*is2)= -1
91  hecmesh%adapt_children_item(2*is3)= -1
92  hecmesh%adapt_children_item(2*is4)= -1
93  hecmesh%adapt_children_item(2*is5)= -1
94  hecmesh%adapt_children_item(2*is6)= -1
95  hecmesh%adapt_children_item(2*is7)= -1
96  hecmesh%adapt_children_item(2*is8)= -1
97 
98  !C
99  !C== embedding TYPE
100  if (ndivsum.eq.0) ntyp= 0
101  !C
102  !C-- TYP-1
103  if (ndivsum.eq.2 .and. ndiv(1).eq.1 .and. ndiv(4).eq.1) then
104  ntyp= 1
105  n04 = hecmesh%adapt_IWK(ie01)
106  n14 = hecmesh%adapt_IWK(ie11)
107 
108  hecmesh%adapt_type(npar)= ntyp
109  call hecmw_adapt_create_new_prism (n01, n04, n03, n11, n14, n13, 1)
110  call hecmw_adapt_create_new_prism (n04, n02, n03, n14, n12, n13, 2)
111  endif
112  !C
113  !C-- TYP-2
114  if (ndivsum.eq.2 .and. ndiv(2).eq.1 .and. ndiv(5).eq.1) then
115  ntyp= 2
116  n04 = hecmesh%adapt_IWK(ie02)
117  n14 = hecmesh%adapt_IWK(ie12)
118 
119  hecmesh%adapt_type(npar)= ntyp
120  call hecmw_adapt_create_new_prism (n01, n04, n03, n11, n14, n13, 1)
121  call hecmw_adapt_create_new_prism (n01, n02, n04, n11, n12, n14, 2)
122  endif
123  !C
124  !C-- TYP-3
125  if (ndivsum.eq.2 .and. ndiv(3).eq.1 .and. ndiv(6).eq.1) then
126  ntyp= 3
127  n04 = hecmesh%adapt_IWK(ie03)
128  n14 = hecmesh%adapt_IWK(ie13)
129 
130  hecmesh%adapt_type(npar)= ntyp
131  call hecmw_adapt_create_new_prism (n01, n02, n04, n11, n12, n14, 1)
132  call hecmw_adapt_create_new_prism (n04, n02, n03, n14, n12, n13, 2)
133  endif
134  !C
135  !C-- TYP-4
136  if (ndivsum.eq.6) then
137  ntyp= 4
138  n04 = hecmesh%adapt_IWK(ie01)
139  n05 = hecmesh%adapt_IWK(ie02)
140  n06 = hecmesh%adapt_IWK(ie03)
141  n14 = hecmesh%adapt_IWK(ie11)
142  n15 = hecmesh%adapt_IWK(ie12)
143  n16 = hecmesh%adapt_IWK(ie13)
144 
145  hecmesh%adapt_type(npar)= ntyp
146  call hecmw_adapt_create_new_prism (n01, n04, n06, n11, n14, n16, 1)
147  call hecmw_adapt_create_new_prism (n04, n02, n05, n14, n12, n15, 2)
148  call hecmw_adapt_create_new_prism (n06, n05, n03, n16, n15, n13, 3)
149  call hecmw_adapt_create_new_prism (n04, n05, n06, n14, n15, n16, 4)
150  endif
151  !C==
152 
153  !C
154  !C-- TYPE of EMBEDDING
155  nntyp(ntyp)= nntyp(ntyp) + 1
156  enddo
157 
158  !C===
159  return
160 
161 contains
162  subroutine hecmw_adapt_create_new_prism (in1,in2,in3,in4,in5,in6, IDchi)
163 
164  hecmesh%n_adapt_elem_351_cur= hecmesh%n_adapt_elem_351_cur + 1
165  hecmesh%n_adapt_elem_cur = hecmesh%n_adapt_elem_cur + 1
166 
167  icel = hecmesh%n_adapt_elem_cur
168  icoun= icoun + inc
169 
170  if (icel.gt.hecmesh%ne_array) then
171  call hecmw_adapt_error_exit (hecmesh, 61)
172  endif
173 
174  hecmesh%when_i_was_refined_elem(icel)= hecmesh%n_adapt
175  hecmesh%elem_node_index(icel)= hecmesh%elem_node_index(icel-1) + 6
176 
177  is= hecmesh%elem_node_index(icel-1)
178  hecmesh%elem_node_item(is+1)= in1
179  hecmesh%elem_node_item(is+2)= in2
180  hecmesh%elem_node_item(is+3)= in3
181  hecmesh%elem_node_item(is+4)= in4
182  hecmesh%elem_node_item(is+5)= in5
183  hecmesh%elem_node_item(is+6)= in6
184 
185  hecmesh%adapt_parent(2*icel-1)= hecmesh%elem_ID(2*npar-1)
186  hecmesh%adapt_parent(2*icel )= hecmesh%elem_ID(2*npar )
187 
188  hecmesh%elem_ID(2*icel-1)= icoun + hecmesh%ne_internal
189  hecmesh%elem_ID(2*icel )= hecmesh%elem_ID(2*npar )
190 
191  hecmesh%elem_mat_ID_item(icel)= hecmesh%elem_mat_ID_item(npar)
192  hecmesh%section_ID (icel)= hecmesh%section_ID (npar)
193 
194  hecmesh%adapt_type(icel)= 0
195 
196  if (ndivsum.eq.6) then
197  hecmesh%adapt_level(icel)= hecmesh%adapt_level(npar) + 2
198  else
199  hecmesh%adapt_level(icel)= hecmesh%adapt_level(npar) + 1
200  endif
201 
202  is= hecmesh%adapt_children_index(npar-1)
203 
204  hecmesh%adapt_children_item(2*(is+idchi)-1)= icel
205  hecmesh%adapt_children_item(2*(is+idchi)-1)= icoun + hecmesh%ne_internal
206  hecmesh%adapt_children_item(2*(is+idchi) )= hecmesh%my_rank
207 
208  hecmesh%adapt_children_local(is+idchi)= icel
209 
210  is= hecmesh%adapt_children_index(icel-1)
211  hecmesh%adapt_children_index(icel)= is + 8
212 
213  is1= is + 1
214  is2= is + 2
215  is3= is + 3
216  is4= is + 4
217  is5= is + 5
218  is6= is + 6
219  is7= is + 7
220  is8= is + 8
221 
222  hecmesh%adapt_children_item(2*is1)= -1
223  hecmesh%adapt_children_item(2*is2)= -1
224  hecmesh%adapt_children_item(2*is3)= -1
225  hecmesh%adapt_children_item(2*is4)= -1
226  hecmesh%adapt_children_item(2*is5)= -1
227  hecmesh%adapt_children_item(2*is6)= -1
228  hecmesh%adapt_children_item(2*is7)= -1
229  hecmesh%adapt_children_item(2*is8)= -1
230 
231  hecmesh%adapt_children_item(2*is1-1)= 0
232  hecmesh%adapt_children_item(2*is2-1)= 0
233  hecmesh%adapt_children_item(2*is3-1)= 0
234  hecmesh%adapt_children_item(2*is4-1)= 0
235  hecmesh%adapt_children_item(2*is5-1)= 0
236  hecmesh%adapt_children_item(2*is6-1)= 0
237  hecmesh%adapt_children_item(2*is7-1)= 0
238  hecmesh%adapt_children_item(2*is8-1)= 0
239 
240  hecmesh%elem_type (icel)= par_cel_typ
241  hecmesh%adapt_parent_type(icel)= hecmesh%adapt_type(npar)
242 
243  end subroutine hecmw_adapt_create_new_prism
244 end subroutine hecmw_adapt_new_cell_351
245 
246 
247 
hecmw_adapt_new_cell_351
subroutine hecmw_adapt_new_cell_351(hecMESH, icouN)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_new_cell_351.f90:15
hecmw_adapt_error_exit
subroutine hecmw_adapt_error_exit(hecMESH, IFLAG)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_error_exit.f90:8
hecmw_adapt_create_new_prism
subroutine hecmw_adapt_create_new_prism(in1, in2, in3, in4, in5, in6, IDchi)
Definition: hecmw_adapt_new_cell_351.f90:163
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