C CHELCO    SOURCE    PV        09/03/12    21:17:01     6325           
      SUBROUTINE CHELCO(IVAL,IPCHEL,IPCHE1,IPCHE2,IPCHE3)                       
                                                                                
C=======================================================================        
C ENTREES                                                                       
C   IVAL = 0 SI ON VEUT IDIM CHAMELEM CONTENANT CHACUN UNE COMPOSA              
C   IVAL = 1 SI ON VEUT LA PREMIERE COMPOSANTE                                  
C   IVAL = 2 SI ON VEUT LA DEUXIEME COMPOSANTE                                  
C   IVAL = 3 SI ON VEUT LA TROISIEME COMPOSANTE                                 
C   IPCHEL = POINTEUR SUR UN CHAMP PAR ELEMENT (TYPE MCHAML)                    
                                                                                
C SORTIES                                                                       
C   IPCHE1  =POINTEURS SUR LES CHAMP/ELEMENT CONTENANT LES COORDONNEES          
C   IPCHE2                                                                      
C   IPCHE3                                                                      
C                                                                               
C     EBERSOLT OCT  85                                                          
C     NOUVEAUX CHAMELEMS P DOWLATYARI OCT 91                                    
C=======================================================================        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC SMCHAML                                                                    
-INC SMELEME                                                                    
-INC SMINTE                                                                     
-INC SMCOORD                                                                    
-INC CCOPTIO                                                                    
-INC CCGEOME
      CHARACTER*4 NOMEL
C                                                                               
      SEGMENT MTRA                                                              
         REAL*8 XE(3,NBNN)                                                      
      ENDSEGMENT                                                                
C                                                                               
      DATA XZER/0.D0/                                                           
C                                                                               
C   ON ACTIVE LE CHAMP/ELEMENT POUR  EXTRAIRE LES INFOS NECESSAIRES             
C                                                                               
      MCHEL1=IPCHEL                                                             
      SEGACT,MCHEL1                                                             
      N1=MCHEL1.INFCHE(/1)                                                      
      N3=MCHEL1.INFCHE(/2)                                                      
      L1=8                                                                      
      NSOUS=N1                                                                  
C                                                                               
      IF(IVAL.EQ.0)THEN                                                         
        IDEB=IDIM                                                               
        IFIN=1                                                                  
      ELSE                                                                      
         IDEB=IVAL                                                              
         IFIN=IVAL                                                              
      ENDIF                                                                     
C                                                                               
      NCHE=0                                                                    
C                                                                               
C      BOUCLE SUR LES COMPOSANTES                                               
C                                                                               
      DO 1000  ICO=IDEB,IFIN,-1                                                 
C                                                                               
C   ON INITIALISE LE MCHAML CONTENANT LA COORDONNEE ICO                         
C                                                                               
      SEGINI,MCHELM                                                             
      NCHE=NCHE+1                                                               
      IF(NCHE.EQ.1)IPCHE1=MCHELM                                                
      IF(NCHE.EQ.2)IPCHE2=MCHELM                                                
      IF(NCHE.EQ.3)IPCHE3=MCHELM                                                
      IFOCHE=MCHEL1.IFOCHE                                                      
      TITCHE='SCALAIRE'                                                         
C                                                                               
C    BOUCLE SUR LES SOUS-ZONES                                                  
C                                                                               
      DO 100 ISOUS=1,NSOUS                                                      
C                                                                               
      CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)                                        
      IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)                                        
C                                                                               
      DO  10 IO=1,N3                                                            
         INFCHE(ISOUS,IO)=MCHEL1.INFCHE(ISOUS,IO)                               
  10  CONTINUE                                                                  
      N2=1                                                                      
      SEGINI MCHAML                                                             
      ICHAML(ISOUS)=MCHAML                                                      
      NOMCHE(1)='SCAL'                                                          
      TYPCHE(1)='REAL*8'                                                        
C                                                                               
      MELEME=IMACHE(ISOUS)                                                      
      SEGACT,MELEME                                                             
      NBELEM=NUM(/2)                                                            
      NBNN=NUM(/1)                                                              
C                                                                               
      ISUP=INFCHE(ISOUS,6)                                                      
      IF(ISUP.NE.1)THEN                                                         
        MINTE=INFCHE(ISOUS,4)                                                   
        SEGACT,MINTE                                                            
        NBPGAU=SHPTOT(/3)                                                       
      ELSE                                                                      
        NBPGAU=NBNN                                                             
      ENDIF                                                                     
C                                                                               
      N1EL=NBELEM                                                               
      N1PTEL=NBPGAU                                                             
      N2EL=0                                                                    
      N2PTEL=0                                                                  
      SEGINI MELVAL                                                             
      IELVAL(1)=MELVAL                                                          
      SEGINI MTRA                                                               
C                                                                               
      DO   200 IB=1,NBELEM                                                      
C                                                                               
      CALL ZERO(XE,3,NBNN)                                                      
      CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)                                      
C                                                                               
      DO   200  IGAU=1,NBPGAU                                                   
C                                                                               
      IF(ISUP.NE.1)THEN                                                         
       XX=XZER                                                                  
       DO 220  ID=1,NBNN                                                        
         XX=XX+SHPTOT(1,ID,IGAU)*XE(ICO,ID)                                     
 220   CONTINUE                                                                 
       ELSE                                                                     
         XX=XE(ICO,IGAU)                                                        
       ENDIF                                                                    
C+PPj
C      ON DIVISE PAR 2 LE RESULTAT POUR LES ELEMENTS DE JOINTS
       NOMEL=NOMS(ITYPEL)
       IF((NOMEL.EQ.'RAC2').OR.(NOMEL.EQ.'RAC3').OR.(NOMEL.EQ.'LIA3')
     .  .OR.(NOMEL.EQ.'LIA4').OR.(NOMEL.EQ.'LIA6').OR.(NOMEL.EQ.'LIA8'))
     .   XX=XX/2
C+PPj
C                                                                               
      VELCHE(IGAU,IB)=XX                                                        
C                                                                               
 200  CONTINUE                                                                  
      SEGDES,MELVAL,MCHAML,MELEME                                               
      IF(ISUP.NE.1)SEGDES,MINTE                                                 
      SEGSUP MTRA                                                               
C                                                                               
 100  CONTINUE                                                                  
C                                                                               
      SEGDES MCHELM                                                             
C                                                                               
 1000 CONTINUE                                                                  
C                                                                               
      SEGDES MCHEL1                                                             
      RETURN                                                                    
      END