C SOMM      SOURCE    CHAT      05/01/13    03:22:12     5004           
      SUBROUTINE SOMM                                                           
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C                                                                               
C=======================================================================        
C   =                                                                  =        
C   = INTEGRATION DE L'ORDONNEE SUR LES ABSCISSES D'UN OBJET DE TYPE   =        
C   = EVOLUTION                                                        =        
C   =                                                                  =        
C   = SYNTAXE : LREEL1 = SOMM EVOL1 (ABSO)                             =
C   =                                                                  =        
C   = L'INTEGRATION EST EFFECTUEE PAR LA METHODE DES TRAPEZES, LE      =        
C   = PAS D'INTEGRATION ETANT CALCULE A CHAQUE INSTANT                 =
C   = LE RESULTAT EST UN LISTREEL, CONTENANT LES INTEGRALES DE         =
C   = CHACUNE DES COURBES DE L'OBJET EVOLUTION OPERANDE D'ENTREE       =
C   =                                                                  =        
C   = SI ABSO EST PRECISE, ON INTEGRE LA VALEUR ABSOLUE DES ORDONNEES  =        
C   =                                                                  =        
C   =                                                                  =        
C   = CREATION : 24/03/87                                              =        
C   = PROGRAMMATEUR : BEAUFILS                                         =        
C=======================================================================        
C                                                                               
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMLREEL                                                                    
C                                                                               
      CHARACTER*4 ITABSO(1)                                                     
      DATA ITABSO/'ABSO'/                                                       
C                                                                               
      CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET)                                      
      IF(IERR.NE.0) GOTO 100                                                    
C                                                                               
      CALL LIRMOT(ITABSO,1,IABSO,0)                                             
      IF(IERR.NE.0) GOTO 100                                                    
C                                                                               
C CREATION DU LISTREEL SOLUTION
C                                                                               
C BOUCLE SUR LES KEVOLL
C                                                                               
      MEVOLL=IPEVO                                                              
      SEGACT MEVOLL                                                             
      NEVOLL=IEVOLL(/1)                                                         
      JG=0
      SEGINI MLREEL                                                             
      ITRAV=MLREEL                                                              
      IF(NEVOLL.EQ.0) THEN                                                      
        MOTERR(1:8)='EVOLUTIO'
        CALL ERREUR(555)
        RETURN
      ENDIF                                                                     
      DO 1 IK=1,NEVOLL
        KEVOLL=IEVOLL(IK)
        SEGACT KEVOLL
        IF(TYPX(1:8).NE.'LISTMOTS'.AND.TYPY(1:8).NE.'LISTMOTS') THEN
          JG=JG+1
          SEGADJ MLREEL
          MLREE1=IPROGX
          SEGACT MLREE1
          MLREE2=IPROGY
          SEGACT MLREE2
          L1=MLREE1.PROG(/1)
          IF(L1.EQ.0) THEN
            MOTERR(1:8)='LISTREEL'
            CALL ERREUR(555)
            RETURN
          ENDIF
          TRAV=0.D0
C                                                                               
C EFFECTUE LE CALCUL
C                                                                               
          IF(IABSO.EQ.1) THEN
            DO 2 I=1,(L1-1)
              Y2=DABS(MLREE2.PROG(I+1))
              Y1=DABS(MLREE2.PROG(I))
              FORC=(Y2+Y1)/2.D0
              VPAS=MLREE1.PROG(I+1)-MLREE1.PROG(I)
              TRAV=TRAV+FORC*VPAS
   2        CONTINUE
          ELSE
            DO 3 I=1,(L1-1)
              FORC=(MLREE2.PROG(I)+MLREE2.PROG(I+1))/2.D0
              VPAS=MLREE1.PROG(I+1)-MLREE1.PROG(I)
              TRAV=TRAV+FORC*VPAS
   3        CONTINUE
          ENDIF
C                                                                               
          PROG(JG)=TRAV
C                                                                               
          SEGDES MLREE1,MLREE2
C                                                                               
        ENDIF
C                                                                               
        SEGDES KEVOLL
C                                                                               
C     FIN DE LA BOUCLE                                                          
C                                                                               
   1  CONTINUE
C                                                                               
      MLREEL=ITRAV                                                              
      SEGDES MLREEL                                                             
      SEGDES MEVOLL                                                       
C                                                                               
      CALL ECROBJ('LISTREEL',ITRAV)                                             
C                                                                               
 100  CONTINUE                                                                  
C
      RETURN                                                                    
      END