Download cicrot.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer