C TEVOLU    SOURCE    MAUGIS    07/10/26    21:16:21     5856           
      SUBROUTINE TEVOLU(IEVO,TI)
C
C  =====================================================================
C
C     Options (PAS) AVANT et APRES à l'opération EXTR EVOL1
C     (aggiunta opzione ENTI per mots AVAN, APRE; arede 14.09.94)---
C
C  =====================================================================
C
C   CREATION     : 14.09.94
C   PROGRAMMEUR  : ?
C   Modification : PM 12/09/2007, 
C                  définition de la couleur et du type  de l'évolution
C                  extraite 
C
C  =====================================================================
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
      CHARACTER*12 TI
      SEGMENT      WEVOX(0)
      SEGMENT      WEVOY(0)
C
      PARAMETER    (IOPZ=3)
      CHARACTER*4  MOPZ(IOPZ)
      DATA         MOPZ /'PAS ','AVAN','APRE'/

      MEVOL1=IEVO
      SEGACT MEVOL1
      DO IMOT=1,IOPZ
          IF(TI(1:4).EQ.MOPZ(IMOT)) GOTO (10,20,20),IMOT
      ENDDO
      CALL ERREUR(5)
      GOTO 900
C
C     option 'PAS'
*     Extraction d'une valeur toutes les J
*
   10 CONTINUE
*     Lecture du pas
      CALL LIRENT(J,1,IRETOU)
      IF(IERR.NE.0) GOTO 900

      NW=0
      N =0
      SEGINI MEVOLL
      JMEVO=MEVOLL
      IEVTEX=MEVOL1.IEVTEX
      ITYEVO=MEVOL1.ITYEVO
      DO 11 KE=1,MEVOL1.IEVOLL(/1)
        SEGINI WEVOX,WEVOY
        KEVOL1=MEVOL1.IEVOLL(KE)
        SEGACT KEVOL1
        MLREE1=KEVOL1.IPROGX
        MLREE2=KEVOL1.IPROGY
        SEGACT MLREE1,MLREE2
        DO KN=1,MLREE1.PROG(/1),J
          WEVOX(**)=MLREE1.PROG(KN)
          WEVOY(**)=MLREE2.PROG(KN)
        ENDDO
        SEGDES MLREE1,MLREE2

*       création évolution résultat
        SEGINI KEVOLL
        IEVOLL(**)=KEVOLL
        TYPX='LISTREEL'
        TYPY='LISTREEL'
        NOMEVX=KEVOL1.NOMEVX
        NOMEVY=KEVOL1.NOMEVY
        KEVTEX=KEVOL1.KEVTEX
        NUMEVX=KEVOL1.NUMEVX
        LPROG=WEVOX(/1)
        JG=LPROG
        SEGINI MLREE1
        SEGINI MLREE2
        IPROGX=MLREE1
        IPROGY=MLREE2
        DO KN=1,LPROG
          MLREE1.PROG(KN)=WEVOX(KN)
          MLREE2.PROG(KN)=WEVOY(KN)
        ENDDO
        SEGSUP WEVOX,WEVOY
        SEGDES KEVOL1,KEVOLL
   11 CONTINUE
      GOTO 777
C
C     Options AVANT / APRES [ENTI] ['ZERO']
   20 CONTINUE
      CALL LIRMOT('ENTI',1,IENTI,0)
      IF(IENTI.NE.0) THEN
        CALL LIRENT(KKK,1,IRETOU)
        IF(IERR.NE.0) GOTO 900
      ELSE
        CALL LIRFLO(FLT,0,IRETOU)
        IF(IERR.NE.0) GOTO 900
      ENDIF
      NW =0
      N  =0
      IZE=0
      SEGINI MEVOLL
      JMEVO=MEVOLL
      IEVTEX=MEVOL1.IEVTEX
      ITYEVO=MEVOL1.ITYEVO
      DO 21 KE=1,MEVOL1.IEVOLL(/1)
        SEGINI WEVOX,WEVOY
        KEVOL1=MEVOL1.IEVOLL(KE)
        SEGACT KEVOL1
        MLREE1=KEVOL1.IPROGX
        MLREE2=KEVOL1.IPROGY
        SEGACT MLREE1,MLREE2
C
        IF(IENTI.EQ.0) THEN
*         comparaison de la valeur avec le seuil
          DO KN=1,MLREE1.PROG(/1)
            IF(TI(:4).EQ.'AVAN') THEN
              IF(FLT.GE.MLREE1.PROG(KN)) THEN
                WEVOX(**)=MLREE1.PROG(KN)
                WEVOY(**)=MLREE2.PROG(KN)
              ENDIF
            ELSEIF(TI(:4).EQ.'APRE') THEN
              IF(FLT.LE.MLREE1.PROG(KN)) THEN
                WEVOX(**)=MLREE1.PROG(KN)
                WEVOY(**)=MLREE2.PROG(KN)
              ENDIF
            ENDIF
          ENDDO
        ELSE
*         comparaison de l'indice avec le seuil
          DO KN=1,MLREE1.PROG(/1)
            IF(TI(:4).EQ.'AVAN') THEN
                IF(KKK.GE.KN) THEN
                  WEVOX(**)=MLREE1.PROG(KN)
                  WEVOY(**)=MLREE2.PROG(KN)
                ENDIF
            ELSEIF(TI(:4).EQ.'APRE') THEN
              IF(KKK.LE.KN) THEN
                WEVOX(**)=MLREE1.PROG(KN)
                WEVOY(**)=MLREE2.PROG(KN)
              ENDIF
            ENDIF
          ENDDO
          IF(TI(:4).EQ.'APRE') FLT=WEVOX(1)
        ENDIF
        SEGDES MLREE1,MLREE2

C       changement de l'origine des abscisses à zéro ?
        LPROG=WEVOX(/1)
        IF(IZE.EQ.0) THEN
          CALL LIRMOT('ZERO',1,IVAL,0)
          IF(IVAL.NE.0) THEN
            IF(IERR.NE.0) THEN
*             On ne comprend pas le mot %m1:4
              CALL ERREUR(7)
              SEGSUP WEVOX,WEVOY
              GOTO 900
            ENDIF
            IZE=1
          ENDIF
        ENDIF
        IF(IZE.EQ.0) FLT0=0.E0
        IF(IZE.EQ.1) FLT0=FLT

*       création évolution résultat
        SEGINI KEVOLL
        IEVOLL(**)=KEVOLL
        TYPX='LISTREEL'
        TYPY='LISTREEL'
        NOMEVX=KEVOL1.NOMEVX
        NOMEVY=KEVOL1.NOMEVY
        KEVTEX=KEVOL1.KEVTEX
        NUMEVX=KEVOL1.NUMEVX
        JG=LPROG
        SEGINI MLREE1
        SEGINI MLREE2
        IPROGX=MLREE1
        IPROGY=MLREE2
        DO KN=1,LPROG
          MLREE1.PROG(KN)=WEVOX(KN)-FLT0
          MLREE2.PROG(KN)=WEVOY(KN)
        ENDDO
        SEGSUP WEVOX,WEVOY
        SEGDES KEVOL1,KEVOLL
   21 CONTINUE
C
  777 SEGDES MEVOLL
      CALL ECROBJ('EVOLUTIO',JMEVO)

  900 CONTINUE
      SEGDES MEVOL1

      RETURN
      END