C RACCOR    SOURCE    BP208322  16/11/18    21:20:39     9177           
C  FABRIQUE LES ELEMENTS RACCORD ENTRE DEUX LIGNES
C  EXTRAIT DE COCO
C
      SUBROUTINE RACCOR(IPT1,IPT2,MELEME,PREC)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC CCREEL
*-
-INC SMELEME
-INC SMCOORD
      SEGMENT MTRAV
        REAL*8 TA(NBELEM)
        INTEGER NP1(NBELE1),NP2(NBELE1)
      ENDSEGMENT
C* DIMENSION ITEST(0:NBCOUL-1) - NBCOUL stocke dans CCGEOME
      DIMENSION ITEST(0:30)

      SEGACT,MCOORD
      IDIMP1 = IDIM+1

      PREC3=3.*PREC
      TMAX=-XGRAND
      TMIN= XGRAND

      NB1=IPT1.NUM(/2)
      NB2=IPT2.NUM(/2)
      NBMAX=MIN(NB1,NB2)
      NBNN=IPT1.NUM(/1)
      IF (NBNN.NE.IPT2.NUM(/1)) THEN
        CALL ERREUR(16)
        RETURN
      ENDIF
      DO 40 I=0,NBCOUL-1
 40   ITEST(I)=0
       DO 41 I=1,NB1
              ITEST(IPT1.ICOLOR(I))=1
  41   CONTINUE
       DO 42 I=1,NB2
              ITEST(IPT2.ICOLOR(I))=1
  42   CONTINUE
      ICHCOL=-1
      DO 43 I=0,NBCOUL-1
       IF (ITEST(I).EQ.1) THEN
        IF (ICHCOL.EQ.-1) THEN
              ICHCOL=I
        ELSE
              ICHCOL=ITABM(ICHCOL,I)
        ENDIF
       ENDIF
 43   CONTINUE
      NBELEM=NB2
      NBELE1=NBELEM+1
      SEGINI MTRAV
      DO 11 I=1,NB2
      Z=0.
      DO 12 J=1,NBNN
      IREF=IPT2.NUM(J,I)*IDIMP1-IDIM
      Z=Z+ABS(XCOOR(IREF))+ABS(XCOOR(IREF+1))
      IF (IDIM.NE.2) Z=Z+ABS(XCOOR(IREF+2))
  12  CONTINUE
      Z=Z/NBNN
      TA(I)=Z
      IF(Z.GT.TMAX) TMAX=Z
      IF(Z.LT.TMIN) TMIN=Z
   11 CONTINUE
C
C  CLASSEMENT APPROXIMATIF PAR ' DISTANCE '
C
      IF ((ABS(TMAX).GE.XPETIT).AND.(TMAX-TMIN)/TMAX.GE.1E-6) GOTO 6
      TMAX=TMAX+1.
      TMIN=TMIN-1.
   6  CONTINUE
      TDEC=(TMAX-TMIN)/NBELEM*1.0001
      N =int( PREC/TDEC) + 1
C* Boucle 3 redeondante avec SEGINI MTRAV
C*      DO 3 I=1,NBELE1
C*    3 NP1(I)=0
      DO 4 I=1,NBELEM
      IPLA=int((TA(I)-TMIN)/TDEC)+1
    4 NP1(IPLA)=NP1(IPLA)+1
      DO 400 I=2,NBELE1
  400 NP1(I)=NP1(I-1)+NP1(I)
      DO 5 I=1,NBELEM
      IPLA=int((TA(I)-TMIN)/TDEC)+1
      IPLB=NP1(IPLA)
      NP1(IPLA)=NP1(IPLA)-1
      NP2(IPLB)=I
    5 CONTINUE
C
C   DANS NP1 ADDRESSE DU DEBUT DE ZONE
C   DANS NP2 NUMERO DES ELEMENTS  EN NUMEROTATION  LOCALE
C DANS TA  DISTANCE DES ELEMENTS
C
C   IL FAUT PREPARER LE SEGMENT TAMPON OU METTRE LES ELEMS CREES.
      NBREF=0
      NBSOUS=0
      NBNNOR=NBNN
      NBNN=2*NBNN
      NBELEM=NB1+NB2
      SEGINI MELEME
      IPT4=MELEME
      NBT=NBELEM
      NBELEM=NB2
      NUMELG=0
C
C BOUCLE SUR TOUS LES ELEMENTS POUR CONNAITRE LEUR FACES ET REGARDER SI
C LE CENTRE DE GRAVITE EST CONFONDU A PREC PRES DE CELUI D'UN ELEMENT
C  COQUE
      DO 20 I=1,NB1
      ZAA=0.
      DO 21 J=1,NBNNOR
      IREF=IPT1.NUM(J,I)*IDIMP1-IDIM
      ZAA=ZAA+ABS(XCOOR(IREF))+ABS(XCOOR(IREF+1))
      IF (IDIM.NE.2) ZAA=ZAA+ABS(XCOOR(IREF+2))
   21 CONTINUE
      ZAA=ZAA/NBNNOR
      IZO=int((ZAA-TMIN)/TDEC)+1
      IZO1=IZO-N
      IZO2=IZO+N
      IF(IZO1.LT.1) IZO1=1
      IF(IZO2.GT.NBELEM) IZO2=NBELEM
      IF (IZO.LT.0.OR.IZO.GT.NBELE1) GOTO 20
      DO 28 IZO=IZO1,IZO2
      IDEP=NP1(IZO)+1
      IFIN=NP1(IZO+1)
      IF(IFIN.LT.IDEP)  GO TO 28
      DO 23 JFA=IDEP,IFIN
      IB=NP2(JFA)
      IF(ABS(TA(IB)-ZAA).GT.PREC3)  GO TO 23
C  ON VIENT D'IDENTIFIER UN ELEMENT DE RACCOR ON VA LE CREER
      IREFA=IPT1.NUM(1,I)*IDIMP1-IDIM
      DO 24 IK=1,NBNNOR
      IREFB=IPT2.NUM(IK,IB)*IDIMP1-IDIM
      IF (ABS(XCOOR(IREFA)-XCOOR(IREFB)).GT.PREC) GOTO 24
      IF (ABS(XCOOR(1+IREFA)-XCOOR(1+IREFB)).GT.PREC) GOTO 24
      IF (ABS(XCOOR(2+IREFA)-XCOOR(2+IREFB)).GT.PREC.AND.IDIM.NE.2) GOTO
     #  24
      ISTA=IK
      GO TO 26
  24  CONTINUE
      GO TO 23
  26  CONTINUE
      ISENS=1
      ISTA1=ISTA+1
      ISTAA=ISTA
      IF (ISTA1.GT.NBNNOR) ISTA1=1
      IREFA=IPT1.NUM(2,I)*IDIMP1-IDIM
      IREFB=IPT2.NUM(ISTA1,IB)*IDIMP1-IDIM
      Z=XCOOR(IREFA)-XCOOR(IREFB)
      IF(ABS(Z).GT.PREC) ISENS=-1
      Z=XCOOR(IREFA+1)-XCOOR(IREFB+1)
      IF(ABS(Z).GT.PREC) ISENS=-1
      IF (IDIM.NE.2) THEN
        Z=XCOOR(IREFA+2)-XCOOR(IREFB+2)
        IF (ABS(Z).GT.PREC)  ISENS=-1
      ENDIF
      DO 30 IJ=2,NBNNOR
      IREFA=IPT1.NUM(IJ,I)*IDIMP1-IDIM
      ISTAA=ISTAA+ISENS
      IF (ISTAA.EQ.0) ISTAA=NBNNOR
      IF (ISTAA.GT.NBNNOR) ISTAA=1
      IREFB=IPT2.NUM(ISTAA,IB)*IDIMP1-IDIM
      DO 32 KLP=1,IDIM
      Z=XCOOR(IREFA+KLP-1)-XCOOR(IREFB+KLP-1)
      IF(ABS(Z).GT.PREC) GO TO 23
   32 CONTINUE
   30 CONTINUE
C   CREATION D'UN ELEM RACCORD
      NUMELG=NUMELG+1
      IF (NUMELG.GT.NBMAX) CALL ERREUR(31)
      IF (IERR.NE.0) GOTO 101
      DO 27 IK=1,NBNNOR
      IP1=IPT1.NUM(IK,I)
      IP2=IPT2.NUM(ISTA,IB)
      NUM(IK,NUMELG)=IP1
      NUM(NBNN-IK+1,NUMELG)=IP2
      ISTA=ISTA+ISENS
      IF (ISTA.EQ.0) ISTA=NBNNOR
      IF (ISTA.GT.NBNNOR) ISTA=1
      IF (IP1.NE.IP2) GOTO 27
      INTERR(1)=NUMELG
      CALL ERREUR(101)
  27  CONTINUE
   23 CONTINUE
   28 CONTINUE
   20 CONTINUE
      WRITE(IOIMP,29) NUMELG
   29 FORMAT(//,' NOMBRE D''ELEMENTS DE RACCORD CREES : ',I5)
      NBELEM=NUMELG
      MELEME = 0
      IF (NBELEM.EQ.0) THEN
        CALL ERREUR(26)
        GOTO 101
      ENDIF
      SEGINI MELEME
      IF (NBNN.EQ.4) ITYPEL=12
      IF (NBNN.EQ.6) ITYPEL=13
      DO 100 J=1,NBELEM
      ICOLOR(J)=ICHCOL
      DO 100 I=1,NBNN
      NUM(I,J)=IPT4.NUM(I,J)
 100  CONTINUE
 101  SEGSUP IPT4
      SEGSUP MTRAV

      RETURN
      END