C BARKCE    SOURCE    CB215821  26/10/26    21:15:12     12682          
      SUBROUTINE BARKCE(REL,LRE,CARAC,COORD,VROT,WORK,KERRE)
C-----------------------------------------------------------------------
C  ROUTINE DE CALCUL DE LA MATRICE DE RAIDEUR CENTRIFUGE ELEMENTAIRE
C  DE L ELEMENT DE BARRE (REPERE TOURNANT)
C
C  ENTREE
C          LRE     DIMENSION DU TABLEAU REL
C          CARAC   CARACTERISTIQUE MATERIAU
C          COORD   COORDONNEES DES 2 NOEUDS
C          VROT    VECTEUR VITESSE DE ROTATION
C
C  SORTIE
C          REL     MATRICE DE COUPLAGE ELEMENTAIRE
C
C      Didier COMBESCURE mars 2003
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCREEL
      DIMENSION REL(LRE,*),CARAC(*),COORD(3,*),V(3),WORK(*),VROT(*)
      DIMENSION ROME(3,3)
C
      SEC0=CARAC(1)
      RHO=CARAC(2)
C
      DO 1 I=1,36
      REL(I,1)=0.D00
  1   CONTINUE
C
      V(3)=0.
      DO 2 I=1,3
      V(I)=COORD(I,2)-COORD(I,1)
  2   CONTINUE
      XL=(V(1)*V(1)+V(2)*V(2)+V(3)*V(3))
C      WRITE(*,*) XL
      XL=SQRT(XL)
C
      FAC=SEC0*RHO*XL/6.
      FAC2=FAC*2.
C
      ROME(1,1) = (-1.)*((VROT(2)**2) + (VROT(3)**2))
      ROME(2,2) = (-1.)*((VROT(1)**2) + (VROT(3)**2))
      ROME(3,3) = (-1.)*((VROT(1)**2) + (VROT(2)**2))
      ROME(1,2) = VROT(1)*VROT(2)
      ROME(1,3) = VROT(1)*VROT(3)
      ROME(2,3) = VROT(2)*VROT(3)
      ROME(2,1) = ROME(1,2)
      ROME(3,1) = ROME(1,3)
      ROME(3,2) = ROME(2,3)
C
C  REMPLISSAGE DE LA MATRICE
C  FX1
      REL(1,1)=FAC2*ROME(1,1)
      REL(1,2)=FAC2*ROME(1,2)
      REL(1,3)=FAC2*ROME(1,3)
      REL(1,4)=FAC*ROME(1,1)
      REL(1,5)=FAC*ROME(1,2)
      REL(1,6)=FAC*ROME(1,3)
C  FY1
      REL(2,1)=FAC2*ROME(2,1)
      REL(2,2)=FAC2*ROME(2,2)
      REL(2,3)=FAC2*ROME(2,3)
      REL(2,4)=FAC*ROME(2,1)
      REL(2,5)=FAC*ROME(2,2)
      REL(2,6)=FAC*ROME(2,3)
C  FZ1
      REL(3,1)=FAC2*ROME(3,1)
      REL(3,2)=FAC2*ROME(3,2)
      REL(3,3)=FAC2*ROME(3,3)
      REL(3,4)=FAC*ROME(3,1)
      REL(3,5)=FAC*ROME(3,2)
      REL(3,6)=FAC*ROME(3,3)
C  FX2
      REL(4,1)=FAC*ROME(1,1)
      REL(4,2)=FAC*ROME(1,2)
      REL(4,3)=FAC*ROME(1,3)
      REL(4,4)=FAC2*ROME(1,1)
      REL(4,5)=FAC2*ROME(1,2)
      REL(4,6)=FAC2*ROME(1,3)
C  FY2
      REL(5,1)=FAC*ROME(2,1)
      REL(5,2)=FAC*ROME(2,2)
      REL(5,3)=FAC*ROME(2,3)
      REL(5,4)=FAC2*ROME(2,1)
      REL(5,5)=FAC2*ROME(2,2)
      REL(5,6)=FAC2*ROME(2,3)
C  FZ2
      REL(6,1)=FAC2*ROME(3,1)
      REL(6,2)=FAC2*ROME(3,2)
      REL(6,3)=FAC2*ROME(3,3)
      REL(6,4)=FAC*ROME(3,1)
      REL(6,5)=FAC*ROME(3,2)
      REL(6,6)=FAC*ROME(3,3)
C
      KERRE = 0
C
      RETURN
      END



 
