OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
int22ListCombi.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "subvolumes.inc"
#include "inter22.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

recursive subroutine int22listcombi (itask, arg_listfix, arg_sizefix, arg_listvar, arg_sizevar, nintp, icode, idble, lvl, result, bfound)

Function/Subroutine Documentation

◆ int22listcombi()

recursive subroutine int22listcombi ( integer, intent(in) itask,
integer, dimension(arg_sizefix), intent(in) arg_listfix,
integer, intent(in) arg_sizefix,
integer, dimension(arg_sizevar), intent(in) arg_listvar,
integer, intent(in) arg_sizevar,
integer, intent(in) nintp,
integer, intent(in) icode,
integer, intent(in) idble,
integer lvl,
integer, dimension(8), intent(inout) result,
logical, intent(inout) bfound )

Definition at line 33 of file int22ListCombi.F.

37C-----------------------------------------------
38C D e s c r i p t i o n
39C-----------------------------------------------
40C Interface Type22 (/INTER/TYPE22) is an FSI coupling method based on cut cell method.
41C This experimental cut cell method is not completed, abandoned, and is not an official option.
42C
43C Recursive combinatory algorithm.
44C
45C This subroutines determine from a list of
46C potential combinations all possible combination
47C taken into account brick nodes used by each
48C polyhedra. furthermore if two polyhedron in this
49C list of combinationa re using the same edge then
50C this edge has to be taged in IDBLE binary code.
51C ListFIX : sublist of combination which is used
52C with other taken from ListVAR
53C ListVAR : sublist of combination from which
54c combination are taken to test a
55C potential combination. Is Updated
56C to remove incompatibility with
57C combination in ListFIX. Is expanded
58C into new sublist to test new recursively
59C new list os combination
60C NBITS : number of bits which represent the
61C number of intersection points (on brick edges)
62C remains UNCHANGED in the recursion process
63C ICODE : Binary code for intersected edges
64C remains UNCHANGED in the recursion process
65C IDBLE : Binary code for multiple intersection edge
66C remains UNCHANGED in the recursion process
67C
68C-----------------------------------------------
69C M o d u l e s
70C-----------------------------------------------
71 USE i22bufbric_mod
72 USE i22tri_mod
73 USE i22edge_mod
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78#include "comlock.inc"
79C-----------------------------------------------
80C C o m m o n B l o c k s
81C-----------------------------------------------
82#include "subvolumes.inc"
83#include "inter22.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 INTEGER,INTENT(IN) :: arg_SizeFIX,arg_SizeVAR ,NINTP,ICODE,IDBLE
88 INTEGER,INTENT(INOUT) :: RESULT(8)
89 INTEGER,INTENT(IN) :: arg_ListFIX(arg_SizeFIX),arg_ListVAR(arg_SizeVAR)
90 LOGICAL,INTENT(INOUT) :: bFOUND
91 INTEGER,INTENT(IN) :: ITASK
92
93 INTEGER :: SizeFIX,SizeVAR
94 INTEGER :: ListFIX(arg_SizeFIX),ListVAR(arg_SizeVAR)
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER :: I,II,J,K,L,COUNT,CountVAR,CountFIX,ITYP,pCODE,lIDBLE
99 INTEGER :: LIST(32+8),SizeL
100 INTEGER :: IBIN
101 INTEGER :: LLVAR(arg_SizeVAR,arg_SizeVAR-1), SizeLLVAR
102 INTEGER :: LLFIX(arg_SizeVAR,arg_SizeFIX+1), SizeLLFIX
103 INTEGER :: SizeLLVAR_bak
104 INTEGER :: IKEEP
105 INTEGER :: TAG(12),TAG_nod(8),TAG_edg(12), Lnbit, Lcode, Ldble, NNOD, NEDG
106 INTEGER :: IDOUBLE(12),lvl
107 INTEGER :: TAG_nod_fix(8),TAG_edg_fix(12),TAG_nod_bak(8),TAG_nod_tmp(8)
108 LOGICAL :: bool,bCOMPL
109C-----------------------------------------------
110C P r e - C o n d i t i o n
111C-----------------------------------------------
112 IF(int22==0) RETURN
113 IF(bfound)RETURN
114C-----------------------------------------------
115C S o u r c e L i n e s
116C-----------------------------------------------
117ccc print *, "entering int22ListCombi.F"
118ccc print *, "lvl=", lvl, "with ListVar="
119ccc print *, arg_ListVAR(1:arg_SizeVAR)
120
121 !--------------------------------------------------!
122 ! CREATING LOCAL COPY !
123 !--------------------------------------------------!
124 sizefix = arg_sizefix
125 sizevar = arg_sizevar
126 listfix = arg_listfix
127 listvar = arg_listvar
128
129
130 !--------------------------------------------------!
131 ! COUNTING ACTIVATES BITS !
132 !--------------------------------------------------!
133 count = 0
134 countfix = 0
135 countvar = 0
136 !accumulation of intersection points required by each combination present in the Fixed List.
137 DO i=1,sizefix
138 pcode = iabs(listfix(i))
139 ityp = getpolyhedratype(pcode)
140 countfix = countfix + c_polyh(ityp)
141 ENDDO !next I
142 !accumulation of intersection points required by each combination present in the Variable List.
143 DO i=1,sizevar
144 pcode = listvar(i)
145 ityp = getpolyhedratype(pcode)
146 countvar = countvar + c_polyh(ityp)
147 ENDDO !next I
148 count = countfix + countvar
149
150ccc print *, COUNT,COUNTfix,COUNTVAR,NINTP
151
152 !--------------------------------------------------!
153 ! NOT ENOUGH BITS !
154 !--------------------------------------------------!
155 IF(count < nintp .OR. countfix > nintp)THEN
156 !DO NOTHING : LIST OF COMBINATION IS NOT RETAINED
157ccc print *, " *** SKIPPED"
158 RETURN
159 !--------------------------------------------------!
160 ! EXACT NUMBER OF BITS - CHECK COMBINATION !
161 !--------------------------------------------------!
162 ELSEIF(countfix == nintp)THEN
163 !List concatenation
164 sizel = sizefix !+ SizeVAR
165 list(1:sizel) = (/ listfix(1:sizefix) /)!,ListVAR(1:SizeVAR) /)
166 !checking that corrects edge bits are activated in full list (IOR criteria)
167 ibin = bcode(iabs(list(1)))
168 DO i=2,sizel
169 ibin = ior(ibin,bcode(iabs(list(i))))
170 ENDDO
171 IF(ibin/=icode)then;
172ccc print*,"return1";RETURN;
173 endif
174 !checking that corrects multiple intersected edge bits are activated in full list(IAND criteria)
175 tag_edg(1:12) = 0 !sum of activated bits for each of 12 ranks
176 DO i=1,sizel
177 pcode = iabs(list(i))
178 ityp = getpolyhedratype(pcode)
179 nedg = c_polyh(ityp)
180 DO j=1,nedg
181 k = iabs(gcorner(j, pcode))
182 tag_edg(k) = tag_edg(k) + 1
183 ENDDO
184 ENDDO
185 lcode = 0
186 ldble = 0
187 lnbit = 0
188 DO j=1,12
189 IF(tag_edg(j)>2) RETURN
190 IF(tag_edg(j)==2) ldble = ibset(ldble,12-j)
191 IF(tag_edg(j)>=1) THEN
192 lcode = ibset(lcode,12-j)
193 !Lnbit = Lnbit + 1
194 ENDIF
195 ENDDO
196 IF(icode /= lcode) RETURN
197 IF(idble /= ldble) RETURN
198 !Storing the correct combination
199#include "lockon.inc"
200 result(1:sizel)=list(1:sizel)
201 bfound = .true.
202#include "lockoff.inc"
203 !--------------------------------------------------!
204 ! TOO MUCH BITS !
205 !--------------------------------------------------!
206 ELSE
207c print *, " *** EXPAND"
208 IF(arg_sizevar==0) RETURN
209 !------------------------------------------------!
210 ! UPDATE FIXED LIST AND VARIABLE LIST (NEW LOCAL)!
211 !------------------------------------------------!
212 !Expanding the variable sublist & taking each combination in variable list to add it in a new fix list.
213 sizellfix = sizefix + 1
214 !SizeLLVAR = SizeVAR - 1
215 !SizeLLVAR_bak = SizeLLVAR
216 DO ii=1,sizevar
217 ikeep = listvar(ii)
218 llfix(ii,1:sizellfix) = (/listfix(1:sizefix), ikeep /)
219ccc IF(SizeLLVAR>=1)LLVAR(II,1:SizeLLVAR) = (/ListVAR(1:II-1),ListVAR(II+1:SizeVAR)/) !retirer IKEEP
220 sizellvar = sizevar-ii
221 IF(sizellvar>=1)llvar(ii,1:sizellvar) = (/listvar(ii+1:sizevar)/) !retirer IKEEP
222 ENDDO
223 DO ii=1,sizevar
224 sizellvar = sizevar-ii!SizeLLVAR_bak
225ccc print *, "=====II = ",II
226ccc print *, "=====LLFIX(II,1:SizeLLFIX) = ",LLFIX(II,1:SizeLLFIX)
227ccc print *, "=====LLVAR(II,1:SizeLLVAR) = ",LLVAR(II,1:SizeLLVAR)
228
229 !------------------------------------------------!
230 ! CHECKING FIXED LIST CONSISTENCY !
231 !------------------------------------------------!
232 !--verifier nombre de bits
233 countfix = 0
234 DO i=1,sizellfix
235 pcode = iabs(llfix(ii,i))
236 ityp = getpolyhedratype(pcode)
237 countfix = countfix + c_polyh(ityp)
238 ENDDO !next I
239 IF(countfix > nintp)cycle
240 !--verifier les sommets isdoles dans LLFIX : doublon impossible
241 tag_nod_fix(1:8) = 0
242 DO i=1,sizellfix
243 bcompl = .false.
244 pcode = llfix(ii,i)
245 IF(pcode<0) bcompl = .true.
246 pcode = iabs(pcode)
247 ityp = getpolyhedratype(pcode)
248 nnod = n_polyh(ityp)
249 bool = .false.
250 tag_nod_bak(1:8) = tag_nod_fix(1:8)
251 IF(bcompl)THEN
252 tag_nod_tmp(1:8) = 1
253 DO j=1,nnod
254 k = gnode(j,pcode)
255 tag_nod_tmp(k) = 0
256 ENDDO
257 DO j=1,8
258 IF( tag_nod_tmp(j)==0)cycle
259 tag_nod_fix(j) = tag_nod_fix(j)+1
260 IF(tag_nod_fix(j) >= 2)GOTO 50 !already a complementary polyhedron, the original one is incompatible with the previous in the list, so exit
261 ENDDO
262 ELSE
263 DO j=1,nnod
264 k = gnode(j,pcode)
265 tag_nod_fix(k) = tag_nod_fix(k)+1
266 IF(tag_nod_fix(k) >= 2)bool=.true.
267 ENDDO
268 ENDIF
269 !this polyhedron also isolate same nodes. Check complementary polyhedron
270 IF(bool)THEN
271 !restore TAG_nod_fix
272 tag_nod_fix(1:8) = tag_nod_bak(1:8)
273 !check complementary nodes
274 tag_nod_tmp(1:8) = 1
275 DO j=1,nnod
276 k = gnode(j,pcode)
277 tag_nod_tmp(k) = 0
278 ENDDO
279 DO j=1,8
280 IF( tag_nod_tmp(j)==0)cycle
281 tag_nod_fix(j) = tag_nod_fix(j)+1
282 IF(tag_nod_fix(j) >= 2)GOTO 50
283 ENDDO
284 !set negative ID to tag a complementary polyhedron
285 llfix(ii,i) = -llfix(ii,i)
286 ENDIF
287 ENDDO !next I
288 !--verifiers les edges de LLFIX : doublon possible seuelemnt si defini dans IDBLE
289 tag_edg_fix(1:12) = 0
290 DO i=1,sizellfix
291 pcode = iabs(llfix(ii,i))
292 ityp = getpolyhedratype(pcode)
293 nedg = c_polyh(ityp)
294 DO j=1,nedg
295 tag_edg_fix(iabs(gcorner(j,pcode))) = tag_edg_fix(iabs(gcorner(j,pcode)))+1
296 IF(tag_edg_fix(iabs(gcorner(j,pcode))) > 2)GOTO 50
297 !IF(TAG_edg_fix(IABS(Gcorner(J,pCODE)))==2 .AND. BTEST(IDBLE,12-IABS(Gcorner(J,pCODE)))==0 )GOTO 50
298
299 !check : 14.31 FEM file abS ( 8:15:59) = ../tests/inter22/INTERSECTIONS/ALL-POLY-TEST/EULER/0.FVM/ALL-POLY-TEST_0000.rad
300 IF(tag_edg_fix(iabs(gcorner(j,pcode)))==2 )THEN
301 IF(btest(idble,12-iabs(gcorner(j,pcode))) .EQV. (.false.))GOTO 50
302 ENDIF
303 ENDDO
304 ENDDO !next I
305 !------------------------------------------------!
306 ! VARIABLE LIST REDUCTION !
307 !------------------------------------------------!
308 !--verifier les sommets isoles dans LLVAR : doublon impossible
309 !conserver les tags de LLVAR ne pas faire de reset : TAG_nod(1:8) = 0
310 i = 1
311ccc print *, "LLVAR(II,1:SizeLLVAR)=", LLVAR(II,1:SizeLLVAR)
312 DO WHILE(i < sizellvar)
313 tag_nod(:) = tag_nod_fix
314 pcode = llvar(ii,i)
315 ityp = getpolyhedratype(pcode)
316 nnod = n_polyh(ityp)
317 DO j=1,nnod
318 k = gnode(j,pcode)
319 tag_nod(k) = tag_nod(k)+1
320 IF(tag_nod(k) >= 2)THEN
321 !removing polyhedra from list
322ccc print *, " removing_a:", LLVAR(II,I)
323ccc print *, " SizeLLVAR,I=:", SizeLLVAR,I
324 sizellvar = sizellvar - 1
325 tag_nod(k) = tag_nod(k)-1 !restore previous tag value since polhedra is removed from list
326 l=i
327 DO WHILE(l<=sizellvar)
328 llvar(ii,l)=llvar(ii,l+1)
329 l = l + 1
330 ENDDO
331ccc print *, " after removing : LLVAR(II,1:SizeLLVAR)=", LLVAR(II,1:SizeLLVAR)
332 GOTO 51
333 ENDIF
334 ENDDO
335 51 CONTINUE
336 i = i + 1
337 ENDDO !next I
338 !--verifiers les edges de LLVAR : doublon possible seuelement si defini dans IDBLE
339 !conserver les tags de LLFIX, ne pas faire de reset : TAG_edg(1:12) = 0
340 i = 1
341 DO WHILE(i < sizellvar)
342ccc print *, "testing LLVAR=", LLVAR(II,I)
343 tag_edg(:) = tag_edg_fix
344 pcode = llvar(ii,i)
345 ityp = getpolyhedratype(pcode)
346 nedg = c_polyh(ityp)
347 DO j=1,nedg
348 k = iabs(gcorner(j,pcode))
349 tag_edg(k) = tag_edg(k)+1
350 !suppression
351 IF(tag_edg(k) > 2 .OR. (tag_edg(k)==2 .AND. .NOT.btest(idble,12-k)))THEN
352 !removing polyhedra from list
353ccc print *, " removing_b:", LLVAR(II,I)
354ccc print *, " SizeLLVAR,I=:", SizeLLVAR,I
355 sizellvar = sizellvar - 1
356 tag_edg(k) = tag_edg(k)-1 !restore previous tag value since polhedra is removed from list
357 l = i
358 DO WHILE (l <= sizellvar)
359 llvar(ii,l)=llvar(ii,l+1)
360 l = l + 1
361 ENDDO
362ccc print *, " after removing : LLVAR(II,1:SizeLLVAR)=", LLVAR(II,1:SizeLLVAR)
363 GOTO 52
364 ENDIF
365 ENDDO
366 52 CONTINUE
367 i = i + 1
368 ENDDO !next I
369 !------------------------------------------------!
370 ! RECURSION !
371 !------------------------------------------------!
372c print *, " passed and call recursion"
373 CALL int22listcombi(itask,llfix(ii,1:sizellfix),sizellfix,llvar(ii,1:sizellvar),sizellvar,nintp,icode,idble,lvl+1,
374 . result, bfound)
375 50 CONTINUE
376 ENDDO ! II=1,SizeVAR
377 endif!(COUNT)
int22listcombi
recursive subroutine int22listcombi(itask, arg_listfix, arg_sizefix, arg_listvar, arg_sizevar, nintp, icode, idble, lvl, result, bfound)
Definition int22ListCombi.F:37
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22edge_mod
Definition cut-cell-buffer_mod.F:48
i22tri_mod
Definition cut-cell-search_mod.F:212