OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
destroy_cell.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| destroy_cell ../engine/source/interfaces/int22/destroy_cell.F
25!||--- called by ------------------------------------------------------
26!|| sinit22_fvm ../engine/source/interfaces/int22/sinit22_fvm.F
27!||--- uses -----------------------------------------------------
28!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
29!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
30!||====================================================================
31 SUBROUTINE destroy_cell(NIN,IB,ICELL_TARGET,ICELLv,IBv,J,Jv, IXS, ITASK)
32C-----------------------------------------------
33C D e s c r i p t i o n
34C-----------------------------------------------
35C Interface Type22 (/INTER/TYPE22) is an FSI coupling method based on cut cell method.
36C This experimental cut cell method is not completed, abandoned, and is not an official option.
37C
38C Destroy a cell ICELL_target for a given cut
39C cell IB in the cut cell buffer.
40C When a Cell is destroyed from the list , Cell
41C list is updated taken into account : Volume,
42C Faces, and Ajdacent Cell data
43C What needs to be update in cut cell buffer :
44C TYPE BRICK_ENTITY
45C INTEGER :: NBCUT !nombre de plans de coupe
46C INTEGER :: SECID_Cell(8) !cut local id in [1,8] -> [1,52] = sec type. Each possible cut is numbered from 1 to 52 ; 8 nodes => 8 possible cut cells
47C INTEGER :: WhichCell_Node(8) !node local id in[1,8] -> [1,8] = local cut cell id.
48C INTEGER :: %POLY()%NumNOD(9) !noeuds sommets
49C INTEGER :: %POLY()%NumPOINT !nombre total de point decrivant le volume
50C INTEGER :: %POLY()%FACE()%NumPOINT !gives number of points (node+intersec.pts) on a given cell face
51C INTEGER :: Adjacent_Cell(6,9,5) !index3: IADJ (adjacent cell id 1:%NAdjCell)
52C INTEGER :: NAdjCell(9,6) !Number of adjacent cell for a given cell 1:9 and a given face 1:6
53C INTEGER :: %POLY()%ListNodID(8) !Global nodes ID (max8) describing the cell, for each of 9 cells
54C my_real :: %POLY()%Vnew !volume des sous volumes elementaires
55C my_real :: %POLY()%FACE()%Surf !face0=intersection surface
56C TYPE(CUT_PLANE) :: PCUT(8)
57C CHARACTER*14 :: SECTYPE(8)
58C END TYPE BRICK_ENTITY
59C Other quantities are not affected yet or they
60C are related to nodal values.
61C TO DO LATER : Optimize data derived type by
62C example : %CELL(1) = %CELL(9) (only 1 line)
63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE i22bufbric_mod
67 USE i22tri_mod
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER,INTENT(IN) :: IB,ICELL_TARGET,ICELLv,IBv,J,Jv, IXS(NIXS,*),NIN,ITASK
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER :: NCELL,ICELL, NAdjv,IADJv,ID,NBCUT,ICELL_DEST,IADJ, NListNod9,NADj, IE, K
80 INTEGER :: WhichCell_Node(8),INOD, I, NumNODES_Cell, NumIntP,NumPOINT_Face(6),ListNodID(8)
81 my_real :: face_cell(1:6)
82 TYPE (BRICK_ENTITY) :: CUTCELL_TMP
83 LOGICAL :: bFOUND
84C-----------------------------------------------
85C S o u r c e L i n e s
86C-----------------------------------------------
87 id = brick_list(nin,ib)%ID
88 nbcut = brick_list(nin,ib)%NBCUT
89 ncell = nbcut
90
91 if(itask==0)then
92 if(ibug22_destroy==-1 .or. ibug22_destroy==ixs(11,brick_list(nin,ib)%id))then
93 ie = brick_list(nin,ib)%id
94 write (*,fmt='(A,I10,A1,I1)') "destroying cell", ixs(11,ie),".",icell_target
95 endif
96 endif
97
98 IF(ncell==0 .OR. (nbcut>1.AND.icell_target==9) )THEN
99 print *, "**error inter22 : unexpected situation, elem id=", ixs(11,id)
100 ENDIF
101
102 IF(icell_target==9)THEN
103 !--------------------------------------------------------------------------------!
104 ! SIMPLY DESTROY CELL 9 !
105 !--------------------------------------------------------------------------------!
106
107 !---ERASE DATA FROM CELL 9
108 brick_list(nin,ib)%NBCUT = 0
109 brick_list(nin,ib)%SECID_Cell(1) = 0
110
111 brick_list(nin,ib)%NODE(1:8)%WhichCell = 1
112
113 brick_list(nin,ib)%POLY(1)%NumNOD = 8
114 brick_list(nin,ib)%POLY(9)%NumNOD = 0
115
116 brick_list(nin,ib)%POLY(1)%NumPOINT = 8
117 brick_list(nin,ib)%POLY(9)%NumPOINT = 0
118
119 brick_list(nin,ib)%POLY(1)%FACE(1:6)%NumPOINT = 4
120 brick_list(nin,ib)%POLY(9)%FACE(1:6)%NumPOINT = 0
121
122 brick_list(nin,ib)%POLY(9)%FACE(1:6)%Adjacent_Cell(1) = 0
123 brick_list(nin,ib)%POLY(9)%FACE(1:6)%Adjacent_Cell(2) = 0
124 brick_list(nin,ib)%POLY(9)%FACE(1:6)%Adjacent_Cell(3) = 0
125 brick_list(nin,ib)%POLY(9)%FACE(1:6)%Adjacent_Cell(4) = 0
126 brick_list(nin,ib)%POLY(9)%FACE(1:6)%Adjacent_Cell(5) = 0
127
128 brick_list(nin,ib)%POLY(9)%FACE(1:6)%NAdjCell = 0
129 brick_list(nin,ib)%POLY(1)%ListNodID(1:8) = (/1,2,3,4,5,6,7,8/)
130 brick_list(nin,ib)%POLY(9)%ListNodID(1:8) = 0
131 brick_list(nin,ib)%POLY(9)%Vnew = zero
132
133 brick_list(nin,ib)%POLY(1)%FACE(1:6)%Surf = brick_list(nin,ib)%Face_Brick(1:6)
134 !BRICK_LIST(NIN,IB)%POLY(1)%FACE( J)%Surf = ZERO
135 brick_list(nin,ib)%POLY(9)%FACE(1:6)%Surf = zero
136
137 brick_list(nin,ib)%PCUT(1)%N(1:3) = zero
138 brick_list(nin,ib)%PCUT(1)%B(1:3) = zero
139 brick_list(nin,ib)%PCUT(1)%SCUT = zero
140 brick_list(nin,ib)%PCUT(1)%SEFF = zero
141 brick_list(nin,ib)%PCUT(1)%P(1:3,1:6) = zero
142 brick_list(nin,ib)%PCUT(1)%NP = 0
143 brick_list(nin,ib)%SECTYPE(1) = 'REMOVED 0-CELL'
144
145 brick_list(nin,ib)%POLY(1)%WhereIsMain(1:2) = 0
146 brick_list(nin,ib)%POLY(1)%WhereIsMain(3) = id
147 brick_list(nin,ib)%POLY(1)%WhereIsMain(4) = ib
148
149 !BRICK_LIST(NIN,IB)%POLY(1)%CellCENTER(1:3) = BRICK_LIST(NIN,IB)%POLY(1)%CellCENTER(1:3) !keep same one
150
151 !optim : no time to optim, will be treated later, meanwhile a second pass is done in sinit22.F
152 !---UPDATING ADJACENT CELL
153c NAdjv = BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%NAdjCell
154c DO IADJv=1,NADJv
155c IF (BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%Adjacent_Cell(IADJv)==ICELL_TARGET)EXIT
156c ENDDO
157c BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%Adjacent_Cell(IADJv) = 1 !it remains in this case only the full brick.
158c !---local brick
159c !if the new merged cell (after destroy) has already IBv.ICELLv as an adjacent cell, do not add it.
160c NADj = BRICK_LIST(NIN,IB)%POLY(1)%FACE(J)%NAdjCell
161c bFOUND = .FALSE.
162c DO IADJ=1,NADJ
163c IF (BRICK_LIST(NIN,IBv)%POLY(1)%FACE(J)%Adjacent_Cell(IADJ)==ICELLv) bFOUND = .TRUE.
164c ENDDO
165c IF(.NOT.bFOUND)THEN
166c NADj = NADj + 1
167c BRICK_LIST(NIN,IB)%POLY(1)%FACE(J)%NAdjCell = NADj
168c BRICK_LIST(NIN,IB)%POLY(1)%FACE(J)%Adjacent_Cell(IADJ) = ICELLv
169c ENDIF
170
171 ELSEIF(nbcut==1 .AND. icell_target==1)THEN
172 !--------------------------------------------------------------------------------!
173 ! CASE OF TWO CELLS {1,9} : MOVE CELL 9 TO 1 AND DESTROY CELL 9 !
174 !--------------------------------------------------------------------------------!
175
176 !---SWITCH AND ERASE DATA FROM CELL 9
177
178 brick_list(nin,ib)%NBCUT = 0
179
180 brick_list(nin,ib)%SECID_Cell(1) = 0
181
182 brick_list(nin,ib)%NODE(1:8)%WhichCell = 1
183
184 brick_list(nin,ib)%POLY(1)%NumNOD = 8
185 brick_list(nin,ib)%POLY(9)%NumNOD = 0
186
187 brick_list(nin,ib)%POLY(1)%NumPOINT = 8
188 brick_list(nin,ib)%POLY(9)%NumPOINT = 0
189
190 brick_list(nin,ib)%POLY(1)%FACE(1:6)%NumPOINT = 4
191 brick_list(nin,ib)%POLY(9)%FACE(1:6)%NumPOINT = 0
192
193 brick_list(nin,ib)%POLY(1)%WhereIsMain(1:2) = 0
194 brick_list(nin,ib)%POLY(1)%WhereIsMain(3) = id
195 brick_list(nin,ib)%POLY(1)%WhereIsMain(4) = ib
196
197 DO k=1,6
198 brick_list(nin,ib)%POLY(1)%FACE(k)%Adjacent_Cell(1) = brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(1)
199 brick_list(nin,ib)%POLY(1)%FACE(k)%Adjacent_Cell(2) = brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(2)
200 brick_list(nin,ib)%POLY(1)%FACE(k)%Adjacent_Cell(3) = brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(3)
201 brick_list(nin,ib)%POLY(1)%FACE(k)%Adjacent_Cell(4) = brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(4)
202 brick_list(nin,ib)%POLY(1)%FACE(k)%Adjacent_Cell(5) = brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(5)
203 ENDDO !next K
204
205 DO k=1,6
206 brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(1) = 0
207 brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(2) = 0
208 brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(3) = 0
209 brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(4) = 0
210 brick_list(nin,ib)%POLY(9)%FACE(k)%Adjacent_Cell(5) = 0
211 ENDDO !next K
212
213 brick_list(nin,ib)%POLY(1)%FACE(1:6)%NAdjCell = brick_list(nin,ib)%POLY(9)%FACE(1:6)%NAdjCell
214 brick_list(nin,ib)%POLY(9)%FACE(1:6)%NAdjCell = 0
215
216 brick_list(nin,ib)%POLY(1)%ListNodID(1:8) = (/1,2,3,4,5,6,7,8/)
217 brick_list(nin,ib)%POLY(9)%ListNodID(1:8) = 0
218
219 brick_list(nin,ib)%POLY(1)%Vnew = brick_list(nin,ib)%POLY(9)%Vnew
220 brick_list(nin,ib)%POLY(9)%Vnew = zero
221
222 brick_list(nin,ib)%POLY(1)%FACE(1:6)%Surf = brick_list(nin,ib)%Face_Brick(1:6)
223 !BRICK_LIST(NIN,IB)%POLY(1)%FACE( J)%Surf = ZERO
224 brick_list(nin,ib)%POLY(9)%FACE(1:6)%Surf = zero
225
226 brick_list(nin,ib)%PCUT(1)%N(1:3) = zero
227 brick_list(nin,ib)%PCUT(1)%B(1:3) = zero
228 brick_list(nin,ib)%PCUT(1)%SCUT = zero
229 brick_list(nin,ib)%PCUT(1)%SEFF = zero
230 brick_list(nin,ib)%PCUT(1)%P(1:3,1:6) = zero
231 brick_list(nin,ib)%PCUT(1)%NP = 0
232
233 brick_list(nin,ib)%POLY(1)%CellCENTER(1:3) = brick_list(nin,ib)%POLY(9)%CellCENTER(1:3)
234
235 brick_list(nin,ib)%SECTYPE(1) = 'REMOVED 0-CELL'
236
237 !optim : no time to optim, will be treated later, meanwhile a second pass is done in sinit22.F
238c !---UPDATING ADJACENT CELL
239c !adjacent brick
240c NAdjv = BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%NAdjCell
241c DO IADJv=1,NADJv
242c IF (BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%Adjacent_Cell(IADJv)==ICELL_TARGET)EXIT
243c ENDDO
244c BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%Adjacent_Cell(IADJv) = 1 !it remains in this case only the full brick.
245c !---local brick
246c !if the new merged cell (after destroy) has already IBv.ICELLv as an adjacent cell, do not add it.
247c NADj = BRICK_LIST(NIN,IB)%POLY(1)%FACE(J)%NAdjCell
248c bFOUND = .FALSE.
249c DO IADJ=1,NADJ
250c IF (BRICK_LIST(NIN,IBv)%POLY(1)%FACE(J)%Adjacent_Cell(IADJ)/=ICELL_TARGET) EXIT
251c ENDDO
252c IF(IADJ<=NADJ)THEN
253c !traiter ici l'adjacence en 3D : boucler sur toutes les voisines de toutes les faces, si = 1ou 9 selon ICELL_TARGET, mettre jour
254c a
255c BRICK_LIST(NIN,IB)%POLY(1)%FACE(J)%Adjacent_Cell(IADJ) = ICELLv
256c ENDIF
257 ELSE
258 !--------------------------------------------------------------------------------!
259 ! CASE OF MORE THAN TWO CELLS {1,2,..,9} !
260 !--------------------------------------------------------------------------------!
261 !ICELL_TARGET CAN'T BE CELL 9 : ENSURED BY PARTIIONNING CONSTRUCTION
262 !FOUR STEPS :
263 ! -1- KEEP CELLS FROM 1:ICELL_TARGET-1
264 ! -2- SHIFT CELLS FROM (ICELL_TARGET+1 : NBCUT) TO ICELL_TARGET:(NBCUT-1)
265 ! -3- ERASE CELL ICELL_TARGET (FOR DEBUG PURPOSE : RESET IT AND TAG AS REMOVED ONE)
266 ! -4- UPDATE CELL 9 ACCORDINGLY
267 ! -5- UPDATE ADJACENCY
268 face_cell(1:6) = brick_list(nin,ib)%POLY(icell_target)%FACE(1:6)%Surf
269 numnodes_cell = brick_list(nin,ib)%POLY(icell_target)%NumNOD
270 numintp = brick_list(nin,ib)%POLY(icell_target)%NumPOINT - numnodes_cell
271 numpoint_face(1:6) = brick_list(nin,ib)%POLY(icell_target)%FACE(1:6)%NumPOINT
272 listnodid(1:8) = brick_list(nin,ib)%POLY(icell_target)%ListNodID(1:8)
273 !---STEP 1
274 icell = icell_target - 1
275 !---STEP 2
276 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} \ {9}
277 icell = icell +1
278 IF (icell>=ncell)EXIT
279 brick_list(nin,ib)%SECID_Cell(icell) = brick_list(nin,ib)%SECID_Cell(icell+1)
280 brick_list(nin,ib)%POLY(icell)%NumNOD = brick_list(nin,ib)%POLY(icell+1)%NumNOD
281 brick_list(nin,ib)%POLY(icell)%NumPOINT = brick_list(nin,ib)%POLY(icell+1)%NumPOINT
282 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%NumPOINT = brick_list(nin,ib)%POLY(icell+1)%FACE(1:6)%NumPOINT
283 DO k=1,6
284 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(1) = brick_list(nin,ib)%POLY(icell+1)%FACE(k)%Adjacent_Cell(1)
285 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(2) = brick_list(nin,ib)%POLY(icell+1)%FACE(k)%Adjacent_Cell(2)
286 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(3) = brick_list(nin,ib)%POLY(icell+1)%FACE(k)%Adjacent_Cell(3)
287 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(4) = brick_list(nin,ib)%POLY(icell+1)%FACE(k)%Adjacent_Cell(4)
288 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(5) = brick_list(nin,ib)%POLY(icell+1)%FACE(k)%Adjacent_Cell(5)
289 ENDDO
290 brick_list(nin,ib)%POLY(icell)%FACE(1)%NAdjCell = brick_list(nin,ib)%POLY(icell+1)%FACE(1)%NAdjCell
291 brick_list(nin,ib)%POLY(icell)%ListNodID(1:8) = brick_list(nin,ib)%POLY(icell+1)%ListNodID(1:8)
292 brick_list(nin,ib)%POLY(icell)%Vnew = brick_list(nin,ib)%POLY(icell+1)%Vnew
293 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Surf = brick_list(nin,ib)%POLY(icell+1)%FACE(1:6)%Surf
294 brick_list(nin,ib)%PCUT(icell)%N(1:3) = brick_list(nin,ib)%PCUT(icell+1)%N(1:3)
295 brick_list(nin,ib)%PCUT(icell)%B(1:3) = brick_list(nin,ib)%PCUT(icell+1)%B(1:3)
296 brick_list(nin,ib)%PCUT(icell)%SCUT = brick_list(nin,ib)%PCUT(icell+1)%SCUT
297 brick_list(nin,ib)%PCUT(icell)%SEFF = brick_list(nin,ib)%PCUT(icell+1)%SEFF
298 brick_list(nin,ib)%PCUT(icell)%P(1:3,1:6) = brick_list(nin,ib)%PCUT(icell+1)%P(1:3,1:6)
299 brick_list(nin,ib)%PCUT(icell)%NP = brick_list(nin,ib)%PCUT(icell+1)%NP
300 brick_list(nin,ib)%SECTYPE(icell) = brick_list(nin,ib)%SECTYPE(icell+1)
301 brick_list(nin,ib)%POLY(icell)%CellCENTER(1:3) = brick_list(nin,ib)%POLY(icell+1)%CellCENTER(1:3)
302 enddo!next ICELL
303 !---STEP 3
304 icell = nbcut
305 brick_list(nin,ib)%SECID_Cell(icell) = 0
306 brick_list(nin,ib)%POLY(icell)%NumNOD = 0
307 brick_list(nin,ib)%POLY(icell)%NumPOINT = 0
308 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%NumPOINT = 0
309 DO k=1,6
310 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(1) = 0
311 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(2) = 0
312 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(3) = 0
313 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(4) = 0
314 brick_list(nin,ib)%POLY(icell)%FACE(k)%Adjacent_Cell(5) = 0
315 ENDDO
316 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%NAdjCell = 0
317 brick_list(nin,ib)%POLY(icell)%ListNodID(1:8) = 0
318 brick_list(nin,ib)%POLY(icell)%Vnew = zero
319 brick_list(nin,ib)%POLY(icell)%FACE(1:6)%Surf = zero
320 brick_list(nin,ib)%POLY(icell)%FACE0%Surf = zero
321 brick_list(nin,ib)%PCUT(icell)%N(1:3) = zero
322 brick_list(nin,ib)%PCUT(icell)%B(1:3) = zero
323 brick_list(nin,ib)%PCUT(icell)%SCUT = zero
324 brick_list(nin,ib)%PCUT(icell)%SEFF = zero
325 brick_list(nin,ib)%PCUT(icell)%P(1:3,1:6) = zero
326 brick_list(nin,ib)%PCUT(icell)%NP = 0
327 brick_list(nin,ib)%SECTYPE(icell) = 'REMOVED 0-CELL'
328 !---STEP 4
329 brick_list(nin,ib)%NBCUT = nbcut - 1
330 DO inod=1,8
331 IF(brick_list(nin,ib)%NODE(inod)%WhichCell==icell_target)brick_list(nin,ib)%NODE(inod)%WhichCell=9
332 ENDDO
333 DO i=1,6
334 !merge faces of destroyed cell with cell 9
335 brick_list(nin,ib)%POLY(9)%FACE(i)%Surf = brick_list(nin,ib)%POLY(9)%FACE(i)%Surf + face_cell(i)
336 ENDDO
337 nlistnod9 = brick_list(nin,ib)%POLY(9)%NumNOD
338 brick_list(nin,ib)%POLY(9)%NumNOD = brick_list(nin,ib)%POLY(9)%NumNOD + numnodes_cell
339 brick_list(nin,ib)%POLY(9)%NumPOINT = brick_list(nin,ib)%POLY(9)%NumPOINT - numintp
340 DO i=1,6
341 brick_list(nin,ib)%POLY(9)%FACE(i)%NumPOINT = brick_list(nin,ib)%POLY(9)%FACE(i)%NumPOINT + numpoint_face(i)
342 ENDDO
343 brick_list(nin,ib)%POLY(9)%ListNodID(nlistnod9+1:8) = listnodid(1:numnodes_cell)
344
345
346 brick_list(nin,ib)%POLY(icell)%WhereIsMain(1:4) = brick_list(nin,ib)%POLY(9)%WhereIsMain(1:4)
347
348
349 !---STEP 5
350 !optim : no time to optim, will be treated later, meanwhile a second pass is done in sinit22.F
351c !---adjacent brick
352c NAdjv = BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%NAdjCell
353c DO IADJv=1,NADJv
354c IF (BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%Adjacent_Cell(IADJv)==ICELL_TARGET)EXIT
355c ENDDO
356c BRICK_LIST(NIN,IBv)%POLY(ICELLv)%FACE(Jv)%Adjacent_Cell(IADJv) = 9
357c !---local brick
358c !if the new merged cell (after destroy) has already IBv.ICELLv as an adjacent cell, do not add it.
359c NADj = BRICK_LIST(NIN,IB)%POLY(9)%FACE(J)%NAdjCell
360c bFOUND = .FALSE.
361c DO IADJ=1,NADJ
362c IF (BRICK_LIST(NIN,IBv)%POLY(9)%FACE(J)%Adjacent_Cell(IADJ)==ICELLv) bFOUND = .TRUE.
363c ENDDO
364c IF(.NOT.bFOUND)THEN
365c NADj = NADj + 1
366c BRICK_LIST(NIN,IB)%POLY(9)%FACE(J)%NAdjCell = NADj
367c BRICK_LIST(NIN,IB)%POLY(9)%FACE(J)%Adjacent_Cell(IADJ) = ICELLv
368c ENDIF
369 ENDIF
370
371
372
373 END SUBROUTINE
my_real
#define my_real
Definition cppsort.cpp:32
destroy_cell
subroutine destroy_cell(nin, ib, icell_target, icellv, ibv, j, jv, ixs, itask)
Definition destroy_cell.F:32
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::ibug22_destroy
integer ibug22_destroy
Definition cut-cell-search_mod.F:347