C J3UNLO    SOURCE    PV        20/03/24    21:18:26     10554          
      SUBROUTINE J3UNLO(BLOCOM,BLOCO1,MTABLE,TOL)
C--------------------------------------------------------------------
C
C     CHARGEMENT DES POINTS AVEC ELIMINATION AVEC LES POINTS
C                ORIGINAUX
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
-INC SMTABLE
-INC SMCOORD
C
      SEGMENT BLOCOM
        INTEGER POINT(NPOINT)
        REAL*8 YCOOR(IDIM+1,NPOINT)
        INTEGER MAILL(MM1)
      ENDSEGMENT
      POINTEUR BLOCO1.BLOCOM
C
      DIMENSION Y3(4)
C
      SEGACT,MCOORD*MOD
C
      TOL2=TOL**2
      MM1=MLOTAB
C
C     BOUCLE SUR LES BLOCKS (SEULS LES INDICES ENTIERS ... IIE1)
C     WARNING: IPOI DEBUT DES POINTS ORIGINAUX DANS BLOCO1
C              IPOF FIN DES POINT ORIGINAUX DANS BLOCO1
C
      IIE1=0
      IPOI=1
      DO IE1=1,MM1
        IF (MTABTI(IE1).EQ.'ENTIER  ')THEN
          IIE1=IIE1+1
          IPOF=BLOCO1.MAILL(IIE1)
          MTAB1=MTABIV(IE1)
          MM2=MTAB1.MLOTAB
C
C     BOUCLE SUR LES FACES (SEULS LES INDICES ENTIERS ... )
C
          DO IE2=1,MM2
            IF (MTAB1.MTABTI(IE2).EQ.'ENTIER  ')THEN
              MELEME=MTAB1.MTABIV(IE2)
              NBELEM=ICOLOR(/1)
C
C     BOUCLE SUR LES ELEMENTS DES FACES EN PARTICULIER LES 1ER POINTS
C
              ITROU=1
              DO IE3=1,NBELEM
                IPO3=NUM(1,IE3)
                DO IE4=1,IDIM+1
                  Y3(IE4)=YCOOR(IE4,IPO3)
                ENDDO
C
C     ON REGARDE SI CE POINT PEUT ETRE CONFONDU AVEC UN POINT ORIGINAL
C
                DO IE4=IPOI,IPOF
                  NUME=BLOCO1.POINT(IE4)
                  IREF=(NUME-1)*(IDIM+1)
                  AAA=0.D0
                  DO IE5=1,IDIM
                    AAA=AAA+(XCOOR(IE5+IREF)-Y3(IE5))**2
                  ENDDO
                  IF(AAA.LT.TOL2)GOTO 1
                ENDDO
C
C     SI CE N'EST PAS LE CAS, ON L'AJOUTE ...
C
                NBPTS=nbpts+1
                IREF=(NBPTS-1)*(IDIM+1)
                NUME=NBPTS
                SEGADJ,MCOORD
C
C     ... MAIS ON AJOURNE DANS TOUS LES CAS LES COORDONNEES (SURF+DISK!)
C
 1              CONTINUE
                DO IE4=1,IDIM+1
                  XCOOR(IE4+IREF)=Y3(IE4)
                ENDDO
C
C     ON STOCKE LA REFERENCE AU NIVEAU DE LA FACE (ATTENTION AU TROU!)
C
                NUM(1,IE3)=NUME
                IF(IE3.EQ.1)THEN
                  ICAND=NBELEM
                ELSE
                  ICAND=IE3-1
                ENDIF
                IF(NUM(2,ICAND).EQ.IPO3)THEN
                  NUM(2,ICAND)=NUME
                ELSE
                  DO IE4=ITROU,NBELEM
                    IF(NUM(2,IE4).EQ.IPO3)GOTO 2
                  ENDDO
                  WRITE(IOIMP,*)'J3UNLO: IMPOSSIBLE !!!!'
 2                CONTINUE
                  ITROU=IE4+1
                  NUM(2,IE4)=NUME
                ENDIF
C
C     FIN LOOP ELEMENT DE LA FACE
C
              ENDDO
C
C     ON RE-LOOP SUR LA FACE POUR AJOUTER DES POINTS REDONDANT (SURF!)
C
              DO IE3=1,NBELEM-1
                IPO3=NUM(1,IE3)
                IREF3=(IPO3-1)*(IDIM+1)
                DO IE4=IE3+1,NBELEM
                  IF(NUM(1,IE4).EQ.IPO3)THEN
                    NBPTS=nbpts+1
                    IREF=(NBPTS-1)*(IDIM+1)
                    SEGADJ,MCOORD
                    DO IE5=1,IDIM+1
                      XCOOR(IE5+IREF)=XCOOR(IE5+IREF3)
                    ENDDO
                    NUM(1,IE4)=NBPTS
                    IF(NUM(2,IE4-1).NE.IPO3)THEN
                      WRITE(IOIMP,*)'J3UNLO: IMPOSSIBLE (bis) !!!!'
                    ENDIF
                    NUM(2,IE4-1)=NBPTS
                  ENDIF
                ENDDO
              ENDDO
C
C     FIN LOOP FACE
C
              SEGDES,MELEME
            ENDIF
          ENDDO
C
C     FIN LOOP BLOCK
C
          SEGDES,MTAB1
          IPOI=IPOF+1
        ENDIF
      ENDDO
      SEGDES,MTABLE
C
      SEGACT,MCOORD
C
      RETURN
      END