Télécharger microi.eso

Retour à la liste

Numérotation des lignes :

microi
  1. C MICROI SOURCE CB215821 16/04/21 21:17:44 8920
  2. SUBROUTINE MICROI (WRK0,WRK1,NSTRS,NVARI,NMATT,
  3. & ICARA,KERRE,MFR1,IFOURB)
  4. *
  5. * modele d'endommagement microplan isotrope couple a la plasticite
  6. * C. La Borderie + S. Fichant Oct. 95
  7. * routines utilisees:
  8. * micro1: plasticite nadai
  9. * IDECAL=3 DANS LE CAS ISO IDECAL=8 DANS LE CAS ANISO
  10. * jacob3: diagonalisation:
  11. * attention jacob3 modifie la matrice a diagonaliser!!
  12. * prodt et prodt2
  13. * attention prodt2 ne fonctionne qu'avec la matrice des V. P. !!
  14. *
  15. IMPLICIT INTEGER(I-N)
  16. C IMPLICIT REAL*8(A-H,O-Z)
  17. INTEGER NSTRS,NVARI,NMATT,ICARA,KERRE,MFR1,IFOURB
  18. INTEGER ISTRS,I,J
  19. REAL*8 YOUNG,XNU,EPSD0,BT,LAMB,DEUXMU,ALFA
  20. REAL*8 DOM,SIGAN(6),TRSIG,DEF33(3,3),EPSIPP(3),VECP(3,3)
  21. REAL*8 D1
  22. REAL*8 SIGPP(3),SIGPM(3),SIG33(3,3),SIG33P(3,3),SIG33M(3,3)
  23. REAL*8 LAMBDAP,LAMBDAM
  24. REAL*8 DSIGT(6)
  25. INTEGER IDECAL
  26. *
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. *
  31. SEGMENT WRK0
  32. REAL*8 XMAT(NMATT)
  33. ENDSEGMENT
  34. *
  35. SEGMENT WRK1
  36. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  37. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  38. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  39. ENDSEGMENT
  40. SEGMENT WRKK1
  41. REAL*8 DEFELA(NSTRS)
  42. ENDSEGMENT
  43. *
  44. * on recupere les variable materielles
  45. *
  46. YOUNG=XMAT(1)
  47. XNU=XMAT(2)
  48. EPSD0=XMAT(5)
  49. BT=XMAT(6)
  50. ALFA=XMAT(9)
  51. DEUXMU=YOUNG/(1.D0+XNU)
  52. LAMB=XNU*DEUXMU/(1.D0-2.D0*XNU)
  53. *
  54. * recuperation des variables internes d'endommagement
  55. *
  56. DOM=VAR0(3)
  57. SEGINI WRKK1
  58. *
  59. * on ecoule plastiquement sur la contrainte effective
  60. *
  61. IDECAL=3
  62. CALL MICRO1(WRK0,NMATT,WRK1,NSTRS,DSIGT,
  63. 1 NVARI,IDECAL,KERRE,.false.)
  64. IF (KERRE .NE. 0) THEN
  65. print*,'on n''a pas converge dans micro1'
  66. CALL MICRO1(WRK0,NMATT,WRK1,NSTRS,DSIGT,
  67. 1 NVARI,IDECAL,KERRE,.true.)
  68. SEGSUP WRKK1
  69. RETURN
  70. ENDIF
  71. *
  72. * on ecoule en endommagement sur les deformations elastiques
  73. *
  74. *
  75. * calcul des deformations elastiques
  76. *
  77. TRSIG=0.D0
  78. * print*,'-----sigf------'
  79. * print*,sigf(1),sigf(2),sigf(3)
  80. DO ISTRS=1,3
  81. TRSIG=TRSIG+SIGF(ISTRS)
  82. END DO
  83. DO ISTRS=1,3
  84. DEFELA(ISTRS)=( (1.D0+XNU)*SIGF(ISTRS)-XNU*TRSIG)/YOUNG
  85. END DO
  86. * print*,'-----defela------'
  87. * print*,defela(1),defela(2),defela(3)
  88. DO ISTRS=4,NSTRS
  89. DEFELA(ISTRS)= (1.D0+XNU)*SIGF(ISTRS)/YOUNG
  90. END DO
  91. *
  92. * on met les deformations sous forme de matrice 3x3
  93. * pour calculer les valeurs propres
  94. *
  95. CALL ENDOCA (DEFELA,DEF33,1)
  96. * print*,'deformations elastiques dans rpg(3x3)'
  97. * print*,def33
  98. * print*,'prodt defrdpe'
  99. CALL JACOB3 (DEF33,3,EPSIPP,VECP)
  100. * print*,'deformations principales'
  101. * print*,(epsipp(i),i=1,3)
  102. *
  103. * on calcule l'endommagement resultant
  104. *
  105. * print*,'BT=',BT,'EPSD0=',EPSD0,'EPSIPP(1)',EPSIPP(1)
  106. IF (EPSIPP(1) .GT. EPSD0) THEN
  107. D1=1.D0-EPSD0/EPSIPP(1)*EXP(BT*( EPSD0 - EPSIPP(1)))
  108. ELSE
  109. D1=0.D0
  110. END IF
  111. * PRINT*,'D1=',D1
  112. *
  113. *
  114. * et on en l'endommagement final
  115. *
  116. IF(d1.gt.dom)then
  117. dom=d1
  118. endif
  119. * print*,'DOM=',DOM
  120. *
  121. * on separe les contraintes effectives en + et - dans rpsigma
  122. *
  123. CALL ENDOCA (SIGF,SIG33,1)
  124. CALL JACOB3 (SIG33,3,SIGPP,VECP)
  125. * print*,'contraintes ppales'
  126. * print*,sigpp
  127. DO I=1,3
  128. IF (SIGPP(I) .LT. 0.D0)THEN
  129. SIGPM(I)=SIGPP(I)
  130. SIGPP(I)=0.D0
  131. ELSE
  132. SIGPM(I)=0.D0
  133. END IF
  134. END DO
  135. CALL PRODT2(SIG33P,SIGPP,VECP,3)
  136. CALL PRODT2(SIG33M,SIGPM,VECP,3)
  137. * print*,'contraintes dans rpg'
  138. * print*,sig33p
  139. * print*,sig33m
  140. *
  141. LAMBDAP=1.D0-DOM
  142. LAMBDAM=1.D0-DOM**ALFA
  143. SIG33(1,1)=LAMBDAP*SIG33P(1,1)+LAMBDAM*SIG33M(1,1)
  144. SIG33(1,2)=LAMBDAP*SIG33P(1,2)+LAMBDAM*SIG33M(1,2)
  145. SIG33(1,3)=LAMBDAP*SIG33P(1,3)+LAMBDAM*SIG33M(1,3)
  146. SIG33(2,1)=SIG33(1,2)
  147. SIG33(2,2)=LAMBDAP*SIG33P(2,2)+LAMBDAM*SIG33M(2,2)
  148. SIG33(2,3)=LAMBDAP*SIG33P(2,3)+LAMBDAM*SIG33M(2,3)
  149. SIG33(3,1)=SIG33(1,3)
  150. SIG33(3,2)=SIG33(2,3)
  151. SIG33(3,3)=LAMBDAP*SIG33P(3,3)+LAMBDAM*SIG33M(3,3)
  152. * print*,'contraintes dans RPD'
  153. * print*,sig33p
  154. * print*,'sig33p(1,2)',sig33p(1,2)
  155. * print*,'dsigt',dsigt(1),dsigt(2),dsigt(3)
  156. * print*,'dsigt',dsigt(4),dsigt(5),dsigt(6)
  157. * print*,'sigf',sigf(1),sigf(2),sigf(3)
  158. * print*,'sigf',sigf(4),sigf(5),sigf(6)
  159. *
  160.  
  161. * on rend les contraintes et les variables internes finales
  162. *
  163. SIGAN(1)=SIGF(1)-SIG33(1,1)
  164. SIGF(1)=SIG33(1,1)
  165. VARF(3)=MAX (DOM,0.d0)
  166. SIGAN(2)=SIGF(2)-SIG33(2,2)
  167. SIGF(2)=SIG33(2,2)
  168. SIGAN(3)=SIGF(3)-SIG33(3,3)
  169. SIGF(3)=SIG33(3,3)
  170. SIGAN(4)=SIGF(4)-SIG33(1,2)
  171. SIGF(4)=SIG33(1,2)
  172. IF(IFOUR.GE.1.OR.IFOUR.LE.-3) THEN
  173. SIGAN(5)=SIGF(5)-SIG33(1,3)
  174. SIGF(5)=SIG33(1,3)
  175. SIGAN(6)=SIGF(6)-SIG33(2,3)
  176. SIGF(6)=SIG33(2,3)
  177. ELSE
  178. SIGAN(5)=0.D0
  179. SIGAN(6)=0.D0
  180. END IF
  181. DO ISTRS=1,6
  182. VARF(ISTRS+3)=SIGAN(ISTRS)
  183. END DO
  184. * print*,'sigf',sigf(1),sigf(2),sigf(3)
  185. * print*,'sigf',sigf(4),sigf(5),sigf(6)
  186. * print*,'sigan',sigan(1),sigan(2),sigan(3)
  187. * print*,'sigan',sigan(4),sigan(5),sigan(6)
  188. SEGSUP WRKK1
  189. RETURN
  190. END
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  

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