C THSIGH    SOURCE    CHAT      05/01/13    03:38:11     5004
      SUBROUTINE THSIGH(SHP,DJAC,XSTRS,NBNN,IDIM,LRE,REL)
C=====================================================================
C
C   CALCULE SOMME H,I * SIG I J *H ,J
C
C  ENTREE
C    SHP(6,NBNO)   = H   H,X   H,Y  H,Z
C    DJAC          =JACOBIEN
C    XSTRS(NSTRS)  = CONTRAINTES
C    NBNN          = NOMBRE DE NOEUDS
C    IDIM          = DIMENSION
C    LRE           =TAILLE DE LA MATRICE DE RIGIDITE
C    REL(LRE,LRE)  =MATRICE DE RIGIDITE    (LRE=IDIM*NBNN
C
C  SORTIES
C    REL(LRE,LRE)=MATRICE DE RIGIDITE
C    EBERSOLT OCT 85
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION SHP(6,*),XSTRS(*),REL(LRE,*)
      KA=0
      DO 100 IA=1,NBNN
      KB=0
      DO 200 IB=1,IA
      CC=SHP(2,IA)*XSTRS(1)*SHP(2,IB)+SHP(3,IA)*XSTRS(2)*SHP(3,IB)
     1  +(SHP(2,IA)*SHP(3,IB)+SHP(3,IA)*SHP(2,IB))*XSTRS(4)
      IF (IDIM.EQ.2) GOTO 366
      CC=CC+SHP(4,IA)*XSTRS(3)*SHP(4,IB)
     1         +(SHP(2,IA)*SHP(4,IB)+SHP(4,IA)*SHP(2,IB))*XSTRS(5)
     1         +(SHP(3,IA)*SHP(4,IB)+SHP(4,IA)*SHP(3,IB))*XSTRS(6)
  366 CONTINUE
      CC=CC*DJAC
      DO 300 IC=1,IDIM
      REL(KA+IC,KB+IC)=REL(KA+IC,KB+IC)+CC
      REL(KB+IC,KA+IC)=REL(KA+IC,KB+IC)
  300 CONTINUE
  200 KB=KB+IDIM
  100 KA=KA+IDIM
      RETURN
      END

