C VARCHP    SOURCE    CHAT      05/01/13    04:01:36     5004           
      SUBROUTINE VARCHP(IPOI1,IPOI2,IPOI3,IRET)                                 
C----------------------------------------------------------------               
C  ENTREES:                                                                     
C     IPOI1=POINTEUR SUR UN CHPOINT                                             
C     IPOI2=POINTEUR SUR UN EVOLUTION                                           
C  SORTIE:                                                                      
C     IPOI3=POINTEUR SUR LE CHPOINT RESULTAT                                    
C     IRET = 1 SI SUCCES 0 SINON                                                
C----------------------------------------------------------------               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      PARAMETER(XZER=0.D0)                                                      
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMCHPOI                                                                    
-INC SMLREEL                                                                    
C                                                                               
      IRET =1                                                                   
      KERRE=0                                                                   
      YTT1=XZER                                                                 
C                                                                               
C  ON RECUPERE L'OBJET EVOLUTION                                                
C                                                                               
      MEVOLL=IPOI2                                                              
      SEGACT MEVOLL                                                             
      KEVOLL=IEVOLL(1)                                                          
      SEGACT KEVOLL                                                             
      MLREEL=IPROGX                                                             
      MLREE1=IPROGY                                                             
      SEGDES KEVOLL,MEVOLL                                                      
      SEGACT MLREEL,MLREE1                                                      
      NBPOIX=PROG(/1)                                                           
      NBPOIY=MLREE1.PROG(/1)                                                    
C                                                                               
C  ON RECUPERE LE CHPOINT                                                       
C                                                                               
      MCHPO1=IPOI1                                                              
      SEGACT MCHPO1                                                             
      NSOUPO=MCHPO1.IPCHP(/1)  
      NAT=MCHPO1.JATTRI(/1)                                                 
      SEGINI MCHPOI                                                             
      IPOI3=MCHPOI                                                              
      IFOPOI   =MCHPO1.IFOPOI                                                   
      MTYPOI=MCHPO1.MTYPOI                                                      
      MOCHDE=MCHPO1.MOCHDE 
C    on attribue la meme nature
      DO 50 INAT=1,NAT
        JATTRI(INAT)=MCHPO1.JATTRI(1)
  50  CONTINUE                                                     
C                                                                               
C     BOUCLE SUR LES SOUS PAQUETS                                               
C                                                                               
      DO 100 IA=1,NSOUPO                                                        
      MSOUP1=MCHPO1.IPCHP(IA)                                                   
      SEGACT MSOUP1                                                             
      NC =MSOUP1.NOCOMP(/2)                                                     
      SEGINI MSOUPO                                                             
      IPCHP(IA)=MSOUPO                                                          
      IGEOC=MSOUP1.IGEOC                                                        
      DO 110 IB=1,NC                                                            
      NOCOMP(IB)=MSOUP1.NOCOMP(IB)                                              
      NOHARM(IB)=MSOUP1.NOHARM(IB)                                              
  110 CONTINUE                                                                  
C                                                                               
      MPOVA1=MSOUP1.IPOVAL                                                      
      SEGACT MPOVA1                                                             
      N =MPOVA1.VPOCHA(/1)                                                      
      SEGINI MPOVAL                                                             
      IPOVAL   =MPOVAL                                                          
      DO 200 IB=1,N                                                             
      DO 200 IC=1,NC                                                            
      XTT1=MPOVA1.VPOCHA(IB,IC)                                                 
      CALL VARIFO(MLREEL.PROG,MLREE1.PROG,NBPOIX,XTT1,YTT1,KERRE)               
      IF(KERRE.EQ.211) IRET=0                                                   
      VPOCHA(IB,IC)=YTT1                                                        
  200 CONTINUE                                                                  
      SEGDES MPOVA1,MPOVAL,MSOUPO,MSOUP1                                        
  100 CONTINUE                                                                  
      SEGDES MCHPOI,MCHPO1                                                      
      SEGDES MLREEL,MLREE1                                                      
      IF(IRET.EQ.0) CALL DECHPO(IPOI3)                                          
      IF(IRET.EQ.0) CALL ERREUR(KERRE)                                          
C                                                                               
      RETURN                                                                    
      END