C DBCO33    SOURCE    CB215821  26/08/24    21:15:59     12622          
      SUBROUTINE DBCO33(XE,DD,XDDL,EPS2,SHP,BPSS,XEL,XLOC,XSTRS)
C======================================================================
C
C  AJOUTE DANS LES CONTRAINTES XSTRS LA PARTIE DHO * EPS2
C                  QUE POUR LES ELEMENTS COQ3
C  ENTREE
C    XE(3,3)           =COORDONNEES GLOBALES DU COQ3
C    DD(6,6)            =MATRICE DE HOOKE
C    XDDL(18)          =D.D.L.GLOBAUX DE LA FORMULATION
C    XSTRS(6)           =CONTRAINTES  DHO*(EPS1        )
C  TRAVAIL
C    EPS2(3)            = EPSILON 2
C    SHP(3,9)           = FONCTIONS DE FORME
C    XEL(3,3)           = COORDONNEES LOCALES
C    XLOC(18)         = D.D.L. LOCAUX
C  SORTIE
C    XSTRS(6)           =CONTRAINTES DHO*(EPS1 + EPS2 )
C
C   CODE EBERSOLT AOUT  85
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XE(3,*),DD(6,*),XSTRS(*),XDDL(*)
      DIMENSION EPS2(*),SHP(3,*),BPSS(3,*)
      DIMENSION XLOC(*),XEL(3,*)
C
C
      DATA XZER,UNDEMI,UNTIER/0.D0,.5D0,.333333333333333333D0/
C
      DWDX=XZER
      DWDY=XZER
C
      CALL VPAST(XE,BPSS)
      CALL VCORLC(XE,XEL,BPSS)
*      WRITE(6,*) ' BPSS', ((BPSS( IOU,IYU),IOU=1,3),IYU=1,3)
*      WRITE(6,*) 'XEL' , ((XEL(iou,iyu),iou=1,3), iyu=1,3)
      CALL MATVEC(XDDL,XLOC,BPSS,6)
      CALL COQ3SH(UNTIER,UNTIER,XEL,SHP)
*      write(6,*) ((shp(iou,iyu), iou=1,3),iyu=1,9)
*      write(6,*) (xloc(iou),iou=1,18)
      DO 301 IA=1,3
      IA1 = 2 +(IA-1)*6
      IA2 =    (IA-1)*3
      DO 200 IB=1,3
      DWDX =SHP(2,IA2+IB)*XLOC(IA1+IB) +DWDX
      DWDY =SHP(3,IA2+IB)*XLOC(IA1+IB) +DWDY
  200 CONTINUE
  301 CONTINUE
C
      EPS2(1)= DWDX*DWDX*UNDEMI
      EPS2(2)= DWDY*DWDY*UNDEMI
      EPS2(3)= DWDX*DWDY
**      WRITE(6,888) EPS2(1),EPS2(2),EPS2(3),DWDX,DWDY
*  888 FORMAT(4X,' DEBUGG EPS2 ',5E12.5)
C
C     MULTIPLICATION PAR LA MATRICE DE HOOKE
C
      DO 302 IB=1,3
      DO 300 IC=1,3
      XSTRS(IB)=XSTRS(IB)+ DD(IB,IC)*EPS2(IC)
  300 CONTINUE
  302 CONTINUE
C
      RETURN
      END