Télécharger mazars.eso

Retour à la liste

Numérotation des lignes :

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

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