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 614 of file i22ident.F.

617C============================================================================
618C Get bit structure of a 12bits integer
619C-----------------------------------------------
620C M o d u l e s
621C-----------------------------------------------
622 USE i22tri_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
#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 37 of file i22ident.F.

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-----------------------------------------------
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 IF(nbits==3.AND.(npqts==1.OR.npqts==3))GOTO 50 !no other intersection
247 !------------------------!
248 ! PENTA !
249 !------------------------!
250 IF(nbits>=4.AND.npqts>=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 ! IF(NBITS>=5 .AND. 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 END IF !(NBITS>=4.AND.NPQTS>=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! if(itask==0.AND.debug_outp)then
387! if(ibug22_ident==-1 .or. 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 ELSEIF(sizel==2 .AND. ((list(1)>=45.AND.list(1)<=49) .OR. (list(1)>=51.AND.list(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 if((.NOT.bfound).AND.sizel==1)then
459 bfound = .true.
460 result(1) = list(1)
461 result(2) = 0
462 elseif((.NOT.bfound).AND.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 IF(db_write .EQV. .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 !if(itask==0.AND.debug_outp)then
498 ! if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id))print *, " FINAL RESULT ="
499 ! if(ibug22_ident==-1 .or. 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 ! if(itask==0.AND.debug_outp)then
513 ! if(ibug22_ident==-1 .or. ibug22_ident==ixs(11,brick_list(nin,ib)%id) .and.icode/=0)print *,
514 ! . " NO INTERSECTION DETECTED"
515 ! endif
516 ENDIF
517 ! if(itask==0.AND.debug_outp) then
518 ! if(ibug22_ident==-1 .or. 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 if(ibug22_ident==-1 .or. 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
#define my_real
Definition cppsort.cpp:32
subroutine i22gbit(iad, icode, idble, nbits, npqts, idb1, idb2, nin)
Definition i22ident.F:617
recursive subroutine int22listcombi(itask, arg_listfix, arg_sizefix, arg_listvar, arg_sizevar, nintp, icode, idble, lvl, result, bfound)
type(brick_entity), dimension(:,:), allocatable, target brick_list
subroutine my_barrier
Definition machine.F:31