Télécharger coend.eso

Retour à la liste

Numérotation des lignes :

  1. C COEND SOURCE PV 11/03/07 21:15:37 6885
  2. SUBROUTINE COEND(WRK0,WRK2,ENDO0,NCOURB,
  3. 1 NENDO,NRAPP,KERRE)
  4. *
  5. *********************************************************************
  6. *
  7. * Subroutine de trace de la courbe de traction
  8. * et de la courbe de debut d'endommagement
  9. * du modele d'endommagement P/Y
  10. *
  11. * ENTREES
  12. * - WRK0: segment sur les caracteristiques materiaux
  13. * - WRK2: segment sur la courbe de traction
  14. * - ENDO0: segment contenat la courbe de début d'endommagement
  15. * et la courbe d'évolution de l'endommagement
  16. * en fonction de la pseudo porosite
  17. *
  18. * SORTIES
  19. * - WRK2: segment sur la courbe de traction
  20. * - ENDO: courbe de debut d'endommagement
  21. * - RAPP: courbe d'évolution de l'endommagement
  22. * en fonction de la pseudo porosite
  23. * - NCOURB: nombre de points de la courbe de traction
  24. * - NENDO: nombre de points de la courbe de debut d'endommagement
  25. * - NRAPP: nombre de points de la courbe d'évolution de l'endommagement
  26. * en fonction de la pseudo porosite
  27. *
  28. **********************************************************************
  29. *
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8(A-H,O-Z)
  32. *
  33. -INC SMEVOLL
  34. -INC SMLREEL
  35. *
  36. SEGMENT/WRK0/(XMAT(NCOMAT)*D)
  37. SEGMENT/WRK2/(TRAC(LTRAC)*D)
  38. SEGMENT ENDO0
  39. REAL*8 ENDO(LENDO),RAPP(LENDO)
  40. ENDSEGMENT
  41. *
  42. DATA NCOMAX/130/
  43. *
  44. *==============================================
  45. * Courbe de traction
  46. *==============================================
  47. *
  48. KERRE=0
  49. MEVOLL=nint(XMAT(5))
  50. IF (MEVOLL.EQ.0) THEN
  51. KERRE=37
  52. RETURN
  53. ENDIF
  54. *
  55. SEGACT MEVOLL
  56. KEVOLL=IEVOLL(1)
  57. SEGACT KEVOLL
  58. MLREEL=IPROGX
  59. MLREE1=IPROGY
  60. SEGDES KEVOLL
  61. SEGACT MLREEL,MLREE1
  62. NBPOIX=PROG(/1)
  63. NBPOIY=MLREE1.PROG(/1)
  64. IF(NBPOIX.GT.NCOMAX+1) KERRE=31
  65. IF(NBPOIX.LT.3) KERRE=32
  66. IF(KERRE.EQ.0) GO TO 693
  67. 692 CONTINUE
  68. *
  69. * Erreur
  70. *
  71. SEGDES MLREEL,MLREE1
  72. SEGDES MEVOLL
  73. GO TO 777
  74. 693 CONTINUE
  75. *
  76. * TESTS SUR LES POINTS DE LA COURBE ( A COMPLETER )
  77. *
  78. YUNG=XMAT(1)
  79. IF (YUNG.EQ.0.D0) THEN
  80. KERRE=34
  81. GO TO 692
  82. ENDIF
  83. PSIG=MLREE1.PROG(1)
  84. PEPS=PROG(1)
  85. IF (PSIG.NE.0.D0.OR.PEPS.NE.0.D0) THEN
  86. KERRE=35
  87. GO TO 692
  88. ENDIF
  89. *
  90. * VERIF DE LA LIMITE ELASTIQUE NON NULLE
  91. *
  92. PSIG =MLREE1.PROG(2)
  93. IF (PSIG.EQ.0.D0) THEN
  94. KERRE=30
  95. GO TO 692
  96. ENDIF
  97. PEPS=PROG(2)
  98. IF (PEPS.EQ.0.D0) THEN
  99. KERRE=35
  100. GO TO 692
  101. ENDIF
  102. PENTE=PSIG/PEPS
  103. RA=ABS(PENTE-YUNG)/YUNG
  104. IF (RA.GT.5.D-3) THEN
  105. KERRE=36
  106. GO TO 692
  107. ENDIF
  108. *
  109. * VERIF DE LA PENTE
  110. *
  111. DO 100 I=3,NBPOIX
  112. I1=I-1
  113. DEPS=PROG(I)-PROG(I1)
  114. IF(DEPS.EQ.0.D0) THEN
  115. KERRE=33
  116. GO TO 692
  117. ENDIF
  118. PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS
  119. IF(PENTE.GE.YUNG) THEN
  120. KERRE=33
  121. GO TO 692
  122. ENDIF
  123. 100 CONTINUE
  124. NCOURB=1
  125. TRAC(1)=MLREE1.PROG(2)
  126. TRAC(2)=0.D0
  127. DO 695 I=3,NBPOIX
  128. PEPS=PROG(I)
  129. PSIG=MLREE1.PROG(I)
  130. NCOURB=NCOURB+1
  131. TRAC(2*NCOURB-1)=PSIG
  132. TRAC(2*NCOURB)=PEPS-PSIG/YUNG
  133. 695 CONTINUE
  134. *
  135. SEGDES MLREEL,MLREE1
  136. SEGDES MEVOLL
  137. *
  138. *===============================================
  139. * Trace de la courbe d'endommagement
  140. *===============================================
  141. *
  142. MEVOLL=nint(XMAT(6))
  143. IF(MEVOLL.EQ.0) THEN
  144. KERRE=37
  145. RETURN
  146. ENDIF
  147. *
  148. SEGACT MEVOLL
  149. KEVOLL=IEVOLL(1)
  150. SEGACT KEVOLL
  151. MLREEL=IPROGX
  152. MLREE1=IPROGY
  153. SEGDES KEVOLL
  154. SEGACT MLREEL,MLREE1
  155. NBPOIX=PROG(/1)
  156. NBPOIY=MLREE1.PROG(/1)
  157. IF(NBPOIX.GT.NCOMAX+1) KERRE=31
  158. IF(NBPOIX.LT.3) KERRE=32
  159. IF(KERRE.EQ.0) GO TO 10
  160. *
  161. * Erreur
  162. *
  163. SEGDES MLREEL,MLREE1
  164. SEGDES MEVOLL
  165. GO TO 777
  166. 10 CONTINUE
  167. *
  168. NENDO=0
  169. DO 20 I=1,NBPOIX
  170. NENDO=NENDO+1
  171. ENDO(2*NENDO-1)=MLREE1.PROG(I)
  172. ENDO(2*NENDO)=PROG(I)
  173. 20 CONTINUE
  174. *
  175. SEGDES MLREEL,MLREE1
  176. SEGDES MEVOLL
  177. *
  178. *====================================================
  179. * Trace de la courbe d'évolution de l'endommagement
  180. *====================================================
  181. *
  182. MEVOLL=nint(XMAT(7))
  183. IF(MEVOLL.EQ.0) THEN
  184. KERRE=37
  185. RETURN
  186. ENDIF
  187. *
  188. SEGACT MEVOLL
  189. KEVOLL=IEVOLL(1)
  190. SEGACT KEVOLL
  191. MLREEL=IPROGX
  192. MLREE1=IPROGY
  193. SEGDES KEVOLL
  194. SEGACT MLREEL,MLREE1
  195. NBPOIX=PROG(/1)
  196. NBPOIY=MLREE1.PROG(/1)
  197. IF(NBPOIX.GT.NCOMAX+1) KERRE=31
  198. IF(NBPOIX.LT.3) KERRE=32
  199. IF(KERRE.EQ.0) GO TO 11
  200. *
  201. * Erreur
  202. *
  203. SEGDES MLREEL,MLREE1
  204. SEGDES MEVOLL
  205. GO TO 777
  206. 11 CONTINUE
  207. *
  208. NRAPP=0
  209. DO 21 I=1,NBPOIX
  210. NRAPP=NRAPP+1
  211. RAPP(2*NRAPP-1)=MLREE1.PROG(I)
  212. RAPP(2*NRAPP)=PROG(I)
  213. 21 CONTINUE
  214. *
  215. SEGDES MLREEL,MLREE1
  216. SEGDES MEVOLL
  217. *
  218. 777 CONTINUE
  219. RETURN
  220. END
  221.  
  222.  
  223.  
  224.  
  225.  

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