OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22ident.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!|| i22ident ../engine/source/interfaces/int22/i22ident.F
25!||--- called by ------------------------------------------------------
26!|| i22buce ../engine/source/interfaces/intsort/i22buce.F
27!||--- calls -----------------------------------------------------
28!|| i22gbit ../engine/source/interfaces/int22/i22ident.F
29!|| int22listcombi ../engine/source/interfaces/int22/int22ListCombi.F
30!|| my_barrier ../engine/source/system/machine.F
31!||--- uses -----------------------------------------------------
32!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
33!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
34!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
35!||====================================================================
36 SUBROUTINE i22ident(
37 1 IXS, X, ITASK, NIN, BUFBRIC)
38C============================================================================
39C-----------------------------------------------
40C D e s c r i p t i o n
41C-----------------------------------------------
42C Interface Type22 (/INTER/TYPE22) is an FSI coupling method based on cut cell method.
43C This experimental cut cell method is not completed, abandoned, and is not an official option.
44C
45C Determine intersection type
46C---------local numbering of edges------------------
47C
48C +------------+------------+
49C 8+--------+7 | iEDGE(1,*) | iEDGE(2,*) | +---12---+ +--------+
50C /| /| +------------+------------+ /| /| /| 3 /|
51C / | / | 1 + 1 + 2 + 11 10 9 6 / | / |
52C 5+--------+6 | 2 + 1 + 4 + +----8---+ | 6 +--------+ | 5
53C | 4|-----|--+3 3 + 1 + 5 + | |---5-|--+ | |-----|--+
54C | / | / 4 + 3 + 2 + 3 2 7 4 | / 4 | /
55C |/ |/ 5 + 3 + 4 + |/ |/ |/ |/
56C +--------+ 6 + 3 + 7 + +----1---+ +--------+
57C 1 2 7 + 6 + 2 +
58C 8 + 6 + 5 + 1
59C 9 + 6 + 7 +
60C LIST OF NODES 10 + 8 + 4 + LIST OF EDGES LIST OF FACES
61C DEFINED WITH 11 + 8 + 5 + DEFINED WITH DEFINED WITH
62C LOCAL IDs 12 + 8 + 7 + LOCAL IDs LOCAL IDs
63C +------------+------------+
64
65C---------identification of cut cell---------
66C
67C +---------------+
68C /| /|
69C / | / |
70C / | / |
71C +---------------+ |
72C | +-----------|---+
73C | / | /
74C T T | / -> edge 1,2,3 <=> 111000000000(3584) <=> TETRA summit 1
75C |/ |/
76C +---T-----------+
77C (1)
78C
79C +====+===+===+===+===+===+===+===+===+===+===+===++
80C || 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10| 11| 12|| -> id EDGE : 1 a 12
81C ++---+---+---+---+---+---+---+---+---+---+---+---++
82C || T | T | T | | | | | | | | | || -> I12bits : 0 ou 1 (tag intersection)
83C ++===+===+===+===+===+===+===+===+===+===+===+===++
84
85
86C-----------------------------------------------
87C M o d u l e s
88C-----------------------------------------------
89 USE i22bufbric_mod
90 USE i22tri_mod
91 USE i22edge_mod
92C-----------------------------------------------
93C I m p l i c i t T y p e s
94C-----------------------------------------------
95#include "implicit_f.inc"
96#include "comlock.inc"
97C-----------------------------------------------
98C C o m m o n B l o c k s
99C-----------------------------------------------
100#include "task_c.inc"
101#include "subvolumes.inc"
102C-----------------------------------------------s
103 INTERFACE
104 FUNCTION i22chk(
105 1 SECtype, Nbits, Npqts)
106 INTEGER :: Nbits, Npqts
107 CHARACTER*(*) :: SECtype
108 LOGICAL :: I22CHK
109 END FUNCTION i22chk
110 END INTERFACE
111C-----------------------------------------------
112C D u m m y A r g u m e n t s
113C-----------------------------------------------
114 INTEGER :: IXS(NIXS,*), ITASK, NIN, BUFBRIC(*)
115 my_real, intent(in) ::
116 . x(3,*)
117C-----------------------------------------------
118C L o c a l V a r i a b l e s
119C-----------------------------------------------
120 INTEGER I, J, JJ, K, L,S, NE, POS, IAD,NBCUT, Icode, Idble, IB
121 INTEGER I_12BITS, PQTS(4), NPQTS, NBITS, SOM, I_bits(12)
122 INTEGER NBF, NBL, ID, N, id1, id2
123 INTEGER NFACE, NEDGE
124 INTEGER :: MAXSOM
125 INTEGER D, M
126 INTEGER,POINTER,DIMENSION(:) :: pCODE, pTAG, pGnod
127 CHARACTER*14,DIMENSION(:),POINTER ::pSEC
128 LOGICAL LTag(18)
129 CHARACTER*14 :: dbKEY1, dbKEY2
130 integer idb1(0:ncandb), idb2(0:ncandb)
131 INTEGER :: tagTETRA(S_TETRA),tagPENTA(S_PENTA),tagPOLY3(S_POLY3),
132 . taghexae(s_hexae),tagpoly4(s_poly4) !tag if there is a potential intersection
133 INTEGER :: MultICODE(S22_MAX), MultIDBLE(S22_MAX)
134 CHARACTER*14 :: MultiSECtype(S22_MAX)
135 INTEGER :: MultiSECid(S22_MAX)
136 LOGICAL :: bool1, bool2
137 INTEGER :: BasedOnUsedNodes
138 INTEGER :: UsedNodes, Gnod
139 INTEGER :: SecTypeList(0:106)
140 INTEGER :: LIST(106), LIST_FIX(8),LIST_VAR(106)
141 INTEGER :: SizeL , SizeLFIX ,SizeLVAR
142 INTEGER :: NINTP , TAB(12)
143 INTEGER :: RESULT(8)
144 LOGICAL :: bFOUND, debug_outp
145 INTEGER :: CODE, brickID, bAND, IE, Iremoved
146 my_real :: point(3),cutcoor
147 LOGICAL :: db_WRITE
148
149C----------------------------------------------------------------
150
151 list_fix(1:8) = 0
152 tagtetra=0
153 tagpenta=0
154 tagpoly3=0
155 taghexae=0
156 tagpoly4=0
157
158C=======================================================================
159C 1 INITIALISATION CODE BINAIRE 12bits
160C=======================================================================
161 nbf = 1+itask*nb/nthread
162 nbl = (itask+1)*nb/nthread
163
164 DO i=nbf,nbl
165 !KEEP TRIPLE POINTS, INTERPRETATION OF PARTITIONING IS MADE TAKING MOST COMPLEX POLY EVEN IF THERE ARE EXPECTED REMAINING INTERSECTION POINTS
166 ! CALL REMOVE_DOUBLE_INTP(
167 ! 1 IXS, X, ITASK, NIN, BUFBRIC,
168 ! 2 I )
169 CALL i22gbit(
170 1 i , icode , idble, nbits, npqts,
171 2 idb1(i), idb2(i), nin )
172 brick_list(nin,i)%ICODE = icode
173 brick_list(nin,i)%IDBLE = idble
174 brick_list(nin,i)%NBITS = nbits
175 brick_list(nin,i)%NPQTS = npqts
176 brick_list(nin,i)%NBCUT = 0
177 END DO
178
179C=======================================================================
180C 2 Debug
181C=======================================================================
182 !---------------------------------------------------------!
183 ! DEBUG OUTPUT !
184 !---------------------------------------------------------!
185 !INTERFACE 22 ONLY - OUTPUT---------------!
186 debug_outp = .false.
187 if(ibug22_ident/=0)then
188 if(ibug22_ident>0)then
189 do ib=nbf,nbl
190 ie=brick_list(nin,ib)%id
191 if(ixs(11,ie)==ibug22_ident)then
192 debug_outp=.true.
193 exit
194 endif
195 enddo
196 elseif(ibug22_ident==-1)then
197 debug_outp = .true.
198 endif
199 endif
200 if(itask==0.AND.debug_outp)then
201 print *, ""
202 print *, " |----------i22ident.F-----------|"
203 print *, " | IDENTIFICATION INTERSECTION |"
204 print *, " |-------------------------------|"
205 end if
206
207
208 DO i=nbf,nbl
209 !===================================================================
210 ! 3 Potential Polyhedron Detection : stored in SecTypeList in [1,106]
211 !===================================================================
212 iremoved = 0
213 10 CONTINUE
214 ib = i
215 sectypelist(:) = 0
216 usednodes = 0
217 k = 1 !numero plan intersection pour %SECtype
218 icode=brick_list(nin,i)%ICODE
219 idble=brick_list(nin,i)%IDBLE
220 nbits=brick_list(nin,i)%Nbits
221 npqts=brick_list(nin,i)%Npqts
222 brick_list(nin,i)%Sectype(1:8) = '--------------'
223
224
225 !-----------------------------------------------------------------------!
226 ! Listing all potential polyhedron !
227 !-----------------------------------------------------------------------!
228
229 IF(nbits<3)GOTO 50 !sous-variete de dim 1
230 !------------------------!
231 ! TETRA !
232 !------------------------!
233 d = d_tetra
234 m = m_tetra
235 s = s_tetra
236 n = n_tetra
237 pcode => bcode(d:d+s-1) !bincode
238 psec => strcode(d:d+s-1) !sectype
239 DO j=1,s
240 IF( iand(icode,pcode(j))==pcode(j) )THEN
241 sectypelist(k) = d+j-1
242 k = k+1
243 END IF
244 END DO
245 IF(nbits==3.AND.(npqts==1.OR.npqts==3))GOTO 50 !pas d'autre intersection
246 !------------------------!
247 ! PENTA !
248 !------------------------!
249 IF(nbits>=4.AND.npqts>=3)THEN
250 d = d_penta
251 m = m_penta
252 s = s_penta
253 n = n_penta
254 pcode => bcode(d:d+s-1) !bincode
255 psec => strcode(d:d+s-1) !sectype
256 DO j=1,s
257 IF( iand(icode,pcode(j))==pcode(j) )THEN
258 sectypelist(k) = d+j-1 !code_id in [1,106]
259 k = k+1
260 END IF
261 END DO
262 !------------------------!
263 ! POLY3 !
264 !------------------------!
265 IF(nbits>=5)THEN !NPQTS>=3 deja verifie
266 d = d_poly3
267 s = s_poly3
268 m = m_poly3
269 n = n_poly3
270 pcode => bcode(d:d+s-1) !bincode
271 psec => strcode(d:d+s-1) !sectype
272 DO j=1,s
273 IF( iand(icode,pcode(j))==pcode(j) )THEN
274 sectypelist(k) = d+j-1 !code_id in [1,106]
275 k = k+1
276 END IF
277 END DO
278 END IF
279 !------------------------!
280 ! HEXAE !
281 !------------------------!
282 IF(npqts==4)THEN !NBIT>=4 deja verifie
283 d = d_hexae
284 m = m_hexae
285 s = s_hexae * m
286 n = n_hexae
287 pcode => bcode(d:d+s-1) !bincode
288 psec => strcode(d:d+s-1) !sectype
289 DO j=1,s
290 IF( iand(icode,pcode(j))==pcode(j) )THEN
291 sectypelist(k) = d+j-1 !code_id in [1,106]
292 k = k+1
293 END IF
294 END DO
295 END IF
296 !------------------------!
297 ! POLY4 !
298 !------------------------!
299 IF(nbits>=6)THEN !NPQTS>=3 deja verifie
300 d = d_poly4
301 m = m_poly4
302 s = s_poly4 * m
303 n = n_poly4
304 pcode => bcode(d:d+s-1)
305 psec => strcode(d:d+s-1)
306 DO j=1,s
307 IF( iand(icode,pcode(j))==pcode(j) )THEN
308 sectypelist(k) = d+j-1 !code_id in [1,106]
309 k = k+1
310 END IF
311 END DO
312 END IF !(NBITS>=6)
313 !------------------------!
314 ! POLY4A !
315 !------------------------!
316 IF(nbits>=6)THEN !NPQTS>=3 deja verifie
317 d = d_poly4a
318 m = m_poly4a
319 s = s_poly4a * m
320 n = n_poly4a
321 pcode => bcode(d:d+s-1)
322 psec => strcode(d:d+s-1)
323 DO j=1,s
324 IF( iand(icode,pcode(j))==pcode(j) )THEN
325 sectypelist(k) = d+j-1 !code_id in [1,106]
326 k = k+1
327 END IF
328 END DO
329 END IF !(NBITS>=6)
330 !------------------------!
331 ! POLY4B !
332 !------------------------!
333 IF(nbits>=6)THEN !NPQTS>=3 deja verifie
334 d = d_poly4b
335 m = m_poly4b
336 s = s_poly4b * m
337 n = n_poly4b
338 pcode => bcode(d:d+s-1)
339 psec => strcode(d:d+s-1)
340 DO j=1,s
341 IF( iand(icode,pcode(j))==pcode(j) )THEN
342 sectypelist(k) = d+j-1 !code_id in [1,106]
343 k = k+1
344 END IF
345 END DO
346 END IF !(NBITS>=6)
347 !------------------------!
348 ! POLYC !
349 !------------------------!
350 ! IF(NBITS>=5 .AND. IDBLE>0)THEN !NPQTS>=3 deja verifie
351 ! D = D_POLYC
352 ! M = M_POLYC
353 ! S = S_POLYC * M
354 ! N = N_POLYC
355 ! pCODE => bCODE(D:D+S-1)
356 ! pSEC => StrCODE(D:D+S-1)
357 ! DO J=1,S
358 ! bAND = IAND(ICODE,pCODE(J))
359 ! bool1 = bAND==pCODE(J)
360 ! IF( bool1 )THEN
361 ! IF(BTEST(IDBLE,12-IABS(Gcorner(5,D+J-1))))THEN
362 ! SecTypeList(K) = D+J-1 !code_id in [1,106]
363 ! K = K+1
364 ! ENDIF
365 ! END IF
366 ! END DO
367 ! END IF !(NBITS>=6)
368 END IF !(NBITS>=4.AND.NPQTS>=3)
369
370 50 CONTINUE
371 sectypelist(0) = k - 1 !number of potential combination
372 sizel = sectypelist(0)
373
374C=======================================================================
375C 4 Output Potential Intersection for each Cut Cell
376C=======================================================================
377
378
379 DO k=1,sectypelist(0)
380 j = sectypelist(k)
381 list(k) = j
382 ENDDO
383
384
385! if(itask==0.AND.debug_outp)then
386! if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id))then
387! print *, " CELL ID * :",IXS(11,BRICK_LIST(NIN,I)%ID)
388! write (*,fmt='(A,I12,A,12L1,A,I12,A,12L1)') , "ICODE =",icode," ", (btest(icode,12-k),k=1,12),
389! . " IDBLE=", IDBLE, " ",(BTEST(IDBLE,12-K),K=1,12)
390! do K=1,SecTypeList(0)
391! J = SecTypeList(K)
392! print *, J, StrCODE(J)
393! enddo
394! endif
395! endif
396
397
398 IF(sectypelist(0)==0)cycle !next IB
399 IF(icode==0)cycle !next IB
400
401
402C=======================================================================
403C 5 Retain only consistent combination
404C=======================================================================
405
406! TAB(1:12) = (/(BTEST(IDBLE,12-J),J=1,12)/)
407! NINTP = NBITS + (SUM(IABS(TAB)))
408 nintp = nbits + popcnt(idble)
409
410 list_var(1:sizel) = list(1:sizel)
411 sizelvar = sizel
412 sizelfix = 0
413
414 result(:) = 0
415 bfound = .false.
416
417 !db
418 brickid = ixs(11,brick_list(nin,i)%ID)
419 db_write = .false.
420
421 IF(sizel==1)THEN
422 IF(icode/=idble)THEN
423 IF(idble == 0)THEN
424 result(1) = list(1)
425 result(2) = 0
426 bfound = .true.
427 ELSE
428 print *, "**WARNING INTER22 : UNUSED INTERSECTION POINTS FOR THIS ELEMENT ",brickid
429 db_write = .true.
430 result(1) = list(1)
431 result(2) = 0
432 bfound = .true.
433 ENDIF
434 ELSE
435 !ICODE/=IDBLE
436 result(1) = list(1)
437 result(2) = list(1)
438 bfound = .true.
439 ENDIF
440 ELSEIF(sizel==2 .AND. ((list(1)>=45.AND.list(1)<=49) .OR. (list(1)>=51.AND.list(1)<=57)))THEN !sigle hexae or poly4
441 IF(list(2) == list(1)+1)THEN
442 IF( icode==idble )THEN
443 bfound = .true.
444 result(1:2) = list(1:2)
445 result(3) = 0
446 ELSEIF(idble==0)THEN
447 bfound = .true.
448 result(1) = list(1)
449 result(2) = 0
450 ELSE
451 print *, "**WARNING INTER22 : UNUSED INTERSECTION POINTS FOR THIS ELEMENT ",brickid
452 db_write = .true.
453 ENDIF
454 ENDIF
455 else!IF(ICODE/=IDBLE)THEN !including twice the same polyhedron (now it takes automatically the complmentary since previous ChangeList)
456 CALL int22listcombi(itask,list_fix,sizelfix,list_var,sizelvar,nintp,icode,idble,0,result,bfound)
457 if((.NOT.bfound).AND.sizel==1)then
458 bfound = .true.
459 result(1) = list(1)
460 result(2) = 0
461 elseif((.NOT.bfound).AND.sizel>1)then
462 ! if( GetPolyhedraType(LIST(1)) /= GetPolyhedraType(LIST(2)) )then
463 !!!!!!!print *, " *** warning inter22 : simplifying intersection for cell id=",brickID
464 bfound = .true.
465 result(1) = list( maxloc(list(1:sizel),1) )
466 result(2) = 0
467 !CALL ARRET(2)
468 ! else
469 ! CALL REMOVE_DOUBLE_INTP(
470 ! 1 IXS, X, ITASK, NIN, BUFBRIC,
471 ! 2 IB )
472 ! print *, " CELL ID EXITING REMOVING DOUBLE INTERP:",IXS(11,BRICK_LIST(NIN,I)%ID)
473 ! Iremoved = Iremoved +1
474 ! IF(Iremoved<=1)GOTO 10
475 ! endif
476 endif
477 ENDIF
478
479 IF(db_write .EQV. .true.)THEN
480 !!------output intersection points!!
481 !print *, " ",IXS(11,brick_list(nin,i)%id)
482 DO j=1,12
483 iad = (i-1)*12+j
484 nbcut = edge_list(nin,iad)%NBCUT
485 DO k=1,nbcut
486 !on ecrit les coordonnees des intersections aux edges
487 cutcoor = edge_list(nin,iad)%CUTCOOR(k)
488 point(1:3) = x(1:3, edge_list(nin,iad)%NODE(1) ) + cutcoor * (edge_list(nin,iad)%VECTOR(1:3))
489 END DO ! (DO K=1,NBCUT <=> NBCUT>0)
490 ENDDO
491 !!---------------
492 ENDIF
493
494 IF(bfound)THEN
495
496 !if(itask==0.AND.debug_outp)then
497 ! if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id))print *, " FINAL RESULT ="
498 ! if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id))print *, "RESULT(1:8)=",RESULT(1:8)
499 !endif
500 j = 1
501 code = result(j)
502 DO WHILE(code/=0)
503 brick_list(nin,i)%SecID_Cell(j) = code
504 brick_list(nin,i)%SECTYPE(j) = strcode(iabs(code))
505 j = j + 1
506 IF(j==9)EXIT
507 code = result(j)
508 ENDDO
509 brick_list(nin,i)%NBCUT = j-1
510 ELSE
511 ! if(itask==0.AND.debug_outp)then
512 ! if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id) .and.icode/=0)print *,
513 ! . " NO INTERSECTION DETECTED"
514 ! endif
515 ENDIF
516 ! if(itask==0.AND.debug_outp) then
517 ! if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id)) then
518 ! print *, ""
519 ! print *, ""
520 ! print *, ""
521 ! endif
522 ! endif
523
524C=======================================================================
525C 6 Solve ambiguity
526C=======================================================================
527 !done in i22subol.F
528
529
530C=======================================================================
531 END DO !I=NBF,NBL
532
533C=======================================================================
534C 5 DEBUG
535C=======================================================================
536 CALL my_barrier !pour affichage complet dans lordre par itask 0
537
538 if(debug_outp)then
539 if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id))then
540
541 !idb1(i) is dependent on ITASK, cannot loop on I=1,NB
542
543 call my_barrier
544 if(itask==0)then
545 do i=nbf,nbl
546 icode=brick_list(nin,i)%ICODE
547 nbits=brick_list(nin,i)%Nbits
548 npqts=brick_list(nin,i)%Npqts
549 print *, " CELL ID -:",ixs(11,brick_list(nin,i)%ID)
550 WRITE(*,fmt='(A20,I10,A4,I10)') " edges add from ",idb1(i)," to ",idb2(i)
551 WRITE(*,fmt='(A11,I4,A20,I2,A1,I1,A1)') " icode=", icode, " (nbits,npqts) = (", nbits,",",npqts,")"
552 WRITE(*,fmt='(A11,I4,A20,I2,A1,I1,A1)') " idble=", idble
553 WRITE(*,fmt='(A,I1)') " num planes=" , brick_list(nin,i)%NBCUT
554 do j=1,brick_list(nin,i)%NBCUT
555 dbkey1(:)=brick_list(nin,i)%SECTYPE(j)
556 if(dbkey1(1:1)=='-') then
557 WRITE(*,fmt='(A)') " --> NONE"
558 else
559 WRITE(*,fmt='(A,A)') " -->",dbkey1(1:14)
560 end if
561 enddo
562 end do
563 endif
564 call my_barrier
565 if(itask==1)then
566 do i=nbf,nbl
567 icode=brick_list(nin,i)%ICODE
568 nbits=brick_list(nin,i)%Nbits
569 npqts=brick_list(nin,i)%Npqts
570 print *, " BRIQUE ID -:",ixs(11,brick_list(nin,i)%ID)
571 WRITE(*,fmt='(A20,I10,A4,I10)') " edges add from ",idb1(i)," to ",idb2(i)
572 WRITE(*,fmt='(A11,I4,A20,I2,A1,I1,A1)') " icode=", icode, " (nbits,npqts) = (", nbits,",",npqts,")"
573 WRITE(*,fmt='(A,I1)') " num planes=" , brick_list(nin,i)%NBCUT
574 do j=1,brick_list(nin,i)%NBCUT
575 dbkey1(:)=brick_list(nin,i)%SECTYPE(j)
576 if(dbkey1(1:1)=='-') then
577 WRITE(*,fmt='(A)') " --> NONE"
578 else
579 WRITE(*,fmt='(A,A)') " -->",dbkey1(1:14)
580 end if
581 enddo
582 end do
583 endif
584 ! call my_barrier
585 ! if(itask==2)then
586 ! endif
587 ! ...
588 end if
589 endif
590
591C if(debug_outp==-1)CALL MY_BARRIER !for debug : program is stopping before the end of this last print
592
593C=======================================================================
594C 6 DETECTION D UNE SUPERPOSITIONDE PENTA OPPOSES
595C=======================================================================
596
597
598 RETURN
599
600 END
601
602
603
604
605!||====================================================================
606!|| i22gbit ../engine/source/interfaces/int22/i22ident.F
607!||--- called by ------------------------------------------------------
608!|| i22ident ../engine/source/interfaces/int22/i22ident.F
609!||--- uses -----------------------------------------------------
610!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
611!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
612!||====================================================================
613 SUBROUTINE i22gbit(
614 1 IAD , Icode, Idble, Nbits, Npqts,
615 2 idb1, idb2, NIN )
616C============================================================================
617C Get bit structure of a 12bits integer
618C-----------------------------------------------
619C M o d u l e s
620C-----------------------------------------------
621 USE i22tri_mod
622 USE i22bufbric_mod
623C-----------------------------------------------
624C I m p l i c i t T y p e s
625C-----------------------------------------------
626#include "implicit_f.inc"
627C-----------------------------------------------
628C D u m m y A r g u m e n t s
629C-----------------------------------------------
630 INTEGER, intent(inout) ::
631 . Icode, Idble, Nbits, Npqts
632 INTEGER, intent(in) ::
633 . IAD, NIN
634C-----------------------------------------------
635C L o c a l V a r i a b l e s
636C-----------------------------------------------
637 INTEGER I,J,Q, pqts(4), NBCUT, IADD, idb1, idb2
638C----------------------------------------------------------------
639
640 Icode = 0
641 idble = 0
642 nbits = 0
643 npqts = 0
644 pqts(1:4)= 0
645 idb1 = 12*ncandb+1
646 idb2 = 0
647
648 DO q=1,4
649 DO i=1,3
650 j=3*(q-1)+i ! J in [1:12]
651 iadd =(iad-1)*12+j
652 idb1=min(idb1,iadd)
653 idb2=max(idb2,iadd)
654 nbcut = edge_list(nin,iadd)%NBCUT
655 IF (nbcut>0) THEN
656 pqts(q) = 1
657 nbits = nbits + 1
658 IF(nbcut>1)idble = ibset(idble,12-j)
659 icode = ibset(icode,12-j) !11:0
660 END IF
661 END DO ! I=1,3
662 END DO ! Q=1,4
663
664 npqts=sum(pqts(1:4))
665
666 RETURN
667 END
668
669
670
i22ident
subroutine i22ident(ixs, x, itask, nin, bufbric)
Definition i22ident.F:38
i22gbit
subroutine i22gbit(iad, icode, idble, nbits, npqts, idb1, idb2, nin)
Definition i22ident.F:616
int22listcombi
recursive subroutine int22listcombi(itask, arg_listfix, arg_sizefix, arg_listvar, arg_sizevar, nintp, icode, idble, lvl, result, bfound)
Definition int22ListCombi.F:37
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::edge_list
type(edge_entity), dimension(:,:), allocatable, target edge_list
Definition cut-cell-search_mod.F:106
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22edge_mod
Definition cut-cell-buffer_mod.F:48
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::nb
integer nb
Definition cut-cell-search_mod.F:487
i22tri_mod::ibug22_ident
integer ibug22_ident
Definition cut-cell-search_mod.F:256
i22tri_mod::ncandb
integer ncandb
Definition cut-cell-search_mod.F:499
my_barrier
subroutine my_barrier
Definition machine.F:31