C CICROT    SOURCE    PV        17/12/08    21:15:43     9660           
C SICROT    SOURCE    AIEG      99/12/02    21:19:50     3700
      SUBROUTINE CICROT (WRK52,WRK53,WRK54,IDEFO,VECINV,VECRES)
*
*
*     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)

-INC DECHE

      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)





*  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 100 IC=1,3
      DO 100 IL=1,3
        R(IL,IC)=XGLOB(IL,IC)
100   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









 
 
 
