C EFFI3     SOURCE    CHAT      05/01/12    23:28:29     5004
      SUBROUTINE EFFI3(VALCAR,TYVAL,NCA1,NCAR1,XFORC,LRE,IB,IGAU,XATEF1,
     &NSTEP,DREND,CELEM)
***************************************************************
* calcule la matrice d efficacite directionnelle
* puis transforme le vecteur force elementaire
***************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION VALCAR(*),XFORC(*)
      CHARACTER*16 TYVAL(*)
      CHARACTER*8 CELEM
      dimension xatef1(3,3),xfor1(3),tq(3,3)
      dimension xmat2(3,3), q(3,3),xmat3(3,3)
      logical drend

      if (drend) goto 1000
* matrice de rotation
      w1x = valcar(ncar1+1)
      w1y = valcar(ncar1+2)
      w1z = valcar(ncar1+3)
      w2x = valcar(ncar1+4)
      w2y = valcar(ncar1+5)
      w2z = valcar(ncar1+6)
      tq(1,1) = w1x
      tq(2,1) = w1y
      tq(1,2) = w2x
      tq(2,2) = w2y
      if (nstep.gt.2) then
        w3x = w1y*w2z - w1z*w2y
        w3y = w2x*w1z - w2z*w1x
        w3z = w1x*w2y - w1y*w2x
        tq(3,1) = w1z
        tq(3,2) = w2z
        tq(1,3) = w3x
        tq(2,3) = w3y
        tq(3,3) = w3z
      endif
      do i = 1,nstep
        do j = 1, nstep
           q(i,j) = tq(j,i)
        enddo
      enddo
* efficacite
* produit
      do i = 1,nstep
        do j = 1, nstep
         cc= 0.d0
            do k1 = 1,nstep
                cc = cc + tq(i,k1)*xatef1(k1,j)
            enddo
         xmat2(i,j) = cc
        enddo
      enddo
      do i = 1,nstep
        do j = 1, nstep
         cc= 0.d0
            do k1 = 1,nstep
                cc = cc + xmat2(i,k1)*q(k1,j)
            enddo
         xatef1(i,j) = cc
        enddo
      enddo


 1000 CONTINUE
* affecte la force elementaire
c ----------------------------------------
c  elements massifs
c ----------------------------------------
      if (CELEM.NE.'MASSIF  ') goto 2000
      kind = int(LRE/NSTEP)
      DO jind1 = 1,kind

* decoupe un bloc
         do in1 = 1,nstep
                xfor1(in1) = XFORC((jind1 - 1)*nstep + in1)
         enddo
* multiplie et range
         do in1 = 1,nstep
             cc = 0.D0
              do k1 = 1,nstep
                 cc = cc + (xatef1(in1,k1) * xfor1(k1))
              enddo

             XFORC((jind1 - 1)*nstep + in1) = cc
         enddo

      ENDDO
      RETURN

 2000 CONTINUE
c ----------------------------------------
c  elements
c ----------------------------------------
      RETURN
      END