C VARIPO    SOURCE    CHAT      05/01/13    04:04:04     5004           
      SUBROUTINE VARIPO(IPOI1,IPOI2,MOT2,IPOI3)                                 
C----------------------------------------------------------------               
C                    CHPOINT VARIABLE                                           
C----------------------------------------------------------------               
C  ENTREES:                                                                     
C     IPOI1=POINTEUR SUR UN CHPOINT                                             
C     IPOI2=POINTEUR SUR UN EVOLUTIO                                            
C     MOT2 =NOM DE COMPOSANTE A DONNER AU RESULTAT                              
C  SORTIE:                                                                      
C     IPOI3=POINTEUR SUR LE CHPOINT RESULTAT                                    
C----------------------------------------------------------------               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMCHPOI                                                                    
-INC SMLREEL                                                                    
-INC SMELEME                                                                    
      CHARACTER*4 MOTREF,MOT1,MOT2,MOTABS,MOTORD                                
      SEGMENT/MTRA/(XVAL(0)*D)                                                  
      SEGMENT/MTRI/(IPOI(0))                                                    
      SEGMENT/MTRAX/(XX(0)*D)                                                   
      SEGMENT/MTRAY/(YY(0)*D)                                                   
      DATA XZER,UN/0.D0,1.D0/                                                   
      KERRE=0                                                                   
      IPOI3=0                                                                   
C                                                                               
C  ON RECUPERE L'OBJET EVOLUTION                                                
C                                                                               
      MEVOLL=IPOI2                                                              
      SEGACT MEVOLL                                                             
      KEVOLL=IEVOLL(1)                                                          
      SEGACT KEVOLL                                                             
      MLREEL=IPROGX                                                             
      MLREE1=IPROGY                                                             
      MOTABS=NOMEVX(1:4)                                                        
      MOTORD=NOMEVY(1:4)                                                        
      SEGDES KEVOLL                                                             
      SEGACT MLREEL,MLREE1                                                      
      NBPOIX=PROG(/1)                                                           
      NBPOIY=MLREE1.PROG(/1)                                                    
      IF(NBPOIX.NE.NBPOIY) THEN                                                 
      CALL ERREUR(263)                                                          
      SEGDES MLREEL,MLREE1                                                      
      SEGDES MEVOLL                                                             
      RETURN                                                                    
      ENDIF                                                                     
C                                                                               
      SEGINI MTRAX                                                              
      SEGINI MTRAY                                                              
      DO 695 I=1,NBPOIX                                                         
      XX(**)=PROG(I)                                                            
695   CONTINUE                                                                  
      DO 696 I=1,NBPOIY                                                         
      YY(**)=MLREE1.PROG(I)                                                     
696   CONTINUE                                                                  
      SEGDES MLREEL,MLREE1                                                      
      SEGDES MEVOLL                                                             
C                                                                               
C  ON RECUPERE LE CHPOINT                                                       
C                                                                               
      MCHPO1=IPOI1                                                              
      SEGACT MCHPO1                                                             
      NSOUP1=MCHPO1.IPCHP(/1)                                                   
C                                                                               
C     RECHERCHE DU NOMBRE DE COMPOSANTES                                        
C                                                                               
      DO 300 IA=1,NSOUP1                                                        
      MSOUP1=MCHPO1.IPCHP(IA)                                                   
      SEGACT MSOUP1                                                             
      NC1=MSOUP1.NOCOMP(/2)                                                     
      IF(NC1.EQ.1) GO TO 321                                                    
 325  SEGDES MSOUP1                                                             
      MOTREF=MOTABS                                                             
      GO TO 320                                                                 
 321  IF(IA.EQ.1) THEN                                                          
      MOTREF=MSOUP1.NOCOMP(1)                                                   
      GO TO 330                                                                 
      ENDIF                                                                     
      IF(MOTREF.NE.MSOUP1.NOCOMP(1)) GOTO 325                                   
 330  SEGDES MSOUP1                                                             
 300  CONTINUE                                                                  
C                                                                               
C     BOUCLE SUR LES SOUS PAQUETS                                               
C                                                                               
 320  SEGINI MTRA,MTRI                                                          
      DO 100 IA=1,NSOUP1                                                        
      MSOUP1=MCHPO1.IPCHP(IA)                                                   
      SEGACT MSOUP1                                                             
      NC1=MSOUP1.NOCOMP(/2)                                                     
      DO 110 IB=1,NC1                                                           
      MOT1=MSOUP1.NOCOMP(IB)                                                    
      IF(MOT1.NE.MOTREF)  GOTO 110                                              
      IBVAL=IB                                                                  
      GOTO 120                                                                  
  110 CONTINUE                                                                  
      GOTO 130                                                                  
C                                                                               
 120  CONTINUE                                                                  
      MOT1=MSOUP1.NOCOMP(IBVAL)                                                 
      MELEME=MSOUP1.IGEOC                                                       
      MPOVA1=MSOUP1.IPOVAL                                                      
      SEGACT MELEME,MPOVA1                                                      
      NBNN  =NUM(/1)                                                            
      NBELEM=NUM(/2)                                                            
      N     =MPOVA1.VPOCHA(/1)                                                  
      NC    =MPOVA1.VPOCHA(/2)                                                  
      IF(N.EQ.NBELEM.AND.NBNN.EQ.1.AND.NC1.EQ.NC) GOTO 150                      
C                                                                               
C     ERREUR DANS LES DIMENSIONS DES CHPOINT                                    
C                                                                               
      MOTERR(1:8)='VARIPO'                                                      
      CALL ERREUR(178)                                                          
      SEGDES MELEME,MPOVA1,MSOUP1                                               
      GOTO 666                                                                  
C                                                                               
 150  CONTINUE                                                                  
      DO 140 IC=1,NBELEM                                                        
      MM=NUM(1,IC)                                                              
      XVAL(**)=MPOVA1.VPOCHA(IC,IBVAL)                                          
      IPOI(**)=MM                                                               
 140  CONTINUE                                                                  
      SEGDES MELEME,MPOVA1                                                      
 130  CONTINUE                                                                  
      SEGDES MSOUP1                                                             
 100  CONTINUE                                                                  
C                                                                               
      LX=XVAL(/1)                                                               
C                                                                               
C     ERREUR SI PAS DE COMPOSANTE DU TYPE RECHERCHE DANS MCHPOI                 
C                                                                               
      IF(LX.EQ.0)  THEN                                                         
      MOTERR(1:4)=MOTABS                                                        
      CALL ERREUR(181)                                                          
      GOTO 666                                                                  
      ENDIF                                                                     
C                                                                               
C     ON REMPLIT LE NOUVEAU CHPOINT                                             
C                                                                               
      IF(MOT2.EQ.'    ') MOT2=MOTORD                                            
      NSOUPO=1
      NAT=MCHPO1.JATTRI(/1)                                                                   
      SEGINI MCHPOI                                                             
      MTYPOI='SCALAIRE' 
      DO 160 II=1,NAT
         JATTRI(II)=MCHPO1.JATTRI(II)
 160  CONTINUE                                                        
      NC=1                                                                      
      SEGINI MSOUPO                                                             
      IPCHP(1)=MSOUPO                                                           
      NOCOMP(1)=MOT2                                                            
      NBNN  =1                                                                  
      NBELEM=LX                                                                 
      NBSOUS=0                                                                  
      NBREF =0                                                                  
      SEGINI MELEME                                                             
      IGEOC=MELEME                                                              
      ITYPEL=1                                                                  
      N     =LX                                                                 
      NC    =1                                                                  
      SEGINI MPOVAL                                                             
      IPOVAL=MPOVAL                                                             
      SEGDES MCHPOI,MSOUPO                                                      
      DO 220 IA=1,LX                                                            
      NUM(1,IA)   =IPOI(IA)                                                     
      XTT1 =XVAL(IA)                                                            
      CALL VARIFO(XX,YY,NBPOIX,XTT1,YTT1,KERRE)                                 
      IF(KERRE.NE.0) THEN                                                       
      SEGSUP MSOUPO,MCHPOI,MELEME,MPOVAL                                        
      CALL ERREUR(KERRE)                                                        
      GOTO 666                                                                  
      ENDIF                                                                     
      VPOCHA(IA,1)=YTT1                                                         
  220 CONTINUE                                                                  
      IPOI3=MCHPOI                                                              
      SEGDES MELEME,MPOVAL                                                      
C                                                                               
  666 CONTINUE                                                                  
      SEGSUP MTRA,MTRI                                                          
      SEGSUP MTRAX,MTRAY                                                        
      SEGDES MCHPO1                                                             
      RETURN                                                                    
      END