Télécharger cmazar.eso

Retour à la liste

Numérotation des lignes :

  1. C CMAZAR SOURCE BP208322 17/03/01 21:15:49 9325
  2. SUBROUTINE CMAZAR (WRK52,WRK53,WRK54,WRKK2,NSTRS1,NVARI,
  3. 1 ICARA,JDIM,IFOUR2)
  4. C MAZARS SOURCE AM 98/12/23 21:38:30 3409
  5. C
  6. C
  7. C variables en entree
  8. C
  9. C
  10. C WRK0 pointeur sur un segment deformation au pas precedent
  11. C
  12. C WRK1 pointeur sur un segment increment de deformation
  13. C
  14. C WRKK2 pointeur sur un segment variables internes au pas precedent
  15. C
  16. C WRK5 pointeur sur un segment de deformations inelastiques
  17. C
  18. C XMATER constantes du materiau
  19. C
  20. C NSTRS1 nombre de composantes dans les vecteurs des contraintes
  21. C et les vecteurs des deformations
  22. C
  23. C NVARI nombre de variables internes (doit etre egal a 2)
  24. C
  25. C NMATT nombre de constantes du materiau
  26. C
  27. C ISTEP flag utilise pour separer les etapes dans un calcul non local
  28. C ISTEP=0 -----> calcul local
  29. C ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  30. C ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  31. C a partir des seuils moyennes
  32. C
  33. C Modif L.Bode - 14/10/92
  34. C Nouveaux parametres en entree
  35. C JDIM Dimension de travail
  36. C ( Coques JDIM =2 , Massifs JDIM = IDIM )
  37. C IFOUR2 Type de formulation
  38. C ( Coques IFOUR2 = -2 => contraintes planes ,
  39. C Massifs IFOUR2 = IFOUR)
  40. C
  41. C variables en sortie
  42. C
  43. C VARINF variables internes finales
  44. C
  45. C SIGMAF contraintes finales
  46. C
  47. C C. LA BORDERIE MARS 1992
  48. C declaration des variables
  49. C
  50. C
  51. IMPLICIT INTEGER(I-N)
  52. IMPLICIT REAL*8(A-H,O-Z)
  53. -INC CCOPTIO
  54. -INC DECHE
  55. *
  56. SEGMENT WRKK2
  57. REAL*8 EPSILI(NSTRS1)
  58. ENDSEGMENT
  59. C Modif L.Bode - 14/10/92
  60. SEGMENT WRK3
  61. REAL*8 EPSILO(NSTRS1)
  62. ENDSEGMENT
  63. C Definition dynamique de EPSILO
  64. C Fin modif L.Bode
  65. INTEGER NSTRS1,NVARI
  66. REAL*8 EPS33(3,3),EPSIPP(3),EPSILT(3),VALP33(3,3)
  67. REAL*8 SIGP(3),SIGPT(3),SIGPC(3),TRSIGT,TRSIGC
  68. REAL*8 YOUN,XNU,EPSD0,ACOM,BCOM,ATRA,BTRA,BETA
  69. INTEGER ISTRS,JSTRS,KCAS,IRTD
  70. REAL*8 XZERO,UN,DEUX,XPETIT
  71. REAL*8 DINI,D,DT,DC,EPSTIL,EPSTIM,ALFAT,ALFAC,GAMMA
  72. PARAMETER (XZERO=0.D0 , UN=1.D0 , DEUX=2.D0, XPETIT=1.D-12)
  73.  
  74. C
  75. C
  76. C recuperation des variables initiales dans les tableaux
  77. C
  78. C
  79. N=NSTRS1
  80. CMATE = 'ISOTROPE'
  81. YOUN = XMAT(1)
  82. XNU = XMAT(2)
  83. EPSD0= XMAT(5)
  84. ACOM = XMAT(6)
  85. BCOM = XMAT(7)
  86. ATRA = XMAT(8)
  87. BTRA = XMAT(9)
  88. BETA = XMAT(10)
  89. DINI = VAR0(2)
  90.  
  91. C
  92. C calcul des seuils
  93. C
  94. C
  95. C calcul de la deformation totale
  96. C
  97. SEGINI WRK3
  98. DO 100 ISTRS=1,NSTRS1
  99. EPSILO(ISTRS)=EPSILI(ISTRS)+DEPST(ISTRS)
  100. 100 CONTINUE
  101. C
  102. C calcul des deformations principales
  103. C
  104. C
  105. C on reecrit les deformations sous forme matricielle
  106. C
  107. C Modif L.Bode - 14/10/92
  108. C Rajout de IFOUR2 en argument de ENDOCA
  109. * print*,'on appelle ENDOCB'
  110. CALL ENDOCB (EPSILO,EPS33,2,IFOUR2)
  111. * print*,'apres endocb'
  112. C Fin modif L.Bode
  113. C
  114. C et on diagonalise
  115. C
  116. C Modif L.Bode - 14/10/92
  117. C Pour les elts Coques, on travaille en contraintes planes => JDIM =2
  118. C Pour les elts Massifs JDIM =IDIM
  119. * print*,'avant JACOB3'
  120. CALL JACOB3 (EPS33,JDIM,EPSIPP,VALP33)
  121. * print*,'apres JACOB3'
  122. C Fin modif L.Bode
  123. IF (ISTEP .EQ. 0 .OR. ISTEP.EQ.2) THEN
  124. C
  125. C on calcule la matrice de hooke et les contraintes ppales
  126. C
  127. CMATE = 'ISOTROPE'
  128. KCAS=1
  129. C Modif L.Bode - 14/10/92
  130. C IFOUR --> IFOUR2 dans appel DOHMAS
  131. * print*,'avant dohmas'
  132. CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRS1,KCAS,DDHOOK,IRTD)
  133. * print*,'apres dohmas'
  134. C Fin modif L.Bode
  135. DO 200 ISTRS=1,3
  136. SIGP(ISTRS)= XZERO
  137. DO 210 JSTRS=1,3
  138. SIGP(ISTRS)=SIGP(ISTRS)+DDHOOK(ISTRS,JSTRS)*EPSIPP(JSTRS)
  139. 210 CONTINUE
  140. 200 CONTINUE
  141. END IF
  142. C
  143. C on complete la deformation dans le cas des contraintes planes
  144. C
  145. C Modif L.Bode - 14/10/92
  146. C IFOUR remplace par IFOUR2
  147. IF (IFOUR2.EQ. -2) THEN
  148. EPSIPP(3)= -(EPSIPP(1) + EPSIPP(2))*XNU / (UN-XNU)
  149. END IF
  150. C Fin modif L.Bode
  151. C
  152. C on calcule le epsilontild
  153. C
  154. EPSTIL=MAX( XZERO , EPSIPP(1) )**2 +
  155. 1 MAX( XZERO , EPSIPP(2) )**2 +
  156. 2 MAX( XZERO , EPSIPP(3) )**2
  157. EPSTIL=SQRT (EPSTIL)
  158. epstil=max(xpetit,epstil)
  159. IF (ISTEP .EQ. 0) THEN
  160. EPSTIM=EPSTIL
  161. VARF(1)=EPSTIL
  162. ELSE IF (ISTEP .EQ. 1) THEN
  163. VARF(2)=DINI
  164. VARF(1)=EPSTIL
  165. ELSE IF (ISTEP .EQ. 2) THEN
  166. EPSTIM=VAR0(1)
  167. VARF(1)=EPSTIM
  168. ELSE
  169. PRINT*,'DANS MAZARS ISTEP = 0,1,2 ET PAS ',ISTEP
  170. END IF
  171. IF ( (ISTEP .EQ. 0) .OR. (ISTEP .EQ. 2)) THEN
  172. C
  173. C on calcule l'endommagement et les contraintes
  174. C
  175. C
  176. C on calcule ALFAT ALFAC DT et DC puis D
  177. C dans le cas ou le seuil initial est depasse
  178. C
  179. IF ( EPSTIM .GT. EPSD0) THEN
  180. C
  181. C calcul de l'endommagement
  182. C
  183. C
  184. C on calcule le signe des contraintes elastiques
  185. C
  186. DO 300 ISTRS=1,3
  187. IF (SIGP(ISTRS).LT. XZERO) THEN
  188. SIGPC(ISTRS)=SIGP(ISTRS)
  189. SIGPT(ISTRS)=XZERO
  190. ELSE
  191. SIGPT(ISTRS)=SIGP(ISTRS)
  192. SIGPC(ISTRS)=XZERO
  193. END IF
  194. 300 CONTINUE
  195. TRSIGT=SIGPT(1)+SIGPT(2)+SIGPT(3)
  196. TRSIGC=SIGPC(1)+SIGPC(2)+SIGPC(3)
  197. C
  198. C on calcule les deformations dues aux contraintes positives
  199. C
  200. DO 400 ISTRS=1,3
  201. EPSILT(ISTRS)=(SIGPT(ISTRS)*(UN+XNU)-TRSIGT*XNU)/YOUN
  202. 400 CONTINUE
  203. C
  204. C on en deduit ALFAT et ALFAC
  205. C
  206. ALFAT = MAX(XZERO,EPSIPP(1))*EPSILT(1) +
  207. 1 MAX(XZERO,EPSIPP(2))*EPSILT(2) +
  208. 2 MAX(XZERO,EPSIPP(3))*EPSILT(3)
  209. ALFAT = ALFAT/(EPSTIL*EPSTIL)
  210. ALFAC = UN - ALFAT
  211. C
  212. C modification pour la bi ou tricompression
  213. C
  214. IF (TRSIGC.LT. -XPETIT .AND. TRSIGT.LT.XPETIT) THEN
  215. GAMMA=SIGPC(1)*SIGPC(1)+SIGPC(2)*SIGPC(2)+
  216. 1 SIGPC(3)*SIGPC(3)
  217. GAMMA=-SQRT(GAMMA)/TRSIGC
  218. EPSTIM=EPSTIM*GAMMA
  219. END IF
  220. C
  221. C amelioration de la reponse en cisaillement pour beta > 1.
  222. C
  223. IF (BETA .GT. UN) THEN
  224. IF ( ALFAT .GT. XPETIT ) THEN
  225. ALFAT=ALFAT**BETA
  226. END IF
  227. IF ( ALFAC .GT. XPETIT ) THEN
  228. ALFAC=ALFAC**BETA
  229. END IF
  230. END IF
  231.  
  232. C
  233. C on calcule DT et DC puis D
  234. C dans le cas ou le seuil initial est depasse
  235. C
  236. C on est oblige de verifier car on a pu multiplier par gamma
  237. C
  238. C IF (EPSTIM .GT. EPSD0) THEN
  239. C DT=UN - EPSD0*(UN-ATRA)/EPSTIM -
  240. C 1 ATRA*EXP(-BTRA*(EPSTIM-EPSD0))
  241. C DC=UN - EPSD0*(UN-ACOM)/EPSTIM -
  242. C 1 ACOM*EXP(-BCOM*(EPSTIM-EPSD0))
  243. C ELSE
  244. C DT=XZERO
  245. C DC=XZERO
  246. C END IF
  247. CLB 2010/01/20
  248. C trois lois d'évolution:
  249. C ATRA > 0 : loi de mazars classique
  250. C -10<ATRA<0 : loi d'évolution exponentielle modifiée pour le GF
  251. C ATRA < -10 : loi d'évolution linéaire --> BTRA est alors
  252. C la déformation pour laquelle la contrainte s'annule C
  253. C
  254. IF (EPSTIM .GT. EPSD0) THEN
  255. IF (ATRA .GT. 0.D0) THEN
  256. DT=UN - EPSD0*(UN-ATRA)/EPSTIM -
  257. 1 ATRA*EXP(BTRA*(EPSD0-EPSTIM))
  258. ELSE IF (ATRA . GT. -10.) THEN
  259. DT=UN - epsd0/epstim*EXP(BTRA*(EPSD0-EPSTIM))
  260. ELSE
  261. IF(EPSTIM .LT. BTRA) THEN
  262. DT=UN - EPSD0*(BTRA - EPSTIM)/EPSTIM/(BTRA - EPSD0)
  263. ELSE
  264. DT=1.D0
  265. ENDIF
  266. END IF
  267. DC=UN - EPSD0*(UN-ACOM)/EPSTIM -
  268. 1 ACOM*EXP(-BCOM*(EPSTIM-EPSD0))
  269. ELSE
  270.  
  271. DT=XZERO
  272. DC=XZERO
  273. END IF
  274. D = ALFAT*DT + ALFAC*DC
  275. C
  276. C on borne la valeur de D a 0.99999..
  277. C
  278. D=MIN ( D , UN-1.D-20 )
  279. ELSE
  280. D=XZERO
  281. END IF
  282. C
  283. C on teste la croissance de D
  284. C
  285. D=MAX ( D , DINI )
  286. C
  287. C on le stocke dans les variables internes finales
  288. C
  289. VARF(2)= D
  290. C
  291. C on calcule les contraintes finales
  292. C
  293. CALL MATVE1 (DDHOOK,EPSILO,NSTRS1,NSTRS1,SIGF,2)
  294. DO 500 ISTRS=1,NSTRS1
  295. SIGF(ISTRS)=SIGF(ISTRS)*(UN-D)
  296. 500 CONTINUE
  297. C
  298. C et les deformations inelastiques finales
  299. C
  300. DO 600 ISTRS=1,NSTRS1
  301. EPINF(ISTRS)=EPSILO(ISTRS)*D
  302. 600 CONTINUE
  303.  
  304. END IF
  305. SEGSUP WRK3
  306. RETURN
  307. END
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  

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