Télécharger dychec.eso

Retour à la liste

Numérotation des lignes :

dychec
  1. C DYCHEC SOURCE CHAT 05/01/12 23:05:18 5004
  2. SUBROUTINE DYCHEC(XDEP,XDPLAS,XDPLAC,XJEU,IPERM,XABSCI,
  3. & XORDON,I,XFLA,NLIAB,NIP,XVIT,XAMO,iannul)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Calcul de la force de choc pour un choc elementaire *
  12. * point-point- ... -plastique. On recupere en entree *
  13. * la loi de comportement sous la forme d'une evolution. *
  14. * *
  15. * Parametres: *
  16. * *
  17. * e XDEP Valeur du deplacement. *
  18. * es XDPLAS Valeur du deplacement plastique (du pas precedent *
  19. * en entree, du pas actuel en sortie) *
  20. * es XDPLAC Valeur du deplacement plastique cumulé (du pas *
  21. * precedent en entree, du pas actuel en sortie) *
  22. * e XRAID Valeur de la raideur. *
  23. * e XJEU Valeur de la limite de force elastique (positive) *
  24. * e XABSCI Tableau contenant les abscisses de la loi plastique *
  25. * pour la liaison point-point-plastique *
  26. * e XORDON Tableau contenant les ordonnees de la loi plastique *
  27. * e I numero de la liaison. *
  28. * pour la liaison point-point-plastique *
  29. * e IPERM Indice du type de liaison (permanence et ecrouissage) *
  30. * *
  31. * iperm = -2 : liaison elastique permanente *
  32. * iperm = -1 : choc elastique *
  33. * iperm = 1 : choc plastique *
  34. * iperm = 2 : liaison plastique isotrope *
  35. * iperm = 3 : liaison plastique cinematique *
  36. * *
  37. * s XFLA Valeur de la force de choc. *
  38. * *
  39. * *
  40. * Auteur, date de creation: *
  41. * *
  42. * Lenaic FICHET 09/97 point-point- ... -plastique *
  43. * *
  44. *--------------------------------------------------------------------*
  45. *
  46. REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*)
  47. if (iannul.eq.1) then
  48. xfla = 0.D0
  49. return
  50. endif
  51. XRAID = XORDON(I,2)/XABSCI(I,2)
  52. *
  53. *********** CHOC PLASTIQUE ***********
  54. c une sorte d'ecrouissage cinematique en supposant que la
  55. c decharge jusqu' a la contrainte 0 est toujours lineaire
  56.  
  57. IF (IPERM.EQ.1) THEN
  58. XTOT = XDEP - XJEU
  59. XVAL = XTOT - XDPLAS
  60.  
  61. IF (XVAL.GE.0.D0) THEN
  62.  
  63. XFLAT = XRAID*XVAL
  64. xdpla2 = xval + xdplas
  65.  
  66. CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
  67. XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG)))
  68.  
  69. IF (ABS(XFLAT).GT.XFLAC) THEN
  70. xfla = xflac
  71. XDPLAS = XTOT - XFLA/XRAID
  72. XDPLAC = XDPLAS
  73. ELSE
  74. XFLA = XFLAT
  75. ENDIF
  76. xfla = xfla + xamo*xvit
  77. if (xfla.lt.0.d0) xfla = 0.d0
  78. else
  79. xfla = 0.d0
  80. endif
  81. xfla = -xfla
  82.  
  83.  
  84.  
  85. ************** Cas ecrouissage isotrope **************
  86. ELSE IF (IPERM.EQ.2) THEN
  87.  
  88. XVAL = XDEP - XDPLAS
  89. XFLAT = XRAID*XVAL
  90. xdpla2 = abs(xval) + xdplac
  91.  
  92. CALL LIRANG(xdpla2,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
  93. XFLAC = abs(XORDON(I,NRG) + XPENTE*(xdpla2-XABSCI(I,NRG)))
  94.  
  95. IF (ABS(XFLAT).GT.XFLAC) THEN
  96. if (xflat.gt.0) xfla = xflac
  97. if (xflat.le.0) xfla = -xflac
  98. XDPLA0 = XDPLAS
  99. XDPLAS = XDEP - XFLA/XRAID
  100. XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 )
  101. ELSE
  102. XFLA = XFLAT
  103. ENDIF
  104. xfla = xfla + xamo*xvit
  105. xfla = -xfla
  106.  
  107.  
  108. ********** Cas ecrouissage cinematique (bilineaire) **********
  109. ELSE IF (IPERM.EQ.3) THEN
  110. XRAID2 = (XORDON(I,3)-XORDON(I,2))/
  111. & (XABSCI(I,3)-XABSCI(I,2))
  112. xraidp = xraid*xraid2 /(xraid - xraid2)
  113. bacstr = xraidp*xdplas
  114. XVAL = XDEP - XDPLAS
  115. XFLAT = XRAID*XVAL
  116. xstres = xflat - bacstr
  117. if (xstres.ge.0) xcrit = XORDON(I,2)
  118. if (xstres.lt.0) xcrit = -XORDON(I,2)
  119. dxfl = xstres - xcrit
  120.  
  121. IF (abs(xstres) .LE. abs(xcrit)) THEN
  122. XFLA = XFLAT
  123. ELSE
  124. xdp2 = dxfl/xraid
  125. XFLA = xflat - dxfl + xdp2*xraid2
  126. XDPLA0 = XDPLAS
  127. XDPLAS = XDEP - XFLA/XRAID
  128. XDPLAC = XDPLAC + ABS(XDPLAS - XDPLA0 )
  129. ENDIF
  130. xfla = xfla + xamo*xvit
  131.  
  132. XFLA = -XFLA
  133.  
  134. ********** Cas elastique permanent **********
  135. ELSE IF (IPERM.EQ.-2) THEN
  136. XVAL = abs(XDEP)
  137. CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
  138. XFLA = (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG)))
  139. if (xdep.lt.0d0) xfla = -xfla
  140. xfla = -xfla - XAMO * XVIT
  141.  
  142. ********** Choc elastique **********
  143. ELSE IF (IPERM.EQ.-1) THEN
  144. IF (XDEP.GE.XJEU) THEN
  145. XVAL = XDEP - XJEU
  146. CALL LIRANG(XVAL,XABSCI,XORDON,I,NLIAB,NRG,XPENTE,NIP)
  147. XFLA = - (XORDON(I,NRG) + XPENTE*(XVAL-XABSCI(I,NRG)))
  148. & - XAMO * XVIT
  149. IF ( XFLA.GT.0.D0) XFLA = 0.D0
  150. ELSE
  151. XFLA = 0.D0
  152. ENDIF
  153.  
  154.  
  155. ********* autre cas *******
  156. * ELSE IF (IPERM.EQ. ) THEN
  157.  
  158. ENDIF
  159.  
  160. END
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  

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