C DTEVOL    SOURCE    CHAT      05/01/12    22:57:31     5004           
      SUBROUTINE DTEVOL(IRET,IRAT)                                              
C                                                                               
C  =====================================================================        
C  =                                                                   =        
C  =  DESTRUCTION D'UN OBJET EVOLUTION                                 =        
C  =                                                                   =        
C  =  IRAT = 0  DESTRUCTION FAIBLE                                     =        
C  =       = 1  DESTRUCTION TOTALE                                     =        
C  =                                                                   =        
C  =  CREATION    06/01/86                                             =        
C  =  PROGRAMMEUR GUILBAUD                                             =        
C  =                                                                   =        
C  =  NB: ON FAIT ATTENTION, LORS D'UNE DESTRUCTION TOTALE, AU CAS OU  =        
C  =      DES LISTES D'ABSCISSES SERAIENT IDENTIQUES ET REPRESENTEES   =        
C  =      PAR UN MEME "LISTREEL".                                      =        
C  =                                                                   =        
C  =====================================================================        
C                                                                               
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMLREEL                                                                    
-INC SMLENTI 
-INC TMCOLAC                                                                   
      MEVOLL=IRET                                                               
      SEGACT MEVOLL                                                             
      N=IEVOLL(/1)                                                              
      IF (IRAT .EQ. 1) THEN                                                     
         JG = N                                                                 
         SEGINI,MLENTI                                                          
      END IF                                                                    
C                                                                               
      DO 10 NN=1,N                                                              
         KEVOLL=IEVOLL(NN)                                                      
         IF(IRAT.EQ.1) THEN                                                     
            SEGACT KEVOLL                                                       
            LECT(NN) = IPROGX                                                   
            N1 = NN - 1                                                         
            CALL PLACE2 (LECT,N1,IPLACE,IPROGX)                                 
            IF(IPLACE .EQ. 0) THEN                                              
               MLREEL=IPROGX                                                    
               SEGSUP MLREEL
               IF(IPSAUV.NE.0) THEN
                   ICOLAC = IPSAUV
                   SEGACT ICOLAC
                   ILISSE=ILISSG
                   SEGACT ILISSE*MOD
                   CALL TYPFIL('LISTREEL',ICO)
                   ITLACC = KCOLA(ICO)
                   SEGACT ITLACC*MOD
                   CALL AJOUN0(ITLACC,MLREEL,ILISSE,1)
                   SEGDES ITLACC
              ENDIF                                                    
          ENDIF                                                               
            MLREEL=IPROGY                                                       
            SEGSUP MLREEL 
               IF(IPSAUV.NE.0) THEN
                   ICOLAC = IPSAUV
                   SEGACT ICOLAC
                   ILISSE = ILISSG
                   SEGACT ILISSE*MOD
                   ITLACC = KCOLA(ICO)
                   SEGACT ITLACC*MOD
                   CALL AJOUN0(ITLACC,MLREEL,ILISSE,1)
                   SEGDES ITLACC                                                 
              ENDIF 
         ENDIF                                                                 
         SEGSUP KEVOLL                                                          
   10 CONTINUE                                                                  
      SEGSUP MEVOLL                                                             
      IF (IRAT .EQ. 1)  THEN 
            SEGSUP,MLENTI
      ENDIF 
      IF(IPSAUV.NE.0) THEN
          CALL TYPFIL('EVOLUTIO',ICO)
          ICOLAC = IPSAUV
          SEGACT ICOLAC
          ILISSE = ILISSG
          SEGACT ILISSE*MOD
          ITLACC = KCOLA(ICO)
          SEGACT ITLACC*MOD
          CALL AJOUN0(ITLACC,MEVOLL,ILISSE,1)
          SEGDES ITLACC,ILISSE
          SEGDES ICOLAC
      ENDIF                      
C                                                                               
      END