C EVOL1     SOURCE    BP208322  22/09/09    21:15:02     11448          
      SUBROUTINE EVOL1(IBOO,ILEX)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C=======================================================================
C SOUS-PROGRAMME APPELE PAR EVOLL1
C FABRIQUE LE(S) LISTREEL KLIST A PARTIR DE LA SUITE DES CHAMPOINTS
C CONTENUE DANS LE SEGMENT MLENTIPOINTE PAR ILEX
C
C
C CREATION    : 16/10/85
C PROGRAMMEUR : FARVACQUE
C=======================================================================
C

-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLENTI
-INC SMLREEL
-INC SMELEME
      SEGMENT NUMOO
       INTEGER NUMO(N),KLIST(N)
       CHARACTER*(LOCHPO) NUDDL(N)
      ENDSEGMENT
      SEGMENT/ITRAV/(NBB(N),ICC(N),ISS(N))
      CHARACTER*(LOCOMP) NUJ
C
      NUMOO=IBOO
      SEGACT NUMOO*MOD
      N=NUMO(/1)
      SEGINI ITRAV
      MLENTI=ILEX
      SEGACT MLENTI
      LTEM=LECT(/1)
      ISS=0
C
C *** PREMIER PASSAGE ON REPERE LE CHAMP ISS ICC NBB
C
      MCHPOI=LECT  (1)
      SEGACT MCHPOI
      NSOUPO=IPCHP(/1)
      KK=0
      DO 70 ISOU=1,NSOUPO
      MSOUPO=IPCHP(ISOU)
      SEGACT MSOUPO
      NC=NOCOMP(/2)
      MELEME=IGEOC
      SEGACT MELEME
      NBELEM=NUM(/2)
      DO 60 NB=1,NBELEM
      J=NUM(1,NB)
      DO 71 JJ=1,N
      IF(J.EQ.NUMO(JJ)) THEN
          NBB(JJ)=NB
          KK=KK+1
          NUJ=NUDDL(JJ)
          DO 72 IC=1,NC
          IF(NOCOMP(IC).EQ.NUJ) THEN
              ICC(JJ)=IC
              ISS(JJ)=ISOU
              GOTO 71
          ENDIF
 72       CONTINUE
          MOTERR(1:4)=NUJ
          CALL ERREUR(243)
C         INCOMPATIBILITE ENTRE LA COMPOSANTE ET LE POINT
          GOTO 5000
      ENDIF
 71   CONTINUE
      IF(KK.EQ.N) THEN
         SEGDES MELEME,MSOUPO
         GOTO 61
      ENDIF
 60   CONTINUE
      SEGDES MELEME,MSOUPO
 70   CONTINUE
C
      INTERR(1)=J
      MOTERR(1:8)='CHPOINT'
      CALL ERREUR(64)
C     DES POINT N'APPARTIENNENT PAS AU CHAMP
      GOTO 5000
C
C  ****** BOUCLE SUR LES CHPOINTS***************************
C
  61  CONTINUE
      JG=LTEM
      DO 99 JJ=1,N
      SEGINI MLREEL
      KLIST(JJ)=MLREEL
 99   CONTINUE
C
      DO 90 L=1,LTEM
      MCHPOI=LECT  (L)
      SEGACT MCHPOI
      DO 40 JJ=1,N
      MSOUPO=IPCHP(ISS(JJ))
      SEGACT MSOUPO
      MPOVAL=IPOVAL
      SEGACT MPOVAL
      MLREEL=KLIST(JJ)
      PROG(L)=VPOCHA(NBB(JJ),ICC(JJ))
      SEGDES MPOVAL,MSOUPO
 40   CONTINUE
      SEGDES MCHPOI
   90 CONTINUE
C
      SEGSUP ITRAV
      DO 98 JJ=1,N
      MLREEL=KLIST(JJ)
      SEGDES MLREEL
  98  CONTINUE
C
      SEGSUP MLENTI
 5000 CONTINUE
      RETURN
      END