C COMPRI    SOURCE    PV        20/03/30    21:16:31     10567          
C   CET OPERATEUR EXTRAIT D'UNE LIGNE LA PARTIE COMPRISE ENTRE 2 PTS
C
      SUBROUTINE COMPRI
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCOORD
      SEGMENT ICPR(nbpts)
      SEGMENT IDCP(ITE)
      SEGMENT KON(NBCON,NMAX,3)
      CHARACTER*(8) ITPOIN,ITMAIL
      DATA ITPOIN,ITMAIL/'POINT   ','MAILLAGE'/
      ipt1=0
      CALL LIROBJ(ITMAIL,MELEME,1,IRETOU)
      CALL LIROBJ(ITPOIN,IP1,1,IRETOU)
      CALL LIROBJ(ITPOIN,IP2,1,IRETOU)
      IPA1=IP1
      IPA2=IP2
      IF (IERR.NE.0) RETURN
      SEGACT MELEME
      NBNN=ITYPEL
      IF (NBNN.NE.2.AND.NBNN.NE.3) CALL ERREUR(16)
      IF (IERR.EQ.0) GOTO 1
      SEGDES MELEME
      RETURN
   1  CONTINUE
      SEGINI ICPR
      DO 2 I=1,ICPR(/1)
   2  ICPR(I)=0
C  REMPLISSAGE DE ICPR
      ITE=0
      NBELEM=NUM(/2)
      NBNN=NUM(/1)
      DO 3 J=1,NBNN
      DO 3 K=1,NBELEM
      IPOIT=NUM(J,K)
      IF (ICPR(IPOIT).NE.0) GOTO 3
      ITE=ITE+1
      ICPR(IPOIT)=ITE
   3  CONTINUE
C  TABLEAU INVERSE
      SEGINI IDCP
      ILO=nbpts
      DO 4 I=1,ILO
      J=ICPR(I)
      IF (J.EQ.0) GOTO 4
      IDCP(J)=I
   4  CONTINUE
C   ITE EST LE NOMBRE DE POINTS A TRACER  ICPR LE TABLEAU
C   ON VA MAINTENANT INITIALISER ET REMPLIR LE TABLEAU DES CONNECTIONS
      NBCON=3
      NBCONR=NBCON-1
      NMAX=(5*ITE)/NBCON
      SEGINI KON
C   MISE A ZERO DU TABLEAU KON
      DO 10 K=1,3
      DO 10 I=1,NMAX
      DO 10 J=1,NBCON
  10  KON(J,I,K)=0
C   FABRICATION DU TABLEAU DES CONNECTIONS
      ICHAIN=ITE
      DO 20 I=1,NBELEM
      NMIL=1
      N1=ICPR(NUM(1,I))
      N2=ICPR(NUM(NBNN,I))
      IF (NBNN.EQ.3) NMIL=NUM(2,I)
      IF (N1.EQ.N2) GOTO 20
      NI=N1
      NJ=N2
      KSCOL=ICOLOR(I)
  21  CONTINUE
  22  DO 23 K=1,NBCONR
      IF (KON(K,NI,1).EQ.0) GOTO 25
  23  CONTINUE
      IF (KON(NBCON,NI,1).EQ.0) GOTO 24
      NI=KON(NBCON,NI,1)
      GOTO 22
  24  ICHAIN=ICHAIN+1
      IF (ICHAIN.EQ.NMAX) GOTO 30
      KON(NBCON,NI,1)=ICHAIN
      K=1
      NI=ICHAIN
  25  KON(K,NI,1)=NJ
      KON(K,NI,2)=NMIL
      KON(K,NI,3)=KSCOL
      IF (NMIL.LE.0) GOTO 20
      NI=N2
      NJ=N1
      NMIL=-NMIL
      GOTO 21
  30  CALL ERREUR(23)
      RETURN
  20  CONTINUE
      SEGDES MELEME
C  EXTRACTION DE LA SOUS-PARTIE
      NBSOUS=0
      NBREF=0
*     write (6,*) ' ipt1 nbelem nbnn   ',nbelem nbnn
      SEGINI IPT1
      IP1=ICPR(IP1)
      IP2=ICPR(IP2)
      IF (IP1*IP2.EQ.0) CALL ERREUR(18)
      IF (IERR.EQ.0) GOTO 31
      SEGSUP KON
      RETURN
  31  CONTINUE
      if (ipt1.eq.0) call erreur(5)
      IEL=0
      KAUX=IP1
      K=KAUX
      KPRESS=KAUX
  41  DO 40 KL=1,NBCONR
      M=KON(KL,K,1)
      IF (M.EQ.0) GOTO 100
      IF (KON(KL,K,2).LE.0) GOTO 40
      GOTO 45
  40  CONTINUE
      K=KON(NBCON,K,1)
      IF (K.EQ.0) GOTO 100
      GOTO 41
  46  KL=1
  45  DO 47 L=KL,NBCONR
      M=KON(L,K,1)
      IF (M.EQ.-1) GOTO 47
      IF (M.EQ.0) GOTO 100
      GOTO 48
  47  CONTINUE
      K=KON(NBCON,K,1)
      IF (K.EQ.0) GOTO 100
      GOTO 46
  48  IEL=IEL+1
      IPT1.NUM(1,IEL)=IDCP(KPRESS)
      IPT1.NUM(NBNN,IEL)=IDCP(M)
      IPT1.ICOLOR(IEL)=KON(L,K,3)
      IF (NBNN.EQ.3) IPT1.NUM(2,IEL)=ABS(KON(L,K,2))
      IF (M.EQ.IP2) GOTO 52
      KON(L,K,1)=-1
      M1=M
  49  DO 50 L=1,NBCONR
      IF (KON(L,M1,1).EQ.0) GOTO 53
      IF (KON(L,M1,1).EQ.-1) GOTO 50
      IF (KON(L,M1,1).EQ.KPRESS) GOTO 51
  50  CONTINUE
      M1=KON(NBCON,M1,1)
      GOTO 49
  51  KON(L,M1,1)=-1
  53  KPRESS=M
      K=KPRESS
      GOTO 46
 100  CONTINUE
* on essaye de voir si un seul chemin
      SEGSUP KON,IPT1,ICPR,IDCP
      CALL CHEMIN(MELEME,IPA1,IPA2,IPT1)
      IF(IERR.EQ.0)CALL ECROBJ(ITMAIL,IPT1)
      RETURN
  52  CONTINUE
      SEGSUP KON,ICPR,IDCP
C  ON A FINI IL NE RESTE PLUS QU'A COMPACTER LE SEGMENT
      NBELEM=IEL
      SEGINI MELEME
      ITYPEL=NBNN
      DO 60 I=1,NBNN
      DO 60 J=1,NBELEM
      NUM(I,J)=IPT1.NUM(I,J)
  60  CONTINUE
      DO 61 I=1,NBELEM
  61  ICOLOR(I)=IPT1.ICOLOR(I)
      SEGSUP IPT1
      SEGDES MELEME
      CALL ECROBJ(ITMAIL,MELEME)
      RETURN
      END