Télécharger cmicri.eso

Retour à la liste

Numérotation des lignes :

  1. C CMICRI SOURCE BP208322 17/03/01 21:15:51 9325
  2. C MICROI SOURCE AM 00/12/13 21:40:38 4045
  3. SUBROUTINE CMICRI (WRK52,WRK53,WRK54,NVARI,Iecou)
  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 NSTRS1,NVARI,ICARA,MFR1
  18. INTEGER ISTRS,I,J
  19. REAL*8 YOUNG,XNU,EPSD0,BT,LAMB,DEUXMU,ALFA,MP,BT1
  20. REAL*8 DOM,SIGAN(6),TRSIG,TRSIG33,DEF33(3,3),EPSIPP(3),VECP(3,3)
  21. REAL*8 D1,DEFPT(6),DEFTOT(6),EPSITOP(3),EPSE1,EPSE
  22. REAL*8 SIGPP(3),SIGPM(3),SIG33(3,3),SIG33P(3,3),SIG33M(3,3)
  23. REAL*8 LAMBDAP,LAMBDAM
  24. INTEGER IDECAL
  25. *
  26. -INC CCOPTIO
  27. -INC DECHE
  28. *
  29.  
  30. SEGMENT IECOU
  31. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  32. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  33. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  34. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  35. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  36. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  37. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  38. 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  39. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  40. 4 icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  41. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  42. 5 icow39,icow40,icow41,icow42,icow43,icow44
  43. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME
  44. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  45. . icow51,icow52,icow53,icow54,icow55,icow56
  46. . icow57,icow58
  47. ENDSEGMENT
  48.  
  49.  
  50. SEGMENT WRKK1
  51. REAL*8 DEFELA(NSTRS1)
  52. ENDSEGMENT
  53. *
  54. * on recupere les variable materielles
  55. *
  56. YOUNG=XMAT(1)
  57. XNU=XMAT(2)
  58. EPSD0=XMAT(5)
  59. BT=XMAT(6)
  60. MP=XMAT(8)
  61. BT1=(1.D0-(YOUNG/(YOUNG+MP)))
  62. ALFA=XMAT(9)
  63. DEUXMU=YOUNG/(1.D0+XNU)
  64. LAMB=XNU*DEUXMU/(1.D0-2.D0*XNU)
  65. *
  66. * recuperation des variables internes d'endommagement
  67. *
  68. DOM=VAR0(3)
  69. * DOM=0.D0
  70. SEGINI WRKK1
  71. *
  72. * on ecoule plastiquement sur la contrainte effective
  73. *
  74. IDECAL=3
  75. nstrbi=nstrs1
  76. * PRINT*,'ON ECOULE'
  77. CALL CMICR1(WRK52,WRK53,WRK54,NSTRbi,NVARI,IDECAL,
  78. & .FALSE.,DEFPT,EPSE1,EPSE)
  79. nstrs1=nstrbi
  80. IF (KERRE .NE. 0) THEN
  81. print*,'on n''a pas converge dans micro1'
  82. CALL CMICR1(WRK52,WRK53,WRK54,NSTRbi,NVARI,IDECAL,
  83. & .FALSE.,DEFPT,EPSE1,EPSE)
  84. SEGSUP WRKK1
  85. RETURN
  86. ENDIF
  87. *
  88. * on ecoule en endommagement sur les deformations elastiques
  89. *
  90. *
  91. * calcul des deformations elastiques
  92. *
  93. TRSIG=0.D0
  94. * print*,'-----sigf------'
  95. * print*,sigf(1),sigf(2),sigf(3)
  96. DO ISTRS=1,3
  97. TRSIG=TRSIG+SIGF(ISTRS)
  98. END DO
  99. DO ISTRS=1,3
  100. DEFELA(ISTRS)=( (1.D0+XNU)*SIGF(ISTRS)-XNU*TRSIG)/YOUNG
  101. DEFTOT(ISTRS)=DEFELA(ISTRS)+DEFPT(ISTRS)
  102. END DO
  103. * print*,'-----defela------'
  104. * print*,defela(1),defela(2),defela(3)
  105. * print*,'-----defpt------'
  106. * print*,defpt(1),defpt(2),defpt(3)
  107. DO ISTRS=4,NSTRS1
  108. DEFELA(ISTRS)= (1.D0+XNU)*SIGF(ISTRS)/YOUNG
  109. DEFTOT(ISTRS)=DEFELA(ISTRS)+DEFPT(ISTRS)
  110. END DO
  111. *
  112. * on met les deformations sous forme de matrice 3x3
  113. * pour calculer les valeurs propres
  114. *
  115. CALL ENDOCA (DEFELA,DEF33,1)
  116. * print*,'deformations elastiques dans rpg(3x3)'
  117. * print*,def33
  118. * print*,'prodt defrdpe'
  119. CALL JACOB3 (DEF33,3,EPSIPP,VECP)
  120. * print*,'deformations principales'
  121. * print*,(epsipp(i),i=1,3)
  122. *
  123. * PAREIL POUR DEFTOTAL
  124.  
  125. CALL ENDOCA (DEFTOT,DEF33,1)
  126. CALL JACOB3 (DEF33,3,EPSITOP,VECP)
  127. * print*,'deformations TOTAL principales'
  128. * print*,(epsitop(i),i=1,3)
  129.  
  130.  
  131. * on calcule l'endommagement resultant
  132. *
  133. * print*,'BT=',BT,'EPSD0=',EPSD0,'EPSIPP(1)',EPSIPP(1)
  134. IF ( (EPSIPP(1)) .GT. (EPSD0) ) THEN
  135. * IF ( EPSITOP(1) .GT. (EPSD0) ) THEN
  136. * PRINT*,'OUI On calcul l endommagement'
  137. * PRINT*,'EPSIPP(1)/BT1',EPSIPP(1)/BT1
  138. * PRINT*,'EPSITOP(1)',EPSITOP(1)
  139. * PRINT*,'BT1',BT1
  140. D1=1.D0-(((EPSD0)/EPSIPP(1))*EXP(BT*(EPSD0- EPSIPP(1))))
  141. * D1=1.D0-EPSD0/EPSIPP(1)*EXP(BT*(EPSD0 - (EPSIPP(1)+EPSE1)))
  142. * D1=1.D0-EXP(-BT*(EPSE))
  143. * D1=0.D0
  144. ELSE
  145. D1=0.D0
  146. END IF
  147. * PRINT*,'D1=',D1
  148. * PRINT*,'EPSIPP(1)=',EPSIPP(1)
  149. * PRINT*,'EPSE1=',EPSE1
  150. * PRINT*,'EPSE',EPSE
  151. *
  152. *
  153. * et on en l'endommagement final
  154. *
  155. IF(d1.gt.dom)then
  156. dom=d1
  157. endif
  158. * print*,'DOM=',DOM
  159. *
  160. * on separe les contraintes effectives en + et - dans rpsigma
  161. *
  162. CALL ENDOCA (SIGF,SIG33,1)
  163. CALL JACOB3 (SIG33,3,SIGPP,VECP)
  164. * print*,'contraintes ppales'
  165. * print*,sigpp
  166. DO I=1,3
  167. IF (SIGPP(I) .LT. 0.D0)THEN
  168. SIGPM(I)=SIGPP(I)
  169. SIGPP(I)=0.D0
  170. ELSE
  171. SIGPM(I)=0.D0
  172. END IF
  173. END DO
  174. CALL PRODT2(SIG33P,SIGPP,VECP,3)
  175. CALL PRODT2(SIG33M,SIGPM,VECP,3)
  176. * print*,'contraintes dans rpg'
  177. * print*,sig33p
  178. * print*,sig33m
  179. *
  180. LAMBDAP=1.D0-DOM
  181. LAMBDAM=1.D0-DOM**ALFA
  182. SIG33(1,1)=LAMBDAP*SIG33P(1,1)+LAMBDAM*SIG33M(1,1)
  183. SIG33(1,2)=LAMBDAP*SIG33P(1,2)+LAMBDAM*SIG33M(1,2)
  184. SIG33(1,3)=LAMBDAP*SIG33P(1,3)+LAMBDAM*SIG33M(1,3)
  185. SIG33(2,1)=SIG33(1,2)
  186. SIG33(2,2)=LAMBDAP*SIG33P(2,2)+LAMBDAM*SIG33M(2,2)
  187. SIG33(2,3)=LAMBDAP*SIG33P(2,3)+LAMBDAM*SIG33M(2,3)
  188. SIG33(3,1)=SIG33(1,3)
  189. SIG33(3,2)=SIG33(2,3)
  190. SIG33(3,3)=LAMBDAP*SIG33P(3,3)+LAMBDAM*SIG33M(3,3)
  191. *
  192. * Modif Mohammed calcul des def total
  193. DO ISTRS=1,3
  194. TRSIG33=SIG33(1,1)+SIG33(2,2)+sig33(3,3)
  195. END DO
  196. DEFTOT(1)=( (1.D0+XNU)*SIG33(1,1)-XNU*TRSIG33)/YOUNG
  197. * print*,'sig33',sig33(1,1),sig33(2,2),sig33(3,3)
  198. * print*,'Lambdam',dom**alfa
  199. * print*,deftot(1)
  200. *
  201.  
  202. * on rend les contraintes et les variables internes finales
  203. *
  204. SIGAN(1)=SIGF(1)-SIG33(1,1)
  205. SIGF(1)=SIG33(1,1)
  206. VARF(3)=DMAX1 (DOM,0.d0)
  207. * VARF(3)=DEFELA(1)
  208. SIGAN(2)=SIGF(2)-SIG33(2,2)
  209. SIGF(2)=SIG33(2,2)
  210. SIGAN(3)=SIGF(3)-SIG33(3,3)
  211. SIGF(3)=SIG33(3,3)
  212. SIGAN(4)=SIGF(4)-SIG33(1,2)
  213. SIGF(4)=SIG33(1,2)
  214. IF(IFOUR.GE.1.OR.IFOUR.LE.-3) THEN
  215. SIGAN(5)=SIGF(5)-SIG33(1,3)
  216. SIGF(5)=SIG33(1,3)
  217. SIGAN(6)=SIGF(6)-SIG33(2,3)
  218. SIGF(6)=SIG33(2,3)
  219. ELSE
  220. SIGAN(5)=0.D0
  221. SIGAN(6)=0.D0
  222. END IF
  223. DO ISTRS=1,6
  224. VARF(ISTRS+3)=SIGAN(ISTRS)
  225. END DO
  226. * print*,'sigf',sigf(1),sigf(2),sigf(3)
  227. * print*,'sigf',sigf(4),sigf(5),sigf(6)
  228. * print*,'sigan',sigan(1),sigan(2),sigan(3)
  229. * print*,'sigan',sigan(4),sigan(5),sigan(6)
  230. SEGSUP WRKK1
  231. RETURN
  232. END
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  

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