Esope source files

   1 : C DTEVOL    SOURCE    CHAT      05/01/12    22:57:31     5004           
   2 :       SUBROUTINE DTEVOL(IRET,IRAT)                                              
   3 : C                                                                               
   4 : C  =====================================================================        
   5 : C  =                                                                   =        
   6 : C  =  DESTRUCTION D'UN OBJET EVOLUTION                                 =        
   7 : C  =                                                                   =        
   8 : C  =  IRAT = 0  DESTRUCTION FAIBLE                                     =        
   9 : C  =       = 1  DESTRUCTION TOTALE                                     =        
  10 : C  =                                                                   =        
  11 : C  =  CREATION    06/01/86                                             =        
  12 : C  =  PROGRAMMEUR GUILBAUD                                             =        
  13 : C  =                                                                   =        
  14 : C  =  NB: ON FAIT ATTENTION, LORS D'UNE DESTRUCTION TOTALE, AU CAS OU  =        
  15 : C  =      DES LISTES D'ABSCISSES SERAIENT IDENTIQUES ET REPRESENTEES   =        
  16 : C  =      PAR UN MEME "LISTREEL".                                      =        
  17 : C  =                                                                   =        
  18 : C  =====================================================================        
  19 : C                                                                               
  20 :       IMPLICIT INTEGER(I-N)
  21 : -INC CCOPTIO                                                                    
  22 : -INC SMEVOLL                                                                    
  23 : -INC SMLREEL                                                                    
  24 : -INC SMLENTI 
  25 : -INC TMCOLAC                                                                   
  26 :       MEVOLL=IRET                                                               
  27 :       SEGACT MEVOLL                                                             
  28 :       N=IEVOLL(/1)                                                              
  29 :       IF (IRAT .EQ. 1) THEN                                                     
  30 :          JG = N                                                                 
  31 :          SEGINI,MLENTI                                                          
  32 :       END IF                                                                    
  33 : C                                                                               
  34 :       DO 10 NN=1,N                                                              
  35 :          KEVOLL=IEVOLL(NN)                                                      
  36 :          IF(IRAT.EQ.1) THEN                                                     
  37 :             SEGACT KEVOLL                                                       
  38 :             LECT(NN) = IPROGX                                                   
  39 :             N1 = NN - 1                                                         
  39 :             CALL PLACE2 (LECT,N1,IPLACE,IPROGX)                                 
  40 :             IF(IPLACE .EQ. 0) THEN                                              
  41 :                MLREEL=IPROGX                                                    
  42 :                SEGSUP MLREEL
  43 :                IF(IPSAUV.NE.0) THEN
  44 :                    ICOLAC = IPSAUV
  45 :                    SEGACT ICOLAC
  46 :                    ILISSE=ILISSG
  47 :                    SEGACT ILISSE*MOD
  47 :                    CALL TYPFIL('LISTREEL',ICO)
  48 :                    ITLACC = KCOLA(ICO)
  49 :                    SEGACT ITLACC*MOD
  49 :                    CALL AJOUN0(ITLACC,MLREEL,ILISSE,1)
  50 :                    SEGDES ITLACC
  51 :               ENDIF                                                    
  52 :           ENDIF                                                               
  53 :             MLREEL=IPROGY                                                       
  54 :             SEGSUP MLREEL 
  55 :                IF(IPSAUV.NE.0) THEN
  56 :                    ICOLAC = IPSAUV
  57 :                    SEGACT ICOLAC
  58 :                    ILISSE = ILISSG
  59 :                    SEGACT ILISSE*MOD
  60 :                    ITLACC = KCOLA(ICO)
  61 :                    SEGACT ITLACC*MOD
  61 :                    CALL AJOUN0(ITLACC,MLREEL,ILISSE,1)
  62 :                    SEGDES ITLACC                                                 
  63 :               ENDIF 
  64 :          ENDIF                                                                 
  65 :          SEGSUP KEVOLL                                                          
  66 :    10 CONTINUE                                                                  
  67 :       SEGSUP MEVOLL                                                             
  68 :       IF (IRAT .EQ. 1)  THEN 
  69 :             SEGSUP,MLENTI
  70 :       ENDIF 
  71 :       IF(IPSAUV.NE.0) THEN
  71 :           CALL TYPFIL('EVOLUTIO',ICO)
  72 :           ICOLAC = IPSAUV
  73 :           SEGACT ICOLAC
  74 :           ILISSE = ILISSG
  75 :           SEGACT ILISSE*MOD
  76 :           ITLACC = KCOLA(ICO)
  77 :           SEGACT ITLACC*MOD
  77 :           CALL AJOUN0(ITLACC,MEVOLL,ILISSE,1)
  78 :           SEGDES ITLACC,ILISSE
  79 :           SEGDES ICOLAC
  80 :       ENDIF                      
  81 : C                                                                               
  82 :       END                                                                       
  83 :  
  84 :  
  85 :  
  86 :  
  87 :  
  88 :