Télécharger fveh.eso

Retour à la liste

Numérotation des lignes :

  1. C FVEH SOURCE AM 11/05/26 21:15:32 6982
  2. subroutine FVEH (da,force,q,XMKel,Gradgs,distmin_prec,hh,distmin)
  3. C Routine permettant la fonction vectorielle d'écrouissage
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. DIMENSION da(20), XMKel(5,5), force(5), q(5), Gradgs(5), hh(5)
  8. DIMENSION Gradf_star(4), force_star(4), tau(4)
  9. *
  10. a=da(8)
  11. b=da(9)
  12. c=da(10)
  13. d=da(11)
  14. e=da(12)
  15. f=da(13)
  16. a6=da(16)
  17.  
  18. C projection du vecteur Gradfs dans l'hyperplan (H*,M*)
  19. gamma=1.
  20.  
  21. den1_star = a*force(1)**c*(gamma-force(1))**d
  22. den2_star = b*force(1)**e*(gamma-force(1))**f
  23. force_star(1)=force(2)/den1_star
  24. force_star(2)=force(3)/den2_star
  25. force_star(3)=force(4)/den1_star
  26. force_star(4)=force(5)/den2_star
  27.  
  28. Gradf_star(1)=2/q(5)**2*(force_star(1)-q(1))
  29. Gradf_star(2)=2/q(5)**2*(force_star(2)-q(2))
  30. Gradf_star(3)=2/q(5)**2*(force_star(3)-q(3))
  31. Gradf_star(4)=2/q(5)**2*(force_star(4)-q(4))
  32.  
  33. qinf=1-q(5)
  34. DO I=1,4
  35. tau(I)=q(I)
  36. ENDDO
  37. call SCALPR(4,tau,tau,Xnorm_tau)
  38. Xnorm_tau=sqrt(Xnorm_tau)
  39.  
  40. call SCALPR(4,Gradf_star,Gradf_star,Xnorm_Gradf_star)
  41. Xnorm_Gradf_star=sqrt(Xnorm_Gradf_star)
  42. if (Xnorm_Gradf_star.ne.0) then
  43.  
  44. C Test nécessaire pour éviter d'avoir une divergence des variables d'écrouissage
  45. if (abs(q(1)).gt.abs(Gradf_star(1))/Xnorm_Gradf_star*qinf) then
  46. q(1)=Gradf_star(1)/Xnorm_Gradf_star*qinf
  47. endif
  48. if (abs(q(2)).gt.abs(Gradf_star(2))/Xnorm_Gradf_star*qinf) then
  49. q(2)=Gradf_star(2)/Xnorm_Gradf_star*qinf
  50. endif
  51. if (abs(q(3)).gt.abs(Gradf_star(3))/Xnorm_Gradf_star*qinf) then
  52. q(3)=Gradf_star(3)/Xnorm_Gradf_star*qinf
  53. endif
  54. if (abs(q(4)).gt.abs(Gradf_star(4))/Xnorm_Gradf_star*qinf) then
  55. q(4)=Gradf_star(4)/Xnorm_Gradf_star*qinf
  56. endif
  57.  
  58. dist=(sqrt((Gradf_star(1)/Xnorm_Gradf_star*qinf-q(1))**2+
  59. & (Gradf_star(2)/Xnorm_Gradf_star*qinf-q(2))**2+
  60. & (Gradf_star(3)/Xnorm_Gradf_star*qinf-q(3))**2+
  61. & (Gradf_star(4)/Xnorm_Gradf_star*qinf-q(4))**2))
  62.  
  63. else
  64. dist=0.9999999
  65. endif
  66.  
  67. if (dist.le.distmin_prec) then
  68. distmin=dist
  69. else
  70. distmin=distmin_prec
  71. endif
  72.  
  73.  
  74. dist0=2/(1+a6)
  75. if (((dist+distmin*(1-dist0))/dist0).gt.1) then
  76. hh(1)=-Gradgs(2)/((1+a6)*den1_star)*1E12*XMKel(2,2)
  77. hh(2)=-Gradgs(3)/((1+a6)*den2_star)*1E12*XMKel(3,3)
  78. hh(3)=-Gradgs(4)/((1+a6)*den1_star)*1E12*XMKel(4,4)
  79. hh(4)=-Gradgs(5)/((1+a6)*den2_star)*1E12*XMKel(5,5)
  80. hh(5)=-a6*abs((q(1)*Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2)
  81. &+q(2)*Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3)
  82. &+q(3)*Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4)
  83. &+q(4)*Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5))*1E12)/Xnorm_tau
  84. else
  85. hh(1)=-Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2)
  86. & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
  87. hh(2)=-Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3)
  88. & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
  89. hh(3)=-Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4)
  90. & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
  91. hh(4)=-Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5)
  92. & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
  93. hh(5)=-a6*abs((q(1)*Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2)
  94. &+q(2)*Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3)
  95. &+q(3)*Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4)
  96. &+q(4)*Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5))
  97. & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0)))/Xnorm_tau
  98.  
  99. endif
  100.  
  101.  
  102. return
  103. end
  104.  
  105.  

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