Esope source files

   1 : C SICROT    SOURCE    CHAT      06/03/29    21:33:37     5360           
   2 :       SUBROUTINE SICROT (WRK0,WTRAV,IDEFO,VECINV,VECRES,iarr)
   3 : *
   4 : *
   5 : *     cette subroutine effectue la rotation des tenseurs des 
   6 : *     contraintes (IDEFO=0) ou des deformation (IDEFO=1) dans
   7 : *     le repere orthotrope du materiau. Elle est basee sur la
   8 : *     subroutine RTENS         
   9 :       IMPLICIT INTEGER(I-N)
  10 :        
  11 :       SEGMENT WRK0
  12 :         REAL*8 XMAT(NMATT)
  13 :       ENDSEGMENT
  14 :        
  15 :        
  16 :       SEGMENT WTRAV
  17 :         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  18 :         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  19 :         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  20 :         REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM)
  21 :         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  22 :       ENDSEGMENT
  23 :         
  24 :         
  25 :       REAL*8 VALVEC (6), VECINV(6), VECRES(6)
  26 :       REAL*8 A(3,3), R(3,3), RT(3,3), RINV(3,3), MTEMP(3,3)
  27 :       
  28 :       
  29 :       
  29 :       CALL ZERO (VALVEC,6,1)
  29 :       CALL ZERO (A,3,3)
  29 :       CALL ZERO (R,3,3)
  29 :       CALL ZERO (RINV,3,3)
  29 :       CALL ZERO (RT,3,3)
  29 :       CALL ZERO (MTEMP,3,3)
  30 :       
  31 :       iarr=0
  32 :       
  33 :         
  34 :         
  35 : *  Extraction des vecteurs des axe d'ortho.        
  36 :       VALVEC(1)=XMAT(10)
  37 :       VALVEC(2)=XMAT(11)
  38 :       VALVEC(3)=XMAT(12)
  39 :       VALVEC(4)=XMAT(13)
  40 :       VALVEC(5)=XMAT(14)
  41 :       VALVEC(6)=XMAT(15)
  42 :       
  43 : *      WRITE (*,*) 'VALVEC'
  44 : *      WRITE (*,*) (VALVEC(I),I=1,6)
  45 :       
  46 : *      WRITE (*,*)  'TXR'
  47 : *      DO 5 I=1,3
  48 : *         WRITE (*,*) (TXR(I,J), J=1,3)
  49 : *5     CONTINUE    
  50 :       
  51 : 
  52 : 
  53 : 
  54 : * Calcul des cosinus directeurs des axes d'ortho.
  54 :       CALL RGLOB (VALVEC,3,TXR,XLOC,XGLOB)
  55 :       
  56 : *      WRITE (*,*) 'XGLOB'
  57 : *      DO 10 I=1,3
  58 : *         DO 10 J=1,3
  59 : *             WRITE (*,*) XGLOB(I,J)
  60 : *10    CONTINUE
  61 : 
  62 : 
  63 : 
  64 : * On recopie et inverse la matrice XGLOB      
  65 :       DO 100 IC=1,3
  66 :       DO 100 IL=1,3
  67 :         R(IL,IC)=XGLOB(IL,IC)
  68 : 100   CONTINUE
  69 :       
  70 :             
  71 : 
  72 : 
  73 : 
  74 : * Rotation du vecteur VECINV      
  75 :       A (1,1)= VECINV(1)
  76 :       A (2,2)= VECINV(2)
  77 :       A (3,3)= VECINV(3)
  78 :       A (1,2)= VECINV(4)
  79 :       A (1,3)= VECINV(5)
  80 :       A (2,3)= VECINV(6)
  81 :       
  82 :       IF (IDEFO.EQ.1) THEN
  83 :          A(1,2)= A(1,2)/2.0D0
  84 :          A(1,3)= A(1,3)/2.0D0
  85 :          A(2,3)= A(2,3)/2.0D0
  86 :       ENDIF
  87 :       
  88 :       A (2,1)= A (1,2)
  89 :       A (3,1)= A (1,3)
  90 :       A (3,2)= A (2,3)
  91 :       
  92 :       
  93 :       IF (IDEFO.EQ.1) THEN
  93 :          CALL TRSPOD (R,3,3,RT)
  93 :          CALL MULMAT (MTEMP,A,R,3,3,3)
  93 :          CALL MULMAT (A,RT,MTEMP,3,3,3)
  94 :       ELSE
  95 : *         WRITE (*,*) 'R'
  96 : *         DO 200 I=1,3
  97 : *             WRITE (*,*) (R(I,J),J=1,3)
  98 : *200      CONTINUE
  98 :          CALL INVER3 (R,RINV)
  99 : *         WRITE (*,*) 'R INVERSEE'
 100 : *         DO 300 I=1,3
 101 : *             WRITE (*,*) (RINV(I,J),J=1,3)
 102 : *300      CONTINUE
 102 :          CALL TRSPOD (RINV,3,3,RT)
 102 :          CALL MULMAT (MTEMP,A,RINV,3,3,3)
 102 :          CALL MULMAT (A,RT,MTEMP,3,3,3)
 103 :       ENDIF
 104 : 
 105 : 
 106 : 
 107 :       
 108 :       IF (IDEFO.EQ.1) THEN
 109 :          A(1,2)= A(1,2)*2.0D0
 110 :          A(1,3)= A(1,3)*2.0D0
 111 :          A(2,3)= A(2,3)*2.0D0
 112 :       ENDIF
 113 : 
 114 :       VECRES(1) =  A (1,1)
 115 :       VECRES(2) =  A (2,2)
 116 :       VECRES(3) =  A (3,3)
 117 :       VECRES(4) =  A (1,2)
 118 :       VECRES(5) =  A (1,3)
 119 :       VECRES(6) =  A (2,3)
 120 :       
 121 : 
 122 :       
 123 : 
 124 :       RETURN
 125 :       END
 126 : 
 127 :  
 128 :  
 129 :