C J3COAK    SOURCE    CHAT      05/01/13    00:45:59     5004
      SUBROUTINE J3COAK(WWORK1,VWORK,TOL,IRET)
C----------------------------------------------------
C     COALESCENCE DES TROUS A ET B (ramasse miette pour les trou)
C
C     CODE IST(1,I): 0 point non traite
C                    1 est sur le segment IST(2,I)
C                    2 est sur les segments IST(2,I) et IST(3,I)
C                   -1 est a l'interieur
C                   -2 est a l'exterieur
C
C     CODE CRO(J,I): 1 cote sur le segment
C                   -1 cote interieur
C                   -2 cote exterieur
C
C     PP 6/97 12/98
C     Pierre Pegon/JRC Ispra
C----------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC PPARAM
-INC CCOPTIO
C
      SEGMENT WORK
        REAL*8 XYC(2,NPTO)
        INTEGER IST(3,NPTO)
        REAL*8 DENS(NPTO)
        INTEGER JUN
      ENDSEGMENT
      POINTEUR WORK1.WORK,WORK2.WORK
C
      SEGMENT WWORK
        REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
        INTEGER FWORK
        INTEGER TWORK(NTROU)
      ENDSEGMENT
      POINTEUR WWORK1.WWORK
C
      SEGMENT VWORK
        INTEGER FWWORK(NFACE)
      ENDSEGMENT
C
      LOGICAL LAINB,LAOUB,LAONB,LBINA,LBOUA,LBONA
C
      NTROU1=WWORK1.TWORK(/1)
      NFACE=FWWORK(/1)
C
C     ON BOUCLE SUR LES NOUVELLES FACES ET ON EN EXTRAIT WORK QUE L'ON
C     PLACE EN A (WORK1)
C
      NFACE=FWWORK(/1)
      DO IE1=1,NFACE
        IFACE=NFACE-IE1+1
        WWORK=FWWORK(IFACE)
        NTROU=TWORK(/1)
        IF(NTROU.NE.0)THEN
          IRET=IRET+1
          WRITE(IOIMP,*)'J3COAK: LE NOMBRE DE TROUS DANS LES NOUVELLES'
          WRITE(IOIMP,*)'        FACES DOIT ETRE NUL'
          RETURN
        ENDIF
        WORK1=FWORK
C
C     ON BOUCLE SUR LES TROUS DE A QUE L"ON PLACE EN B (WORK2)
C
        DO IE2=1,NTROU1
          WORK2=WWORK1.TWORK(IE2)
C
C     SI LE TROU EST ENCORE ACTIF ON REGARDE S'IL EST STRICTEMENT CONTENU
C     DANS A (en 98 on adoucit au cas sur les bord!!!)
C
          IF(WORK2.NE.0)THEN
CPP???
            CALL J3COTO(WORK2,WORK1,TOL,IRET)
CPP???
            CALL J3COTO(WORK1,WORK2,TOL,IRET)
            IF(IRET.NE.0)RETURN
            NPTO1=WORK1.XYC(/2)
            CALL J3TES1(WORK1.IST,NPTO1,LAINB,LAOUB,LAONB,NAONB)
            NPTO2=WORK2.XYC(/2)
            CALL J3TES1(WORK2.IST,NPTO2,LBINA,LBOUA,LBONA,NBONA)
C pp98        IF(LBINA)THEN
              IF(.NOT.LBOUA)THEN
C pp98        IF(LBONA)THEN
C pp98          IRET=IRET+1
C pp98          WRITE(IOIMP,*)'J3COAK: A NE PEUT PAS ETRE SUR B'
C pp98          RETURN
C
C     SI OUI, ON BOUGE LE TROU DANS LA NOUVELLE FACE
C
C pp98        ELSE
                NTROU=NTROU+1
                SEGADJ,WWORK
                TWORK(NTROU)=WORK2
                WWORK1.TWORK(IE2)=0
C pp98        ENDIF
            ENDIF
          ENDIF
        ENDDO
      ENDDO
C
      RETURN
      END