Télécharger cicrot.eso

Retour à la liste

Numérotation des lignes :

cicrot
  1. C CICROT SOURCE PV 17/12/08 21:15:43 9660
  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.  
  19. CALL ZERO (VALVEC,6,1)
  20. CALL ZERO (A,3,3)
  21. CALL ZERO (R,3,3)
  22. CALL ZERO (RINV,3,3)
  23. CALL ZERO (RT,3,3)
  24. CALL ZERO (MTEMP,3,3)
  25.  
  26.  
  27.  
  28.  
  29.  
  30. * Extraction des vecteurs des axe d'ortho.
  31. VALVEC(1)=XMAT(10)
  32. VALVEC(2)=XMAT(11)
  33. VALVEC(3)=XMAT(12)
  34. VALVEC(4)=XMAT(13)
  35. VALVEC(5)=XMAT(14)
  36. VALVEC(6)=XMAT(15)
  37.  
  38. * WRITE (*,*) 'VALVEC'
  39. * WRITE (*,*) (VALVEC(I),I=1,6)
  40.  
  41. * WRITE (*,*) 'TXR'
  42. * DO 5 I=1,3
  43. * WRITE (*,*) (TXR(I,J), J=1,3)
  44. *5 CONTINUE
  45.  
  46.  
  47.  
  48.  
  49. * Calcul des cosinus directeurs des axes d'ortho.
  50. CALL RGLOB (VALVEC,3,TXR,XLOC,XGLOB,2)
  51.  
  52. * WRITE (*,*) 'XGLOB'
  53. * DO 10 I=1,3
  54. * DO 10 J=1,3
  55. * WRITE (*,*) XGLOB(I,J)
  56. *10 CONTINUE
  57.  
  58.  
  59.  
  60. * On recopie et inverse la matrice XGLOB
  61. DO 100 IC=1,3
  62. DO 100 IL=1,3
  63. R(IL,IC)=XGLOB(IL,IC)
  64. 100 CONTINUE
  65.  
  66.  
  67.  
  68.  
  69.  
  70. * Rotation du vecteur VECINV
  71. A (1,1)= VECINV(1)
  72. A (2,2)= VECINV(2)
  73. A (3,3)= VECINV(3)
  74. A (1,2)= VECINV(4)
  75. A (1,3)= VECINV(5)
  76. A (2,3)= VECINV(6)
  77.  
  78. IF (IDEFO.EQ.1) THEN
  79. A(1,2)= A(1,2)/2.0D0
  80. A(1,3)= A(1,3)/2.0D0
  81. A(2,3)= A(2,3)/2.0D0
  82. ENDIF
  83.  
  84. A (2,1)= A (1,2)
  85. A (3,1)= A (1,3)
  86. A (3,2)= A (2,3)
  87.  
  88.  
  89. IF (IDEFO.EQ.1) THEN
  90. CALL TRSPOD (R,3,3,RT)
  91. CALL MULMAT (MTEMP,A,R,3,3,3)
  92. CALL MULMAT (A,RT,MTEMP,3,3,3)
  93. ELSE
  94. * WRITE (*,*) 'R'
  95. * DO 200 I=1,3
  96. * WRITE (*,*) (R(I,J),J=1,3)
  97. *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
  103. CALL TRSPOD (RINV,3,3,RT)
  104. CALL MULMAT (MTEMP,A,RINV,3,3,3)
  105. CALL MULMAT (A,RT,MTEMP,3,3,3)
  106. ENDIF
  107.  
  108.  
  109.  
  110.  
  111. IF (IDEFO.EQ.1) THEN
  112. A(1,2)= A(1,2)*2.0D0
  113. A(1,3)= A(1,3)*2.0D0
  114. A(2,3)= A(2,3)*2.0D0
  115. ENDIF
  116.  
  117. VECRES(1) = A (1,1)
  118. VECRES(2) = A (2,2)
  119. VECRES(3) = A (3,3)
  120. VECRES(4) = A (1,2)
  121. VECRES(5) = A (1,3)
  122. VECRES(6) = A (2,3)
  123.  
  124.  
  125.  
  126.  
  127. RETURN
  128. END
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales