C BARYCE    SOURCE    FANDEUR   07/01/29    21:15:00     5626           
C  CALCUL LE BARYCENTRE D'UN OBJET                                              
C                                                                               
      SUBROUTINE BARYCE                                                         
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
      DIMENSION XGRAV(4)                                                        
      CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)                                   
      IF (IERR.NE.0) RETURN                                                     
      SEGACT,MCOORD
      IDIMP1=IDIM+1                                                             
      XGRAV(1)=0.                                                               
      XGRAV(2)=0.                                                               
      XGRAV(3)=0.                                                               
      XGRAV(4)=0.                                                               
      NPOIN=0                                                                   
      SEGACT,MELEME                                                      
      IPT1=MELEME                                                               
      DO 2 IO=1,MAX(1,LISOUS(/1))                                               
      IF (LISOUS(/1).NE.0) THEN                                                 
       IPT1=LISOUS(IO)                                                          
       SEGACT IPT1                                                              
      ENDIF                                                                     
      NPOIN=NPOIN+IPT1.NUM(/2)*IPT1.NUM(/1)                                     
      DO 3 I=1,IPT1.NUM(/1)                                                     
      DO 3 J=1,IPT1.NUM(/2)                                                     
      IREF=IDIMP1*(IPT1.NUM(I,J)-1)                                             
      DO 5 L=1,IDIMP1                                                           
   5  XGRAV(L)=XGRAV(L)+XCOOR(IREF+L)                                           
   3  CONTINUE                                                                  
      IF (LISOUS(/1).NE.0) SEGDES IPT1                                          
   2  CONTINUE                                                                  
      SEGDES,MELEME                                                             
C  ON MET LE CENTRE DE GRAVITE DANS LA TABLE DES POINTS                         
      NBPTS=XCOOR(/1)/IDIMP1+1                                                  
      SEGADJ,MCOORD                                                             
      IREF=(NBPTS-1)*IDIMP1
      DO 11 I=1,IDIMP1                                                          
      XCOOR(IREF+I)=XGRAV(I)/NPOIN                                      
  11  CONTINUE                                                                  
      KGRAV=XCOOR(/1)/IDIMP1
      CALL ECROBJ('POINT   ',KGRAV)                                             
      RETURN                                                                    
      END