C COMPOU    SOURCE    PV        17/12/08    21:16:50     9660           
*
      SUBROUTINE COMPOU(IB,MWRKXE,ililuc,iwrk53)
*
****************************************************
*  ENTREES
****************************************************
*
*  MFR   : formulation de l'élément
*  MELE  : numéro élément fini
*  NBNN  : nombre de noeuds par élément (WRK4)
*  IB    : numéro de l'élément
*  XEL   : coordonnées des points de l'élément (MWRK2)
*
****************************************************
*  SORTIES
****************************************************
*
****************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*

-INC PPARAM
-INC CCOPTIO
*
-INC SMCHAML
* segment deroulant le mcheml
-INC DECHE
*
      SEGMENT MWRKXE
        REAL*8 XEL(3,NBNN)
      ENDSEGMENT
c
      liluc = ililuc
      wrk53 = iwrk53
C
C  XEL est rempli systematiquement dans le sous-programme appelant
c
c    special poutres et tuyaux  sauf timoschenko
c
      IF ((MFR.EQ.7.OR.MFR.EQ.13).AND.MELE.NE.84) THEN
C
        IF (IDIM.EQ.3) THEN
C
            XL=SQRT ( (XEL(1,2)-XEL(1,1))**2 +
     &                (XEL(2,2)-XEL(2,1))**2 +
     &                (XEL(3,2)-XEL(3,1))**2   )
            pilnec = liluc(11,2)
*******            segact pilnec*nomod
            mran = pilobl(/2)
            deche = pilobl(6,mran)
*********            segact deche*nomod
            melval = ieldec
            DSIGP = VELCHE(1,IB) - VELCHE(2,IB)
            deche = pilobl(2,mran)
********            segact deche*nomod
            melval = ieldec
*********            segact melval*mod
            VELCHE(1,IB)= DSIGP / XL
            VELCHE(2,IB)=VELCHE(1,IB)
            deche = pilobl(5,mran)
***********            segact deche*nomod
            melval = ieldec
            DSIGP = VELCHE(2,IB) - VELCHE(1,IB)
            deche = pilobl(3,mran)
***********            segact deche*nomod
            melval = ieldec
************            segact melval*mod
            VELCHE(1,IB)= DSIGP / XL
            VELCHE(2,IB)=VELCHE(1,IB)
C
        ELSE
C  CAS 2D
            XL=SQRT ( (XEL(1,2)-XEL(1,1))**2 +
     &                (XEL(2,2)-XEL(2,1))**2 )
            pilnec = liluc(11,2)
***********            segact pilnec*nomod
            mran = pilobl(/2)
            deche = pilobl(3,mran)
*************            segact deche*nomod
            melval = ieldec
            DSIGP = VELCHE(1,IB) - VELCHE(2,IB)
*
            deche = pilobl(2,mran)
************            segact deche*nomod
            melval = ieldec
***************            segact melval*mod
            VELCHE(1,IB)= DSIGP / XL
            VELCHE(2,IB)=VELCHE(1,IB)
C
        ENDIF
C
      ENDIF
c
      RETURN
      END


 
 
 
