Télécharger cmicro.eso

Retour à la liste

Numérotation des lignes :

  1. C CMICRO SOURCE BP208322 17/03/01 21:15:52 9325
  2. C MICROP SOURCE AM 00/12/13 21:40:52 4045
  3. SUBROUTINE CMICRO (WRK52,WRK53,WRK54,NVARI,Iecou)
  4. *
  5. * modele d'endommagement microplan 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 NVARI,ICARA,MFR1
  18. INTEGER ISTRS,I,J
  19. REAL*8 YOUNG,XNU,EPSD0,BT,LAMB,DEUXMU,ALFA
  20. REAL*8 DOM(6),SIGAN(6),TRSIG,DEF33(3,3),EPSIPP(3),VECP(3,3)
  21. REAL*8 DEFPT(6),DEFTOT(6),EPSITOP(3),EPSE1,EPSE
  22. REAL*8 VECPT(3,3),DOM33(3,3),DEFRPDE(3,3),DOMRPDE(3,3)
  23. REAL*8 D1,D2,D3,DOM3(3)
  24. REAL*8 SIGPP(3),SIGPM(3),SIG33(3,3),SIG33P(3,3),SIG33M(3,3)
  25. REAL*8 S33PRD(3,3),S33MRD(3,3)
  26. REAL*8 LAMBDAP(6), LAMBDAM(6)
  27. LOGICAL COMP
  28. INTEGER IDECAL
  29. *
  30. -INC CCOPTIO
  31. -INC DECHE
  32. *
  33.  
  34. SEGMENT IECOU
  35. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  36. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  37. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  38. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  39. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  40. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  41. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  42. 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  43. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  44. 4 icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  45. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  46. 5 icow39,icow40,icow41,icow42,icow43,icow44
  47. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME
  48. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  49. . icow51,icow52,icow53,icow54,icow55,icow56
  50. . icow57,icow58
  51. ENDSEGMENT
  52.  
  53.  
  54. SEGMENT WRKK1
  55. REAL*8 DEFELA(NSTRS1)
  56. REAL*8 DDEFEL(NSTRS1)
  57. ENDSEGMENT
  58. *
  59. * on recupere les variable materielles
  60. *
  61. YOUNG=XMAT(1)
  62. XNU=XMAT(2)
  63. EPSD0=XMAT(5)
  64. BT=XMAT(6)
  65. ALFA=XMAT(9)
  66. DEUXMU=YOUNG/(1.D0+XNU)
  67. LAMB=XNU*DEUXMU/(1.D0-2.D0*XNU)
  68. * print*,'dans microp'
  69. *
  70. * recuperation des variables internes d'endommagement
  71. *
  72. DO ISTRS=1,NSTRS1
  73. DOM(ISTRS)=VAR0(2+ISTRS)
  74. END DO
  75. SEGINI WRKK1
  76. *
  77. * on ecoule plastiquement sur la contrainte effective
  78. *
  79. IDECAL=8
  80. * print*,'appel a micro1'
  81. nstrbi=nstrs1
  82. CALL CMICR1(wrk52,wrk53,wrk54,NSTRbi,NVARI,IDECAL,
  83. & .false.,DEFPT,EPSE1,EPSE)
  84. nstrs1=nstrbi
  85. IF (KERRE .NE. 0) THEN
  86. print*,'on n''a pas converge dans micro1'
  87.  
  88. CALL CMICR1(wrk52,wrk53,wrk54,NSTRbi,NVARI,IDECAL,
  89. & .true.,DEFPT,EPSE1,EPSE)
  90. SEGSUP WRKK1
  91. RETURN
  92. ENDIF
  93. *
  94. * on ecoule en endommagement sur les deformations elastiques
  95. *
  96. * print*,'apres micro1'
  97. *
  98. * calcul de l'increment deformations elastiques DDEFEL
  99. * 1) on calcule l'increment de deformations totales avec
  100. * l'increment de contraintes elastique DSIGT
  101. * 2) on retranche l'increment de deformations plastiques DEFP
  102. *
  103. TRSIG=0.D0
  104. DO ISTRS=1,3
  105. TRSIG=TRSIG+DSIGT(ISTRS)
  106. END DO
  107. DO ISTRS=1,3
  108. DDEFEL(ISTRS)=( (1.D0+XNU)*DSIGT(ISTRS)-XNU*TRSIG)/YOUNG
  109. 1 - DEFP(ISTRS)
  110. END DO
  111. DO ISTRS=4,NSTRS1
  112. DDEFEL(ISTRS)= (1.D0+XNU)*DSIGT(ISTRS)/YOUNG
  113. 1 - 0.5d0*DEFP(ISTRS)
  114. END DO
  115. *
  116. * on diagonalise l'increment de deformations elastiques:
  117. * 1) on met sous forme 3x3 avec endoca
  118. * 2) on diagonalise avec jacob3
  119. *
  120. * print*,'incr de def el dans rpg'
  121. * print*,ddefel
  122. * print*,'avant endoca ddefl'
  123. CALL ENDOCA (DDEFEL,DEF33,1)
  124. * print*,'apres endoca ddefl'
  125. CALL JACOB3 (DEF33,IDIM,EPSIPP,VECP)
  126. * print*,'apres jacob3 def33'
  127. * print*,'incr deformations principales'
  128. * print*,epsipp
  129. *
  130. * calcul des deformations elastiques
  131. *
  132. TRSIG=0.D0
  133. * print*,'-----sigf------'
  134. * print*,sigf(1),sigf(2),sigf(3)
  135. DO ISTRS=1,3
  136. TRSIG=TRSIG+SIGF(ISTRS)
  137. END DO
  138. DO ISTRS=1,3
  139. DEFELA(ISTRS)=( (1.D0+XNU)*SIGF(ISTRS)-XNU*TRSIG)/YOUNG
  140. END DO
  141. * print*,'-----defela------'
  142. * print*,defela(1),defela(2),defela(3)
  143. DO ISTRS=4,NSTRS1
  144. DEFELA(ISTRS)= (1.D0+XNU)*SIGF(ISTRS)/YOUNG
  145. END DO
  146. * print*,'deformations elastiques dans rpg'
  147. * print*,defela
  148. *
  149. * on met les deformations sous forme de matrice 3x3
  150. * puis on ecrit la matrice dans le repere de depsilon:DEFRPDE
  151. *
  152. CALL ENDOCA (DEFELA,DEF33,1)
  153. * print*,'deformations elastiques dans rpg(3x3)'
  154. * print*,def33
  155. CALL PRODT (DEFRPDE,DEF33,VECP,3,3)
  156. * print*,'def elast dans rpddeps'
  157. * print*,defrpde
  158. *
  159. * on calcule l'endommagement resultant
  160. *
  161. IF (DEFRPDE(1,1) .GT. EPSD0) THEN
  162. D1=1.D0-EPSD0/DEFRPDE(1,1)*EXP(BT*( EPSD0 - DEFRPDE(1,1)))
  163. ELSE
  164. D1=0.D0
  165. END IF
  166. IF (DEFRPDE(2,2) .GT. EPSD0) THEN
  167. D2=1.D0-EPSD0/DEFRPDE(2,2)*EXP(BT*( EPSD0 - DEFRPDE(2,2)))
  168. ELSE
  169. D2=0.D0
  170. END IF
  171. IF (DEFRPDE(3,3) .GT. EPSD0) THEN
  172. D3=1.D0-EPSD0/DEFRPDE(3,3)*EXP(BT*( EPSD0 - DEFRPDE(3,3)))
  173. ELSE
  174. D3=0.D0
  175. END IF
  176. * print*,defrpde(1,1),epsd0,D1
  177. * print*,defrpde(2,2),epsd0,D2
  178. * print*,defrpde(3,3),epsd0,D3
  179. *
  180. * on met l'endommagement initial dans le meme repere
  181. *
  182. CALL ENDOCA(DOM,DOM33,1)
  183. * print*,'prodt DOMRPDE'
  184. CALL PRODT (DOMRPDE,DOM33,VECP,3,3)
  185. * print*,'endommagement initial dans rpddeps'
  186. * print*,domrpde
  187. *
  188. * et on en deduit l'increment d'endommagement dans RPDE
  189. *
  190. IF(d1.gt.domrpde(1,1))then
  191. domrpde(1,1)=d1
  192. endif
  193. IF(d2.gt.domrpde(2,2))then
  194. domrpde(2,2)=d2
  195. endif
  196. IF(d3.gt.domrpde(3,3))then
  197. domrpde(3,3)=d3
  198. endif
  199. * print*,'endommagement final dans rpddeps'
  200. * print*,domrpde
  201. *
  202. * on remet D dans RPG
  203. *
  204. DO I=1,3
  205. DO J=1,3
  206. VECPT(I,J)=VECP(J,I)
  207. END DO
  208. END DO
  209. call prodt(DOM33,DOMRPDE,VECPT,3,3)
  210. * print*,'endommagement final dans rpg'
  211. * print*,dom33
  212.  
  213. *
  214. * on separe les contraintes effectives en + et - dans rpsigma
  215. *
  216. CALL ENDOCA (SIGF,SIG33,1)
  217. CALL JACOB3 (SIG33,3,SIGPP,VECP)
  218. * print*,'contraintes ppales'
  219. * print*,sigpp
  220. DO I=1,3
  221. IF (SIGPP(I) .LT. 0.D0)THEN
  222. SIGPM(I)=SIGPP(I)
  223. SIGPP(I)=0.D0
  224. ELSE
  225. SIGPM(I)=0.D0
  226. END IF
  227. END DO
  228. CALL PRODT2(SIG33P,SIGPP,VECP,3)
  229. CALL PRODT2(SIG33M,SIGPM,VECP,3)
  230. * print*,'contraintes dans rpg'
  231. * print*,sig33p
  232. * print*,sig33m
  233. *
  234. * on met le tout dans le repere ppal d'endo
  235. * attention jacob3 modifie la matrice fournie
  236. * --> on passe une copie
  237. DO I=1,3
  238. DO J=1,3
  239. SIG33(I,J)=DOM33(I,J)
  240. END DO
  241. END DO
  242. CALL JACOB3(SIG33,3,DOM3,VECP)
  243. * print*,'endom dans rpd'
  244. * print*,dom3
  245. **************
  246. * A REVOIR EN ATENDANT MIEUX ON BORNE LES VALEURS PROPRES DE D ENTRE 0. ET 1.*
  247. **************
  248. DO I=1,3
  249. DOM3(I)=DMAX1 (DOM3(I),0.D0)
  250. DOM3(I)=DMIN1 (DOM3(I),1.D0-1.d-6)
  251. END DO
  252. CALL PRODT2 (DOM33,DOM3,VECP,3)
  253. **************
  254. * FIN A REVOIR
  255. **************
  256. * print*,'dom3=',dom3
  257. * print*,'dom33=',dom33
  258. CALL PRODT (S33PRD,SIG33P,VECP,3,3)
  259. CALL PRODT (S33MRD,SIG33M,VECP,3,3)
  260.  
  261. * print*,'s33prd',s33prd(3,3)
  262. * print*,'s33mrd',s33mrd(3,3)
  263. * print*,'callambdap'
  264. COMP=.FALSE.
  265. CALL CLMBDA(DOM3(1),DOM3(2),DOM3(3),LAMBDAP,YOUNG,XNU,ALFA,
  266. 1 COMP)
  267. COMP=.TRUE.
  268. CALL CLMBDA(DOM3(1),DOM3(2),DOM3(3),LAMBDAM,YOUNG,XNU,ALFA,
  269. 1 COMP)
  270. * print*,'apres callambdap'
  271. SIG33P(1,1)=LAMBDAP(1)*S33PRD(1,1)+LAMBDAM(1)*S33MRD(1,1)
  272. SIG33P(1,2)=LAMBDAP(4)*S33PRD(1,2)+LAMBDAM(4)*S33MRD(1,2)
  273. SIG33P(1,3)=LAMBDAP(5)*S33PRD(1,3)+LAMBDAM(5)*S33MRD(1,3)
  274. SIG33P(2,1)=SIG33P(1,2)
  275. SIG33P(2,2)=LAMBDAP(2)*S33PRD(2,2)+LAMBDAM(2)*S33MRD(2,2)
  276. SIG33P(2,3)=LAMBDAP(6)*S33PRD(2,3)+LAMBDAM(6)*S33MRD(2,3)
  277. SIG33P(3,1)=SIG33P(1,3)
  278. SIG33P(3,2)=SIG33P(2,3)
  279. SIG33P(3,3)=LAMBDAP(3)*S33PRD(3,3)+LAMBDAM(3)*S33MRD(3,3)
  280. * print*,'contraintes dans RPD'
  281. * print*,sig33p
  282. * print*,'sig33p(1,2)',sig33p(1,2)
  283. * print*,'dsigt',dsigt(1),dsigt(2),dsigt(3)
  284. * print*,'dsigt',dsigt(4),dsigt(5),dsigt(6)
  285. * print*,'sigf',sigf(1),sigf(2),sigf(3)
  286. * print*,'sigf',sigf(4),sigf(5),sigf(6)
  287. *
  288. * on remet le tout dans le repere global
  289. *
  290. * print*,'matrice des vect proprs'
  291. * print*,vecp
  292. DO I=1,3
  293. DO J=1,3
  294. VECPT(I,J)=VECP(J,I)
  295. END DO
  296. END DO
  297. CALL PRODT (SIG33,SIG33P,VECPT,3,3)
  298. * print*,'contraintes dans rpg'
  299. * print*,sig33
  300. *
  301. * on rend les contraintes et les variables internes finales
  302. *
  303. SIGAN(1)=SIGF(1)-SIG33(1,1)
  304. SIGF(1)=SIG33(1,1)
  305. VARF(3)=DMAX1 (DOM33(1,1),0.d0)
  306. SIGAN(2)=SIGF(2)-SIG33(2,2)
  307. SIGF(2)=SIG33(2,2)
  308. VARF(4)=DMAX1 (DOM33(2,2),0.d0)
  309. SIGAN(3)=SIGF(3)-SIG33(3,3)
  310. SIGF(3)=SIG33(3,3)
  311. VARF(5)=DMAX1 (DOM33(3,3),0.d0)
  312. SIGAN(4)=SIGF(4)-SIG33(1,2)
  313. SIGF(4)=SIG33(1,2)
  314. VARF(6)=DMAX1 (DOM33(1,2),0.d0)
  315. VARF(7)=DMAX1 (DOM33(1,3),0.d0)
  316. VARF(8)=DMAX1 (DOM33(2,3),0.d0)
  317. IF(IFOUR.GE.1.OR.IFOUR.LE.-3) THEN
  318. SIGAN(5)=SIGF(5)-SIG33(1,3)
  319. SIGF(5)=SIG33(1,3)
  320. SIGAN(6)=SIGF(6)-SIG33(2,3)
  321. SIGF(6)=SIG33(2,3)
  322. ELSE
  323. SIGAN(5)=0.D0
  324. SIGAN(6)=0.D0
  325. END IF
  326. DO ISTRS=1,6
  327. VARF(ISTRS+8)=SIGAN(ISTRS)
  328. END DO
  329. * print*,'sigf',sigf(1),sigf(2),sigf(3)
  330. * print*,'sigf',sigf(4),sigf(5),sigf(6)
  331. * print*,'sigan',sigan(1),sigan(2),sigan(3)
  332. * print*,'sigan',sigan(4),sigan(5),sigan(6)
  333. SEGSUP WRKK1
  334. RETURN
  335. END
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  

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