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