C ADEVOR    SOURCE    PASCAL    09/02/16    21:15:00     6282           
      SUBROUTINE ADEVOR(IPO1,IPO2,IRET,IPM)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C
C  ===================================================================
C  =  OPERATEUR :                                                    =
C  =        SOMME (OU DIFFERENCE) DE DEUX OBJETS DE TYPE EVOLUTION   =                 =
C  =              - X1 ET X2 VARIENT DE FACON STRICTEMENT CROISSANTE =
C  =              - Y1 ET Y2 SONT DE MEME NATURE                     =
C  =  APPELE PAR ADEVOL                                              =
C  =                                                                 =
C  =  REECRITURE DE L'ADDITION D'OBJETS EVOLUTION DE SOUS-TYPE REELS =          =
C  =  MODIFICATION AOUT 97 ELOI                                      =
C  ===================================================================
-INC SMEVOLL                                                                    
-INC SMLREEL                                                                    
      POINTEUR MLRE1X.MLREEL,MLRE1Y.MLREEL
      POINTEUR MLRE2X.MLREEL,MLRE2Y.MLREEL
      POINTEUR MLREEX.MLREEL,MLREEY.MLREEL
-INC CCOPTIO                                                                    
      SEGMENT ILIS1(NL1)
      SEGMENT ILIS2(NL2)
      SEGMENT ITAB1(NP)
      SEGMENT ITAB2(NP)
C                                                                               
      PARAMETER (NCR=2,NOA=3)
      CHARACTER*72 TI                                                           
      CHARACTER*4 COMREEL(NCR),OKADI(NOA)
      COMREEL(1)='REEL'
      COMREEL(2)='HIST'
      OKADI(1)='REEL'
      OKADI(2)='HIST'
      OKADI(3)='MARQ'
C                                                                               
      IRET=0                                                                    
C
      MEVOL1=IPO1
      SEGACT MEVOL1
      MEVOL2=IPO2
      SEGACT MEVOL2
C
C ON TRAITE LE CAS DES OBJETS EVOLUTION DE SOUS-TYPE "REEL"
C
C   LES DIFFERENTES COURBES DOIVENT ETRE DE SOIT DE TYPE "REEL",
C                                           SOIT DE TYPE "MARQ",
C                                           SOIT DE TYPE "HIST"
C
      N1=MEVOL1.IEVOLL(/1)
      NL1=N1
      N2=MEVOL2.IEVOLL(/1)
      NL2=N2
      SEGINI,ILIS1
      SEGINI,ILIS2
      NRES10=0
      NRES20=0
      NDIF12=0
C
C  ILIS1 : INDICES DES COURBES DE TYPE "REEL" OU "HIST" DE LA 1ERE EVOL
C
      DO I0=1,NCR
        NRES1=0
        DO 1 I1=1,N1
          KEVOL1=MEVOL1.IEVOLL(I1)
          SEGACT KEVOL1
          CALL PLACE(OKADI,3,IPLAC,KEVOL1.NUMEVY)
          IF (IPLAC.EQ.0) THEN
            SEGDES KEVOL1
            SEGDES MEVOL1,MEVOL2
            SEGSUP ILIS1
            CALL ERREUR(871)
            RETURN
          ENDIF
          IF (KEVOL1.NUMEVY.EQ.COMREEL(I0)) THEN
            NRES1=NRES1+1
            NRES10=NRES10+1
            ILIS1(NRES10)=I1
          ENDIF
          SEGDES KEVOL1
    1   CONTINUE
C
C  ILIS2 : INDICES DES COURBES DE TYPE "REEL" OU "HIST" DE LA 2ND EVOL
C
        NRES2=0
        DO 2 I2=1,N2
          KEVOL2=MEVOL2.IEVOLL(I2)
          SEGACT KEVOL2
          CALL PLACE(OKADI,3,IPLAC,KEVOL2.NUMEVY)
          IF (IPLAC.EQ.0) THEN
            SEGDES KEVOL2
            SEGDES MEVOL1,MEVOL2
            SEGSUP ILIS2
            CALL ERREUR(871)
            RETURN
          ENDIF
          IF (KEVOL2.NUMEVY.EQ.COMREEL(I0)) THEN
            NRES2=NRES2+1
            NRES20=NRES20+1
            ILIS2(NRES20)=I2
          ENDIF
          SEGDES KEVOL2
    2   CONTINUE
        IF (NRES1.NE.NRES2) THEN
          NDIF12=1
        ENDIF
      ENDDO
      NL1=NRES10
      NL2=NRES20
      SEGADJ,ILIS1,ILIS2
C
C   LES DEUX EVOLUTIONS DOIVENT AVOIR LE MEME NOMBRE DE COURBES DE TYPE
C   "REEL" OU "HIST"
C
      IF (NDIF12.NE.0) THEN
        SEGDES MEVOL1,MEVOL2
        SEGSUP ILIS1,ILIS2
        IF (NRES10.EQ.NRES20) THEN
          CALL ERREUR(871)
        ELSE
          CALL ERREUR(870)
        ENDIF
        RETURN
      ENDIF
C
C   LES DIFFERENTES ABSCISSES DOIVENT ETRE DES PROGRESSIONS STRICTEMENT 
C                                                            CROISSANTES
C
      DO 3 I1=1,N1
        KEVOL1=MEVOL1.IEVOLL(I1)
        SEGACT KEVOL1
        MLREEL=KEVOL1.IPROGX
        SEGACT MLREEL
        NJG=PROG(/1)
        IF (NJG.GT.1) THEN
          VAL1=PROG(1)
          DO 4 IJG=2,NJG
            VAL2=PROG(IJG)
            IF (VAL2.LE.VAL1) THEN
              SEGDES MLREEL
              SEGDES KEVOL1
              SEGDES MEVOL1,MEVOL2
              SEGSUP ILIS1,ILIS2
              CALL ERREUR(872)
              RETURN
            ENDIF
            VAL1=VAL2
    4     CONTINUE
        ENDIF
        SEGDES MLREEL
        SEGDES KEVOL1
    3 CONTINUE
C
      DO 5 I2=1,N2
        KEVOL2=MEVOL2.IEVOLL(I2)
        SEGACT KEVOL2
        MLREEL=KEVOL2.IPROGX
        SEGACT MLREEL
        NJG=PROG(/1)
        IF (NJG.GT.1) THEN
          VAL1=PROG(1)
          DO 6 IJG=2,NJG
            VAL2=PROG(IJG)
            IF (VAL2.LE.VAL1) THEN
              SEGDES MLREEL
              SEGDES KEVOL2
              SEGDES MEVOL1,MEVOL2
              SEGSUP ILIS1,ILIS2
              CALL ERREUR(872)
              RETURN
            ENDIF
            VAL1=VAL2
    6     CONTINUE
        ENDIF
        SEGDES MLREEL
        SEGDES KEVOL2
    5 CONTINUE
C                                                                       DD
      EPS=1.D-12
C
      N=NRES10
      SEGINI MEVOLL
C
      DO 7 IN=1,NRES10
        IL1=ILIS1(IN)
        KEVOL1=MEVOL1.IEVOLL(IL1)
        SEGACT KEVOL1
        MLRE1X=KEVOL1.IPROGX
        SEGACT MLRE1X
        NJG1=MLRE1X.PROG(/1)
        IL2=ILIS2(IN)
        KEVOL2=MEVOL2.IEVOLL(IL2)
        SEGACT KEVOL2
        MLRE2X=KEVOL2.IPROGX
        SEGACT MLRE2X
        NJG2=MLRE2X.PROG(/1)
        NP=MAX(NJG1,NJG2)
        SEGINI ITAB1
        SEGINI ITAB2
        IDEP=1
        NP3=0
        DO 8 IJG1=1,NJG1
          VAL1=MLRE1X.PROG(IJG1)
          DO 9 IJG2=IDEP,NJG2
            VAL2=MLRE2X.PROG(IJG2)
            IF ((ABS(VAL2 - VAL1)).LT.EPS) THEN
              NP3=NP3+1
              ITAB1(NP3)=IJG1
              ITAB2(NP3)=IJG2
              IDEP=IJG2
              GOTO 10
            ENDIF
    9     CONTINUE
   10     CONTINUE
    8   CONTINUE
        IF (NP3.EQ.0) THEN
          SEGDES MLRE1X
          SEGDES MLRE2X
          SEGDES KEVOL1
          SEGDES KEVOL2
          SEGDES MEVOL1,MEVOL2
          SEGSUP ITAB1,ITAB2
          SEGSUP ILIS1,ILIS2
          IF (IN.GT.1) THEN
            DO 11 IIN=1,IN-1
              KEVOLL=IEVOLL(IIN)
              MLREEX=IPROGX
              SEGSUP MLREEX
              MLREEY=IPROGY
              SEGSUP MLREEY
              SEGSUP KEVOLL
   11       CONTINUE
          ENDIF
          SEGSUP MEVOLL
          CALL ERREUR(310)
          RETURN
        ELSE
          NP=NP3
          SEGADJ ITAB1
          SEGADJ ITAB2
          JG=NP
          SEGINI MLREEX
          SEGINI MLREEY
          DO 12 IP=1,NP
            MLREEX.PROG(IP)=MLRE1X.PROG(ITAB1(IP))
   12     CONTINUE
C
C   IPM VAUT  1 DANS LE CAS DE L'ADDITION
C   IPM VAUT -1 DANS LE CAS DE LA SOUSTRACTION
C
          MLRE1Y=KEVOL1.IPROGY
          SEGACT MLRE1Y
          MLRE2Y=KEVOL2.IPROGY
          SEGACT MLRE2Y
          IF (IPM.EQ.1) THEN
            DO 13 IP=1,NP
              MLREEY.PROG(IP)=
     #                   MLRE1Y.PROG(ITAB1(IP)) + MLRE2Y.PROG(ITAB2(IP))
   13       CONTINUE
          ELSEIF (IPM.EQ.-1) THEN
            DO 14 IP=1,NP
              MLREEY.PROG(IP)=
     #                   MLRE1Y.PROG(ITAB1(IP)) - MLRE2Y.PROG(ITAB2(IP))
   14       CONTINUE
          ENDIF
          SEGINI KEVOLL
          IPROGX=MLREEX
          IPROGY=MLREEY
          NUMEVX=KEVOL1.NUMEVX
          NUMEVY=KEVOL1.NUMEVY
          TYPX=KEVOL1.TYPX
          TYPY=KEVOL1.TYPY
          NOMEVX=KEVOL1.NOMEVX
          NOMEVY=KEVOL1.NOMEVY
          KEVTEX=KEVOL1.KEVTEX
          IEVOLL(IN)=KEVOLL
          SEGDES MLREEX
          SEGDES MLREEY
          SEGDES KEVOLL
          SEGDES MLRE1X
          SEGDES MLRE1Y
          SEGDES MLRE2X
          SEGDES MLRE2Y
          SEGDES KEVOL2
        ENDIF
        SEGDES KEVOL1
        SEGSUP ITAB1,ITAB2
    7 CONTINUE
      SEGSUP ILIS1,ILIS2
      TI(1:72)=TITREE
      IEVTEX=TI
      ITYEVO=MEVOL1.ITYEVO
      IRET=MEVOLL
      SEGDES MEVOLL
      SEGDES MEVOL1
      SEGDES MEVOL2
C
      RETURN
      END