      SUBROUTINE ES3D2C(NNO,NPO,NBFACE,NPOQ,NNOQ,NPOP,NNOP,NOREF,
     +                  NPI,POIR,NPISQ,NPISP,POIQS,POIPS,
     +                  NLOC,X,Y,Z,fom,fgam,pn,PR,PR1,DPR,DPR1,DPQS1,
     +                  DPPS1,PQS,PQS1,PPS,PPS1,DELTS,DELTA,BE)
C  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     BUT :   CALCUL DU SECOND MEMBRE ELEMENTAIRE
C     ---     D UN ELEMENT  PENTAEDRE
C  +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     PARAMETRES D ENTREE
C     -------------------
c
C     NNO           : NOMBRE DE NOEUDS DE L ELEMENT
C     NPO           : NOMBRE DE POINTS DE L ELEMENT
C     NBFACE        : NOMBRE DE FACES DE L ELEMENT
c     nloc : numerotation locale des faces
c
c     --- volume --

c     nno ,npo           : nombre de noeuds , points
c     nbface             : nombre de faces
c     poir(npi)          : poids
c     pr,dpr             : interpolation
c     pr1,dpr1           : geometrie

c     --- face triangulaire -- 

c     nnop ,npop         : nombre de noeuds , points
c     poips(npisp)       : poids
c     pps,dpps           : interpolation
c     pps1,dpps1         : geometrie
c  
c     --- face quadrangulaire --  
 
c     nnop ,npop         : nombre de noeuds , points
c     poiqs(npisq)       : poids
c     pqs,dpqs           : interpolation
c     pqs1,dpqs1         : geometrie
C     FOM                : efforts volumique aux noeuds
C     FGAM               : esfforts surfaciques aux noeuds
c     PN                 : pression aux noeuds
c     NOREF              : noref(nbface,2) 1 =/ 0 si effort surfacique
c                                          2 =/ 0 si pression

C     PARAMETRES RESULTATS
C     --------------------
C     BE            : SECOND MEMBRE ELEMENTAIRE
C  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C     PROGRAMMEUR   : Marina Vidrascu INRIA 2001
C  ...................................................................
c
      parameter (npfm=9 ,npim = 27)
      DOUBLE PRECISION POIR(NPI),POIQS(NPISQ),POIPS(NPISP),
     +   BE(3,NNO),VOL(3,NPIM),SURF(3,NPfm),fom(3,nno),
     +   fgam(3,nnoq,nbface),pn(nnoq,nbface),
     +   PR(NNO,NPI),DPR(3,NNO,NPI),PR1(NPO,NPI),DPR1(3,NPO,NPI),
     +   PQS(NNOQ,NPISQ),PQS1(NPOQ,NPISQ),
     +   DPQS1(2,NPOQ,NPISQ),PPS(NNOP,NPISP),PPS1(NPOP,NPISP),
     +   DPPS1(2,npop,npisp),DF(3,3),DFINV(3,3),
     +   DELTS(NPISQ),DELTA(NPI),zero
      INTEGER NOREF(nbface,2),NLOC(NNOQ,nbface)
      DOUBLE PRECISION X(NPO),Y(NPO),Z(NPO),XS(NPfm),YS(NPfm),ZS(NPfm)

c     --- non utilises ---

      DOUBLE PRECISION a2(1),DPQS(1),DPPS(1)
      DOUBLE PRECISION XINT(1),YINT(1),ZINT(1),FF1(1),FF2(1),FF3(1)

      parameter (zero=0)
C
      INDICE = 3
      call dcopy(3*npi,zero,0,vol,1)
      CALL FOBASE(3,3,NNO,NPO,NPI,PR,PR1,DPR,DPR1,X,Y,Z,A2,XINT,
     +            YINT,ZINT,DELTA,DFINV,DF,INDICE,vol,fom,fom,1)

C     TERMES DE VOLUME
C     ----------------

      CALL dcopy(3*nno,zero,0,BE,1)
      DO 13 J = 1,NNO
      DO 13 I = 1,3
      DO 13 L = 1,NPI
         BE(I,J) = BE(I,J) +PR(J,L)*POIR(L)*DELTA(L)*VOL(I,L)
13    CONTINUE
C
C     TERMES DE BORD
C    -----------------  
  
      DO 26 NF = 1,NBFACE

      IF(NOREF(NF,1) .GT. 0 .OR. NOREF(NF,2) .GT. 0 ) THEN
C
c       calcul de iopt
c
        if (noref(nf,1) .ne. 0) then
            if (noref(nf,2) .ne. 0) then
               iopt = 3
            else
               iopt = 1
            endif
        else
            iopt = 2
        endif
C
            IF (NF.EQ.1. OR .NF.EQ.4) THEN

C              FACE TRIANGULAIRE

               DO 116 I=1,NPOP
                  XS(I)=X(NLOC(I,NF))
                  YS(I)=Y(NLOC(I,NF))
                  ZS(I)=Z(NLOC(I,NF))
116            CONTINUE

               INDICE = 3
               call dcopy(3*npisp,zero,0,surf,1)
               CALL FOBASE(3,2,NNOP,NPOP,NPISP,PPS,PPS1,DPPS,DPPS1,XS,
     +                     YS,ZS,A2,FF1,FF2,FF3,DELTS,DFINV,DF,INDICE,
     +                     surf,fgam(1,1,nf),pn(1,nf),iopt)
C
               DO 125 J = 1,NNOP
               DO 125 I = 1,3
               DO 125 L = 1,NPISP
                  BE(I,NLOC(J,NF)) = BE(I,NLOC(J,NF)) +
     +                  PPS(J,L) * DELTS(L) * POIPS(L)*SURF(I,L)
125            CONTINUE

           ELSE

C              FACE QUADRANGULAIRE

               DO 115 I = 1,NPOQ
                  XS(I) = X(NLOC(I,NF))
                  YS(I) = Y(NLOC(I,NF))
                  ZS(I) = Z(NLOC(I,NF))
115            CONTINUE

               INDICE = 3
               call dcopy(3*npisq,zero,0,surf,1)
               CALL FOBASE(3,2,NNOQ,NPOQ,NPISQ,PQS,PQS1,DPQS,DPQS1,XS,
     +                     YS,ZS,A2,FF1,FF2,FF3,DELTS,DFINV,DF,INDICE,
     +                     surf,fgam(1,1,nf),pn(1,nf),iopt)
C
               DO 25 J = 1,NNOQ
               DO 25 I = 1,3
               DO 25 L = 1,NPISQ
                  BE(I,NLOC(J,NF)) = BE(I,NLOC(J,NF)) +
     +                      PQS(J,L) * DELTS(L) * POIQS(L)*SURF(I,L)
25             CONTINUE
         END IF
         END IF
26    CONTINUE
      END
