C MUCPR2    SOURCE    PV090527  25/02/19    21:15:03     12164          
      subroutine mucpr2(inpl,indl,re,xbuffp,xbuffd,isyme,irela)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*  appele par mucpr1
      REAL*8 re(indl,inpl),xbuffp(inpl),xbuffd(indl)
*  blocage par 6 puis par 3 puis par 2 pour reutiliser xbuffp
*  le blocage a 2 est suffisant en fait
*  les triangles ont 3 noeuds et 3  ou 6 inconnues par noeud
**       write (6,*) 'isyme inpl indl',isyme,inpl,indl
**       write (6,*) ((re(ind,inp),inp=1,inpl),ind=1,indl)



         indi=0
       if (isyme.ne.0) then
*  cas non symetrique
         do ind=indi,indl-2,2
          xb1=0.d0
          xb2=0.d0
          do inp=1,inpl
           xbp=xbuffp(inp)
           xb1=xb1+re(ind+1,inp)*xbp
           xb2=xb2+re(ind+2,inp)*xbp
          enddo
          xbuffd(ind+1)=xb1
          xbuffd(ind+2)=xb2
         enddo
         indi=ind

         do ind=indi,indl-1,1
          xb1=0.d0
          do inp=1,inpl
           xb1=xb1+re(ind+1,inp)*xbuffp(inp)
          enddo
          xbuffd(ind+1)=xb1
         enddo
       else
*  cas symetrique on utilise la transposee
*  pour les relations, on ne considere que la premiere ligne et colonne
       if (irela.eq.0) then
       do ind=indi,indl-2,2
        xb1=0.d0
        xb2=0.d0
        do inp=1,inpl
         xbp=xbuffp(inp)
         xb1=xb1+re(inp,ind+1)*xbp
         xb2=xb2+re(inp,ind+2)*xbp
        enddo
        xbuffd(ind+1)=xb1
        xbuffd(ind+2)=xb2
       enddo
       indi=ind
       endif
       if(irela.eq.1) then
*       write(6,*) 'mucpr2 irela 1 inpl ',inpl
        xb1=0.d0
        do inp=1,inpl
         xb1=xb1+re(inp,1)*xbuffp(inp)
        enddo
        xbuffd(1)=xb1
        do ind=1,indl-1,1
         xb1=re(1,ind+1)*xbuffp(1)
         xbuffd(ind+1)=xb1
        enddo
       else 
        do ind=indi,indl-1,1
         xb1=0.d0
         do inp=1,inpl
          xb1=xb1+re(inp,ind+1)*xbuffp(inp)
         enddo
         xbuffd(ind+1)=xb1
        enddo
       endif
       endif
       end