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