Sources Esope | Cast3M

comrot
C COMROT    SOURCE    PV        17/12/08    21:16:51     9660           
 
      SUBROUTINE COMROT(WRK53,IB,IPTR1,MWRKXE,WRK54)
*
**********************************************************
*   ENTREES
**********************************************************
*
*  CMATE  : nom du matériau élastique
*  MFR    : formulation de l'élément
*  NBBN   : nombre de noeuds de l'élément
*  IB     : numéro de l'élément
*  MELE   : numéro élément fini
*  IPTR1  : pointeur sur un segment MINTE2
*
**********************************************************
*   SORTIES
**********************************************************
*  TXR    : cosinus directeurs des axes locaux de l'élément massif
*           (WTRAV) a remplir si IPTR1 n'est pas NUL !
*
**********************************************************
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
 
-INC PPARAM
-INC CCOPTIO
*
-INC SMINTE
-INC DECHE
*
      SEGMENT MWRKXE
        REAL*8 XEL(3,NBNN)
      ENDSEGMENT
c
c     calcul des axes locaux
c
      IF (IPTR1.GT.0) THEN
C*      IF((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
C*     &  CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1
C*     &         .OR.MFR.EQ.31.OR.MFR.EQ.33)) THEN
        MINTE2=IPTR1
        NBSH=MINTE2.SHPTOT(/2)
        NBNN = XEL(/2)
        CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR)
        if (nbsh.eq.-1) then
         call erreur(525)
         return
        endif
      ENDIF
*
CPPU  IF(LUNI1)THEN
CPPU    NBNN = XEL(/2)
CPPU    NLG=NUMGEO(MELE)
CPPU    CALL RESHPT(1,NBNN,NLG,MELE,0,IPTR1,IRT1)
CPPU    MINTE2=IPTR1
CPPU    SEGACT MINTE2
CPPU    NBSH=MINTE2.SHPTOT(/2)
CPPU    CALL RLOCAL (XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR)
CPPU  ENDIF
*
      RETURN
      END