OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i22ident.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "task_c.inc"
#include "subvolumes.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i22ident (ixs, x, itask, nin, bufbric)
subroutine i22gbit (iad, icode, idble, nbits, npqts, idb1, idb2, nin)

Function/Subroutine Documentation

◆ i22gbit()

subroutine i22gbit ( integer, intent(in) iad,
integer, intent(inout) icode,
integer, intent(inout) idble,
integer, intent(inout) nbits,
integer, intent(inout) npqts,
integer idb1,
integer idb2,
integer, intent(in) nin )

Definition at line 613 of file i22ident.F.

616C============================================================================
617C Get bit structure of a 12bits integer
618C-----------------------------------------------
619C M o d u l e s
620C-----------------------------------------------
621 USE i22tri_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
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
type(edge_entity), dimension(:,:), allocatable, target edge_list

◆ i22ident()

subroutine i22ident ( integer, dimension(nixs,*) ixs,
dimension(3,*), intent(in) x,
integer itask,
integer nin,
integer, dimension(*) bufbric )

Definition at line 36 of file i22ident.F.

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-----------------------------------------------
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.AND..OR. IF(NBITS==3(NPQTS==1NPQTS==3))GOTO 50 !pas d'autre intersection
246 !------------------------!
247 ! PENTA !
248 !------------------------!
249.AND. IF(NBITS>=4NPQTS>=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.AND. ! IF(NBITS>=5 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.AND. END IF !(NBITS>=4NPQTS>=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.AND.! if(itask==0debug_outp)then
386.or.! if(ibug22_ident==-1 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.AND..AND..OR..AND. ELSEIF(SIZEL==2 ((LIST(1)>=45LIST(1)<=49) (LIST(1)>=51LIST(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.NOT..AND. if((bFOUND)SIZEL==1)then
458 bFOUND = .TRUE.
459 RESULT(1) = LIST(1)
460 RESULT(2) = 0
461.NOT..AND. elseif((bFOUND)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.EQV. IF(db_WRITE .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.AND. !if(itask==0debug_outp)then
497.or. ! if(ibug22_ident==-1 ibug22_ident==ixs(11,brick_list(nin,ib)%id))print *, " final result ="
498.or. ! if(ibug22_ident==-1 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.AND. ! if(itask==0debug_outp)then
512.or..and. ! if(ibug22_ident==-1 ibug22_ident==ixs(11,brick_list(nin,ib)%id) icode/=0)print *,
513 ! . " no intersection detected"
514 ! endif
515 ENDIF
516.AND. ! if(itask==0debug_outp) then
517.or. ! if(ibug22_ident==-1 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.or. if(ibug22_ident==-1 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
#define my_real
Definition cppsort.cpp:32
subroutine i22ident(ixs, x, itask, nin, bufbric)
Definition i22ident.F:38
subroutine i22gbit(iad, icode, idble, nbits, npqts, idb1, idb2, nin)
Definition i22ident.F:616
subroutine interp(tf, tt, npoint, f, tg)
Definition interp.F:35
initmumps id
for(i8=*sizetab-1;i8 >=0;i8--)
type(brick_entity), dimension(:,:), allocatable, target brick_list