C J3ARET    SOURCE    CHAT      05/01/13    00:45:53     5004
      SUBROUTINE J3ARET(BLOCOM,TOL)
C--------------------------------------------------------------------
C
C     ADDITION DES POINTS SUR LES ARRETES
C
C     PP /9/97
C     Pierre Pegon/JRC Ispra
C--------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
C
      SEGMENT BLOCOM
        INTEGER POINT(NPOINT)
        REAL*8 YCOOR(IDIM+1,NPOINT)
        INTEGER MAILL(MM1)
      ENDSEGMENT
C
      DIMENSION V1(3),V2(3),VI(3)
C
      IF(IDIM.EQ.2)THEN
        V1(3)=0.D0
        V2(3)=0.D0
        VI(3)=0.D0
      ENDIF
C
      MM1=MAILL(/1)
      NPOINT=POINT(/1)
      TOL2=TOL**2
C
C     ON BOUCLE SUR TOUS LES CONTOURS
C
      NBSOUS=0
      NBREF=0
      NBNN=2
      DO IE1=1,MM1
        MELEME=MAILL(IE1)
        NBELEM=ICOLOR(/1)
C
C     ... ET SUR TOUS LEURS COTES
C     (ON SIMULE "DO 3 IE2=1,NBELEM" AVEC IE2 ET NBELEM EVENTUELLEMENT CHANGES)
C
        IE2=0
 1      IE2=IE2+1
        IF(IE2.GT.NBELEM)GOTO 3
C       DO IE2=1,NBELEM
          D12=0.D0
          DO IE3=1,IDIM
            V1(IE3)=YCOOR(IE3,NUM(1,IE2))
            V2(IE3)=YCOOR(IE3,NUM(2,IE2))
            D12=D12+(V1(IE3)-V2(IE3))**2
          ENDDO
C
C     ON BOUCLE SUR TOUS LES POINTS ...
C
          DO 2 IE3=1,NPOINT
            DI1=0.D0
            DI2=0.D0
            DO IE4=1,IDIM
              VI(IE4)=YCOOR(IE4,POINT(IE3))
              DI1=DI1+(VI(IE4)-V1(IE4))**2
              DI2=DI2+(VI(IE4)-V2(IE4))**2
            ENDDO
C
C     ... ON ELIMINE CEUX QUI SONT TROP LOIN ...
C
            IF((DI1.GT.D12+TOL2).OR.(DI2.GT.D12+TOL2))GOTO 2
C
C     ... ON ELIMINE CEUX QUI SONT TROP PRES ...
C
            IF((DI1.LT.TOL2).OR.(DI2.LT.TOL2))GOTO 2
C
C     ... CEUX QUI NE SONT PAS ENTRE ...
C
            AAA=0.D0
            DO IE4=1,IDIM
              AAA=AAA+(VI(IE4)-V1(IE4))*(V2(IE4)-V1(IE4))
            ENDDO
            AAA=AAA/D12
            IF(AAA.LT.0.D0.OR.AAA.GT.1.D0)GOTO 2
C
C     ... ET CEUX QUI SONT TROP LOIN DU SEGMENT
C
            BBB=0.D0
            DO IE4=1,IDIM
              BBB=BBB+(VI(IE4)-V1(IE4)-AAA*(V2(IE4)-V1(IE4)))**2
            ENDDO
            IF(BBB.GT.TOL2)GOTO 2
C
C     ON INCERE LES POINT RESTANT DANS LE MAILLAGE
C     WARNING: ON LE FAIT SANS DUPLICATION
C
            NBELEM=NBELEM+1
            SEGADJ, MELEME
            ICOLOR(NBELEM)=ICOLOR(NBELEM-1)
            IF(IE2.LT.NBELEM)THEN
              DO IE4=NBELEM,IE2+1,-1
                NUM(1,IE4)=NUM(1,IE4-1)
                NUM(2,IE4)=NUM(2,IE4-1)
              ENDDO
            ENDIF
            NUM(2,IE2  )=POINT(IE3)
            NUM(1,IE2+1)=POINT(IE3)

C     ... ET ON REPASSE PAR LE NOUVEAU SEGMENT EN SORTANT DE LA BOUCLE POINT
C
            IE2=IE2-1
            GOTO 1
C
C     FIN BOUCLE POINT
C
 2        CONTINUE
C
C     FIN BOUCLE COTE
C
          GOTO 1
 3      CONTINUE
C
C     FIN BOUCLE FACE
C
      ENDDO
C
      RETURN
      END