C EVOL2     SOURCE    BP208322  22/09/09    21:15:03     11448          
      SUBROUTINE EVOL2(IBOO,ILEX,IBOBAS,ICHAN)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C=======================================================================
C ILEX CONTIENT LA SUITE DES CHPOINTS DES CONTRIBUTIONS MODALES.
C POUR LES COUPLES POINTS-COMPOSANTES CONTENUS DANS NUMOO, ON
C RECOMBINE LES MODES ET SOLUTIONS STATIQUES CONTENUS DANS MSOBAS .
C RESULTAT DANS LE(S) LISTREEL KLIST.
C APPELE PAR EVRECO
C SI ICHAN=0 ON TRAVAILLE SUR UN CHPOINT
C SI ICHAN=1 ON TRAVAILLE SUR UN CHAMELEM ET ON LE TRANSFORME EN
C            CHPOINT PAR UN APPEL A PELPO
C APPELLE : ERREUR(61,243,18) IANUL PROSC1
C CREATION    : 02/04/85
C PROGRAMMEUR : FARVACQUE
C=======================================================================
C

-INC PPARAM
-INC CCOPTIO
-INC SMBASEM
-INC SMCHPOI
-INC SMSOLUT
-INC SMLREEL
-INC SMELEME
-INC SMCOORD
      SEGMENT ICPR(nbpts)
      SEGMENT ICPR1(nbpts)
      SEGMENT/ITRAV1/( TRAV(LDEPL,N)*D)
      SEGMENT/ITRAV2/(TRAVV(LDEPL)*D)
      SEGMENT/ITRAV3/(ICC(N),ISS(N),IPP(N),NBB(N))
      SEGMENT IPOS(NSOUP1)
      SEGMENT ITRAV(2,LDEPL)
      SEGMENT NUMOO
       INTEGER NUMO(N),KLIST(N)
       CHARACTER*(LOCHPO) NUDDL(N)
      ENDSEGMENT
      DIMENSION KDEPL(2),IMEL(2)
      CHARACTER*(LOCOMP) NUJ
C
      NUMOO=IBOO
      SEGACT NUMOO
      N=NUMO(/1)
      MSOBAS=IBOBAS
      SEGACT MSOBAS
      LDEPL=0
      DO 6 ICAS=1,2
      KDEPL(ICAS)=0
      MSOLUT=IBSTRM(ICAS+1)
      IF(MSOLUT.EQ.0) GOTO 6
      SEGACT MSOLUT
      IF (ICHAN.EQ.0) KDEPL(ICAS)=MSOLIS(5)
      IF (ICHAN.EQ.1) KDEPL(ICAS)=MSOLIS(6)
      IMEL(ICAS)=MSOLIS(3)
      SEGDES MSOLUT
      IF(KDEPL(ICAS).EQ.0) THEN
        MOTERR(1:8)=ITYSOL
        CALL ERREUR(61)
        SEGDES MSOBAS
        RETURN
      ENDIF
      MSOLEN=KDEPL(ICAS)
      SEGACT MSOLEN
      LDEPL=LDEPL+ISOLEN(/1)
      SEGDES MSOLEN
    6 CONTINUE
      SEGDES MSOBAS
      LICPR=nbpts
      SEGINI ICPR,ICPR1
C
C  **** FABRICATION DU TABLEAU ICC-ISS-IPP-NBB POUR CHAQUE PT DE SORTIE
C  **** (BOUCLE 30)
C  **** FABRICATION DU TABLEAU TRAV(LDEPL,N) DES MODES REDUITS AUX
C  **** POINTS DE SORTIE (BOUCLE 40)
C
      JJJ=0
      SEGINI ITRAV1
      DO 50 ICAS=1,2
      MSOLEN=KDEPL(ICAS)
      IF(MSOLEN.EQ.0) GOTO 50
      SEGINI ITRAV3
      SEGACT MSOLEN
      IF (ICHAN.EQ.0) THEN
      MCHPOI=ISOLEN(1)
      ELSE
      ICHAM=ISOLEN(1)
C* Manque le passage en MCHAML aux noeuds avec le modele !!!
C*    CALL CHASUP(IPMODL,ICHAM,ICHAM2,IRET,1)
C*    IF (IRET.EQ.0) THEN
C*      CALL ERREUR(___)
C*      RETURN
C*    ENDIF
C*    CALL CHAMPO(ICHAM2,2,MCHPOI,IRET)
      CALL CHAMPO(ICHAM,2,MCHPOI,IRET)
      IF (IRET.EQ.0) RETURN
      ENDIF
      SEGACT MCHPOI
      NSOUPO=IPCHP(/1)
      KK=0
      DO 30 ISOU=1,NSOUPO
      MSOUPO=IPCHP(ISOU)
      SEGACT MSOUPO
      NC=NOCOMP(/2)
      MELEME=IGEOC
      SEGACT MELEME
      CALL IANUL(ICPR(1),LICPR)
      DO 60 NB=1,NUM(/2)
      ICPR(NUM(1,NB))=NB
 60   CONTINUE
      SEGDES MELEME
      DO 61 I=1,N
      IF(ICPR(NUMO(I)).NE.0) THEN
        KK=KK+1
        NBB(KK)=ICPR(NUMO(I))
        NUJ=NUDDL(I)
        DO 72 IC=1,NC
        IF(NOCOMP(IC).EQ.NUJ) THEN
          ICC(KK)=IC
          ISS(KK)=ISOU
          IPP(KK)=I
          GOTO 61
        ENDIF
  72    CONTINUE
        MOTERR=NUJ
        CALL ERREUR(243)
C       INCOMPATIBILITE POINT_COMPOSANTE
        GOTO 5000
      ENDIF
 61   CONTINUE
      SEGDES MSOUPO
 30   CONTINUE
C
      IF(KK.NE.N) THEN
        CALL ERREUR(18)
C       IL MANQUE DES POINTS
        GOTO 5000
      ENDIF
C
      LDEP=ISOLEN(/1)
      MELEME=IMEL(ICAS)
      SEGACT MELEME
      DO 40 I=1,LDEP
      JJJ=JJJ+1
      ICPR1(NUM(1,I))=JJJ
      IF(I.EQ.1) GOTO 42
      IF (ICHAN.EQ.0) THEN
      MCHPOI=ISOLEN(I)
      ELSE
      ICHAM=ISOLEN(I)
C* Manque le passage en MCHAML aux noeuds avec le modele !!!
C*    CALL CHASUP(IPMODL,ICHAM,ICHAM2,IRET,1)
C*    IF (IRET.EQ.0) THEN
C*      CALL ERREUR(___)
C*      RETURN
C*    ENDIF
C*    CALL CHAMPO(ICHAM2,2,MCHPOI,IRET)
      CALL CHAMPO(ICHAM,2,MCHPOI,IRET)
      IF (IRET.EQ.0) RETURN
      ENDIF
      SEGACT MCHPOI
  42  CONTINUE
      DO 41 IP=1,N
      MSOUPO=IPCHP(ISS(IP))
      SEGACT MSOUPO
      MPOVAL=IPOVAL
      SEGACT MPOVAL
      TRAV(JJJ,IPP(IP))=VPOCHA(NBB(IP),ICC(IP))
      SEGDES MPOVAL,MSOUPO
   41 CONTINUE
      IF (ICHAN.EQ.0) SEGDES MCHPOI
      IF (ICHAN.EQ.1) SEGSUP MCHPOI
   40 CONTINUE
      SEGDES MSOLEN,MELEME
      SEGSUP ITRAV3
   50 CONTINUE
C
      SEGSUP ICPR
C
C  **** FABRICATION DE ITRAV(2,LDEPL), ET DE IPOS(NSOUP+1)
C
      MSOLEN=ILEX
      SEGACT MSOLEN
      MCHPOI=ISOLEN(1)
      SEGACT MCHPOI
      NSOUP=IPCHP(/1)
      NSOUP1=NSOUP+1
      SEGINI IPOS
      SEGINI ITRAV
      KK=0
      IPOS(1)=0
      DO 1 ISOU=1,NSOUP
      MSOUPO=IPCHP(ISOU)
      SEGACT MSOUPO
      MELEME=IGEOC
      SEGACT MELEME
      DO 2 I=1,NUM(/2)
      J=ICPR1(NUM(1,I))
      IF(J.NE.0) THEN
        KK=KK+1
        ITRAV(1,KK)=I
        ITRAV(2,KK)=J
      ENDIF
   2  CONTINUE
      SEGDES MELEME,MSOUPO
      IPOS(ISOU+1)=KK
   1  CONTINUE
      SEGSUP ICPR1
C
C **** BOUCLE SUR LES INSTANTS DE LA TABLE
C
      MSOLEN=ILEX
      SEGACT MSOLEN
      LTEM=ISOLEN(/1)
      JG=LTEM
      DO 99 JJ=1,N
      SEGINI MLREEL
      KLIST(JJ)=MLREEL
   99 CONTINUE
C
      SEGINI ITRAV2
      DO 90 L=1,LTEM
      MCHPOI=ISOLEN(L)
      SEGACT MCHPOI
      DO 70 I=1,NSOUP
      IF(IPOS(I+1).NE.IPOS(I)) THEN
        MSOUPO=IPCHP(I)
        SEGACT MSOUPO
        MPOVAL=IPOVAL
        SEGACT MPOVAL
        DO 160 NB=IPOS(I)+1,IPOS(I+1)
        TRAVV(ITRAV(2,NB))=VPOCHA(ITRAV(1,NB),1)
 160    CONTINUE
        SEGDES MPOVAL,MSOUPO
      ENDIF
  70  CONTINUE
      SEGDES MCHPOI
      DO 162 IP=1,N
      CALL PROSC1(TRAVV,TRAV(1,IP),RET,LDEPL)
      MLREEL=KLIST(IP)
      PROG(L)=RET
162   CONTINUE
 90   CONTINUE
C
      SEGSUP ITRAV
      SEGSUP IPOS
      SEGSUP ITRAV1,ITRAV2
      DO 98 JJ=1,N
      MLREEL=KLIST(JJ)
      SEGDES MLREEL
 98   CONTINUE
C
      SEGDES MSOLEN
 5000 CONTINUE
      RETURN
      END