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