FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
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
14subroutine 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
161contains
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
244end subroutine hecmw_adapt_new_cell_351
245
246
247
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_351(hecmesh, icoun)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_create_new_prism(in1, in2, in3, in4, in5, in6, idchi)
I/O and Utility.
Definition: hecmw_util_f.F90:7