C ETALPR    SOURCE    CHAT      05/01/12    23:46:07     5004           
      SUBROUTINE ETALPR(MCHPOI,IINC,ICPR,ICONTR)                                
C=======================================================================        
C     CE SUBROUTINE REMPLIT ICPR ,IINC ET ICONTR                                
C     ICPR(K)=IK  : LE POINT K EST A LA POSITION IK DANS MCHPOI                 
C     IINC(I) EST LA IEME COMPOSANTE DE MCHPOI(TOUTES LES COMPOSANTES           
C     DANS IINC SONT DIFFERENTES)                                               
C     MCONTR(I,J)=1 VEUT DIRE QUE LA IEME COMPOSANTE DANS IINC EXISTE           
C     POUR LE IK IEME POINT (TEL QUE ICPR(K)=IK) DANS MCHPOI                    
C                                                                               
C     ATTENTION SEGINI ICPR. SEGINI IINC. SEGINI ICONTR                         
C=======================================================================        
      IMPLICIT INTEGER(I-N)
-INC SMCHPOI                                                                    
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))                                          
      SEGMENT IINC                                                              
       CHARACTER*4 CIINC(0)                                                     
      ENDSEGMENT                                                                
      SEGMENT /ICONTR/(MCONTR(NNI1,IPR1))                                       
C                                                                               
      SEGINI ICPR                                                               
      SEGACT MCHPOI                                                             
      NSOUPO=IPCHP(/1)                                                          
      IK=0                                                                      
      MSOUPO=IPCHP(1)                                                           
      SEGACT MSOUPO                                                             
      SEGINI IINC                                                               
      CIINC(**)=NOCOMP(1)                                                       
      SEGDES MSOUPO                                                             
      ININC=1                                                                   
      DO 101 ISOU=1,NSOUPO                                                      
      MSOUPO=IPCHP(ISOU)                                                        
      SEGACT MSOUPO                                                             
      MELEME=IGEOC                                                              
      SEGACT MELEME                                                             
      N2=NUM(/2)                                                                
      DO 102 I2=1,N2                                                            
      K=NUM(1,I2)                                                               
      IK=IK+1                                                                   
      ICPR(K)=IK                                                                
 102  CONTINUE                                                                  
      SEGDES MELEME                                                             
      DO 106 I2=1,NOCOMP(/2)                                                    
      DO 107 IJ=1,ININC                                                         
      IF(CIINC(IJ).EQ.NOCOMP(I2)) GO TO 106                                     
 107  CONTINUE                                                                  
      CIINC(**)=NOCOMP(I2)                                                      
      ININC=ININC+1                                                             
 106  CONTINUE                                                                  
      SEGDES MSOUPO                                                             
 101  CONTINUE                                                                  
      NNI1=CIINC(/2)                                                            
      IPR1=IK                                                                   
      SEGINI ICONTR                                                             
      DO 201 ISOU=1,NSOUPO                                                      
      MSOUPO=IPCHP(ISOU)                                                        
      SEGACT MSOUPO                                                             
      MELEME=IGEOC                                                              
      SEGACT MELEME                                                             
      N2=NUM(/2)                                                                
      NC=NOCOMP(/2)                                                             
      DO 202 J=1,NC                                                             
      DO 203 K=1,NNI1                                                           
      IF(NOCOMP(J).EQ.CIINC(K)) GO TO 204                                       
 203  CONTINUE                                                                  
 204  CONTINUE                                                                  
      DO 205 I2=1,N2                                                            
      KI=ICPR(NUM(1,I2))                                                        
      MCONTR(K,KI)=1                                                            
 205  CONTINUE                                                                  
 202  CONTINUE                                                                  
      SEGDES MELEME,MSOUPO                                                      
 201  CONTINUE                                                                  
      SEGDES ICONTR                                                             
      SEGDES MCHPOI                                                             
      SEGDES ICPR                                                               
      SEGDES IINC                                                               
      RETURN                                                                    
      END