Sources Esope | Cast3M

sicrot
C SICROT    SOURCE    CB215821  26/08/24    21:18:24     12622          
      SUBROUTINE SICROT (WRK0,WTRAV,IDEFO,VECINV,VECRES,iarr)
*
*
*     cette subroutine effectue la rotation des tenseurs des
*     contraintes (IDEFO=0) ou des deformation (IDEFO=1) dans
*     le repere orthotrope du materiau. Elle est basee sur la
*     subroutine RTENS
      IMPLICIT INTEGER(I-N)
 
      SEGMENT WRK0
        REAL*8 XMAT(NMATT)
      ENDSEGMENT
 
 
      SEGMENT WTRAV
        REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
        REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
        REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
        REAL*8 XLOC(3,3),XGLOB(3,3)
        REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
      ENDSEGMENT
 
 
      REAL*8 VALVEC (6), VECINV(6), VECRES(6)
      REAL*8 A(3,3), R(3,3), RT(3,3), RINV(3,3), MTEMP(3,3)
 
 
 
      CALL ZERO (VALVEC,6,1)
      CALL ZERO (A,3,3)
      CALL ZERO (R,3,3)
      CALL ZERO (RINV,3,3)
      CALL ZERO (RT,3,3)
      CALL ZERO (MTEMP,3,3)
 
      iarr=0
 
 
 
*  Extraction des vecteurs des axe d'ortho.
      VALVEC(1)=XMAT(10)
      VALVEC(2)=XMAT(11)
      VALVEC(3)=XMAT(12)
      VALVEC(4)=XMAT(13)
      VALVEC(5)=XMAT(14)
      VALVEC(6)=XMAT(15)
 
*      WRITE (*,*) 'VALVEC'
*      WRITE (*,*) (VALVEC(I),I=1,6)
 
*      WRITE (*,*)  'TXR'
*      DO 5 I=1,3
*         WRITE (*,*) (TXR(I,J), J=1,3)
*5     CONTINUE
 
 
 
 
* Calcul des cosinus directeurs des axes d'ortho.
      CALL RGLOB (VALVEC,3,TXR,XLOC,XGLOB,2)
 
*      WRITE (*,*) 'XGLOB'
*      DO 10 I=1,3
*         DO 10 J=1,3
*             WRITE (*,*) XGLOB(I,J)
*10    CONTINUE
 
 
 
* On recopie et inverse la matrice XGLOB
      DO 101 IC=1,3
      DO 100 IL=1,3
        R(IL,IC)=XGLOB(IL,IC)
100   CONTINUE
  101 CONTINUE
 
 
 
 
 
* Rotation du vecteur VECINV
      A (1,1)= VECINV(1)
      A (2,2)= VECINV(2)
      A (3,3)= VECINV(3)
      A (1,2)= VECINV(4)
      A (1,3)= VECINV(5)
      A (2,3)= VECINV(6)
 
      IF (IDEFO.EQ.1) THEN
         A(1,2)= A(1,2)/2.0D0
         A(1,3)= A(1,3)/2.0D0
         A(2,3)= A(2,3)/2.0D0
      ENDIF
 
      A (2,1)= A (1,2)
      A (3,1)= A (1,3)
      A (3,2)= A (2,3)
 
 
      IF (IDEFO.EQ.1) THEN
         CALL TRSPOD (R,3,3,RT)
         CALL MULMAT (MTEMP,A,R,3,3,3)
         CALL MULMAT (A,RT,MTEMP,3,3,3)
      ELSE
*         WRITE (*,*) 'R'
*         DO 200 I=1,3
*             WRITE (*,*) (R(I,J),J=1,3)
*200      CONTINUE
         CALL INVER3 (R,RINV)
*         WRITE (*,*) 'R INVERSEE'
*         DO 300 I=1,3
*             WRITE (*,*) (RINV(I,J),J=1,3)
*300      CONTINUE
         CALL TRSPOD (RINV,3,3,RT)
         CALL MULMAT (MTEMP,A,RINV,3,3,3)
         CALL MULMAT (A,RT,MTEMP,3,3,3)
      ENDIF
 
 
 
 
      IF (IDEFO.EQ.1) THEN
         A(1,2)= A(1,2)*2.0D0
         A(1,3)= A(1,3)*2.0D0
         A(2,3)= A(2,3)*2.0D0
      ENDIF
 
      VECRES(1) =  A (1,1)
      VECRES(2) =  A (2,2)
      VECRES(3) =  A (3,3)
      VECRES(4) =  A (1,2)
      VECRES(5) =  A (1,3)
      VECRES(6) =  A (2,3)
 
 
 
 
      RETURN
      END