C CHEMIN    SOURCE    PASCAL    22/02/24    21:15:02     11298          
      SUBROUTINE CHEMIN(MELEME,IP1,IP2,IPT1)
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
      SEGMENT ICPR(nbpts)
      SEGMENT IPRI(nbpts)
      SEGMENT INEG(nbpts)
      SEGMENT KON(MAXVOI,NPO)
      SEGMENT IVOI(MAXVOI,NPO)
      SEGMENT ILKON(NPO)
      SEGMENT ICHEM
         INTEGER NIVE(NPO+2)
         INTEGER INOE(NPO)
         INTEGER IPERE(nbpts)
      ENDSEGMENT
      SEGINI ICPR
      NPOIN=0
      I1=1
      I2=2
      SEGACT MELEME
      NBELEM=NUM(/2)
      IF(ITYPEL.NE.2.AND.ITYPEL.NE.3) THEN
        CALL ERREUR(16)
        SEGDES MELEME
        RETURN
      ENDIF
      IF(ITYPEL.EQ.3) I2=3
*
*  en entree MELEME est suppose ne contenir que des elements de meme
*  type. Soit des seg2 soit des seg3. ICPR(I)=J l'ancien Ieme noeud
* est le Jeme local
*
*   comptage des voisins
*
      DO 1 I=1,NUM(/2)
      IJ= NUM(I1,I)
      ICPR(IJ)=ICPR(IJ)+1
      IJ= NUM(I2,I)
      ICPR(IJ)=ICPR(IJ)+1
   1  CONTINUE
      IF(ICPR(IP1).EQ.0.OR.ICPR(IP2).EQ.0) THEN
         CALL ERREUR(866)
         RETURN
      ENDIF
      MAXVOI=0
      NPO=0
      DO 2 I=1,ICPR(/1)
      IF(ICPR(I).NE.0) THEN
         MAXVOI=MAX(MAXVOI,ICPR(I))
         NPO=NPO+1
         ICPR(I)=NPO
      ENDIF
    2 CONTINUE
*
* fabrication du tableau KON(I,J)=k le iémé noeud connecté au noeud
* J est le Keme noeud
      SEGINI KON,ILKON,IVOI
      DO 3 I=1,NUM(/2)
      IA=NUM(I1,I)
      IB=NUM(I2,I)
      IACP=ICPR(IA)
      IBCP=ICPR(IB)
      ILKON(IACP)=ILKON(IACP)+1
      ILKON(IBCP)=ILKON(IBCP)+1
      KON(ILKON(IACP),IACP)=IB
      KON(ILKON(IBCP),IBCP)=IA
      IVOI(ILKON(IACP),IACP)=I
      IVOI(ILKON(IBCP),IBCP)=I
   3  CONTINUE
*
* on demarre l'arbre en partant du point IP2
*
      SEGINI ICHEM,IPRI,INEG
      IDEP=IP2
      IPLA=1
      INUM=1
      NIVE(1)=1
      NIVE(2)=2
      INOE(IPLA)=IP2
      IPRI(IP2)=1
      IPERE(IP2)=0
      IDER=0
      IAV=0
  100 CONTINUE
      IF(IDER.EQ.1) GO TO 101
      IF(IPLA.EQ.IAV) GO TO 101
      IAV=IPLA
      IF(IPLA.GE.NPO) IDER=1
      IDEB=NIVE(INUM)
      IFIN=NIVE(INUM+1)-1
      DO 104 I=IDEB,IFIN
         IA=INOE(I)
         IC=IPERE(IA)
         DO 105 J=1,ILKON(ICPR(IA))
            IB=KON(J,ICPR(IA))
            IF(IB.EQ.IC) GO TO 105
            if (ib.eq.0) goto 105
            IF(IPRI(IB).EQ.0) THEN
                IPLA=IPLA+1
                INOE(IPLA)=IB
                IPRI(IB)=INUM+1
                IPERE(IB)=IA
             ELSE
*
* on remonte le long des deux branches pour trouver la partie commune
*
                J1=IA
                J2=IB
                L1=IPRI(IA)
                L2=IPRI(IB)
                IF(L1.LT.L2) THEN
                    J2=IPERE(J2)
                    L2=IPRI(J2)
                ENDIF
                IF(L1.GT.L2) THEN
                     J1=IPERE(J1)
                     L1=IPRI(J1)
                ENDIF
  106           CONTINUE
                IF(J2.NE.J1) THEN
                   J1=IPERE(J1)
                   J2=IPERE(J2)
                   GO TO 106
                ELSE
                   INEG(J2)=1
                ENDIF
            ENDIF
 105     CONTINUE
 104  CONTINUE
      INUM=INUM+1
      NIVE(INUM+1)=IPLA+1
      GO TO 100
 101  CONTINUE
      IF(IPRI(IP1).EQ.0) THEN
        CALL ERREUR(868)
        SEGDES MELEME
        SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI
        RETURN
      ENDIF
      IF(INEG(IP2).EQ.1) THEN
        CALL ERREUR(867)
        SEGDES MELEME
        SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI
        RETURN
      ENDIF
*
* on recommence l'arbre mais on met en negatif toutes les cycles
*
      DO 199 I=1,IPRI(/1)
        IPRI(I)=0
  199 CONTINUE
      IPLA=1
      INUM=1
      NIVE(1)=1
      NIVE(2)=2
      INOE(IPLA)=IP2
      IPRI(IP2)=1
      IPERE(IP2)=0
      IAV=0
  200 CONTINUE
      IF(IPLA.GE.NPO) GO TO 201
      IF(IPLA.EQ.IAV) GO TO 201
      IAV=IPLA
      IDEB=NIVE(INUM)
      IFIN=NIVE(INUM+1)-1
      DO 204 I=IDEB,IFIN
         IA=INOE(I)
         IC=IPERE(IA)
         ID=INEG(IA)
         DO 205 J=1,ILKON(ICPR(IA))
            IB=KON(J,ICPR(IA))
            IF(IB.EQ.IC) GO TO 205
            IF(IB.EQ.0) GO TO 205
            IF(IPRI(IB).EQ.0) THEN
                IPLA=IPLA+1
                INOE(IPLA)=IB
                IPRI(IB)=INUM+1
                IPERE(IB)=IA
                IF(ID.GT.0) INEG(IB)=1
            ENDIF
 205     CONTINUE
 204  CONTINUE
      INUM=INUM+1
      NIVE(INUM+1)=IPLA+1
      GO TO 200
  201 CONTINUE
*
*   si ineg(IP1)=0  la tache est possible sinon retour
*
      IF(INEG(IP1).EQ.1)THEN
        CALL ERREUR(867)
        SEGDES MELEME
        SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI
        RETURN
      ENDIF
      NBELEM=IPRI(IP1)-1
      NBNN = NUM(/1)
      NBSOUS=0
      NBREF=0
      SEGINI IPT1
      IPT1.NUM(1,1)=IP1
      IPA=IP1
      IPO=1
  302 CONTINUE
      IB=IPERE(IPA)
      DO 303 I=1,ILKON(ICPR(IPA))
        IF(IB.NE.KON(I,ICPR(IPA)))  GO TO 303
        IV=IVOI (I,ICPR(IPA))
        IF(NBNN.EQ.3) IPT1.NUM(2,IPO)=NUM(2,IV)
        IPT1.ICOLOR(IPO)=ICOLOR(IV)
        IPT1.NUM(I2,IPO)=IB
        IF(IB.NE.IP2)  THEN
            IPA=IB
            IPO=IPO+1
            IPT1.NUM(1,IPO)=IB
            GO TO 302
        ENDIF
        GO TO 304
  303 CONTINUE
      CALL ERREUR(21)
      RETURN
  304 CONTINUE
      IPT1.ITYPEL=I2
      SEGDES IPT1,MELEME
      SEGSUP ICHEM,ILKON,KON,ICPR,IPRI,INEG,IVOI
      RETURN
      END