      SUBROUTINE ETSMIT4(coor,sur,iopt,pol,xnorm,be)
C-----*--*---------*---------*---------*---------*---------*---------*--
C
C BUT : CALCUL DU SECOND MEMBRE DE L ELEMENT MIT4
C ---
C-----*--*---------*---------*---------*---------*---------*---------*--
C parametres d entree :
C -------------------
C coor   : coor(npo,ndim) coordonnees
C SUR    : sur(5,nno) efforts volumiques aux noeuds
c iopt   : options
c          iopt(1) ; pas utilise
c          iopt(2) = ichoix >0 regulier
c                    -i e=x_i
c          iopt(3) = 5 si 5ddl par noud
c                    6 si 6 ddl par noud
C          
C parametres resultats :
C --------------------
C BE     : second memebre
C-----*--*---------*---------*---------*---------*---------*---------*--
      PARAMETER (nno =4, npi = 4, ndl =5)
      integer iopt(1)
      double precision coor(nno,3),pol(96),ddot,zero,un
      double precision poids(npi),sur(5,nno),suri(5,npi),be(*),
     *                 gr(3,npi),gs(3,npi),grr,grs,gss,delta,be5(5,nno)
     *                 ,be6(6,nno),xnorm(3,nno),v1(3,nno),v2(3,nno)
      parameter (zero = 0. ,un=1. )
C
c
c     integration points en r,s
c
      data poids /un,un,un,un /
      if (1.ne.1) then
      CALL Dcopy(5*nno,sur,1,BE,1)
      return
      endif
      
      CALL Dcopy(5*nno,zero,0,BE5,1)

C     *---------*---------*---------*---------*---------*---------*--
      call etsmitx(gr,gs,sur,suri,nno,npi,pol(33),pol,
     *             coor(1,1),coor(1,2),coor(1,3))
C     *---------*---------*---------*---------*---------*---------*--
c
c     calcul du second membre
c     --------------------------------
c     Somme(omega) f*vds 
c
c
c     boucle sur les points d'integration (r,s)
      do 2 l = 1,npi

c
c        calcul de grr gss grs comme polynomes de degre 2 en z
c
         grr   = ddot(3,gr(1,l),1,gr(1,l),1) 
         gss   = ddot(3,gs(1,l),1,gs(1,l),1) 
         grs   = ddot(3,gr(1,l),1,gs(1,l),1) 
         delta = sqrt(grr*gss -grs*grs)
          
         do 2 n = 1,nno
         do 2 k = 1,5
c          --- > be(k,n) = +vp2(n,l)*delta*suri(k,l)*poids(l)
           be5(k,n) = be5(k,n)+pol(nno*(l-1)+n)*delta*suri(k,l)*poids(l)
 2    continue
      if (iopt(3) .eq. 5) then 
c
c        --- > 5 ddl/noeud

         call dcopy(5*nno,be5,1,be,1)
      else
c
c        --- > 6 ddl/noeud 

         ichoix = iopt(2)
         call replo1(nno,xnorm,v1,v2,ichoix)
         do 1 i = 1,nno
           be6(1,i) = be5(1,i)
           be6(2,i) = be5(2,i)
           be6(3,i) = be5(3,i)
           be6(4,i) = v1(1,i)*be5(4,i)+v2(1,i)*be5(5,i)
           be6(5,i) = v1(2,i)*be5(4,i)+v2(2,i)*be5(5,i)
           be6(6,i) = v1(3,i)*be5(4,i)+v2(3,i)*be5(5,i)
 1       continue
         call dcopy(6*nno,be6,1,be,1)
       endif
      end
