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 36 : call SCALPR(4,tau,tau,Xnorm_tau) 37 : Xnorm_tau=sqrt(Xnorm_tau) 38 : 38 : call SCALPR(4,Gradf_star,Gradf_star,Xnorm_Gradf_star) 39 : Xnorm_Gradf_star=sqrt(Xnorm_Gradf_star) 40 : if (Xnorm_Gradf_star.ne.0) then 41 : 42 : C Test nécessaire pour éviter d'avoir une divergence des variables d'écrouissage 43 : if (abs(q(1)).gt.abs(Gradf_star(1))/Xnorm_Gradf_star*qinf) then 44 : q(1)=Gradf_star(1)/Xnorm_Gradf_star*qinf 45 : endif 46 : if (abs(q(2)).gt.abs(Gradf_star(2))/Xnorm_Gradf_star*qinf) then 47 : q(2)=Gradf_star(2)/Xnorm_Gradf_star*qinf 48 : endif 49 : if (abs(q(3)).gt.abs(Gradf_star(3))/Xnorm_Gradf_star*qinf) then 50 : q(3)=Gradf_star(3)/Xnorm_Gradf_star*qinf 51 : endif 52 : if (abs(q(4)).gt.abs(Gradf_star(4))/Xnorm_Gradf_star*qinf) then 53 : q(4)=Gradf_star(4)/Xnorm_Gradf_star*qinf 54 : endif 55 : 56 : dist=(sqrt((Gradf_star(1)/Xnorm_Gradf_star*qinf-q(1))**2+ 57 : & (Gradf_star(2)/Xnorm_Gradf_star*qinf-q(2))**2+ 58 : & (Gradf_star(3)/Xnorm_Gradf_star*qinf-q(3))**2+ 59 : & (Gradf_star(4)/Xnorm_Gradf_star*qinf-q(4))**2)) 60 : 61 : else 62 : dist=0.9999999 63 : endif 64 : 65 : if (dist.le.distmin_prec) then 66 : distmin=dist 67 : else 68 : distmin=distmin_prec 69 : endif 70 : 71 : 72 : dist0=2/(1+a6) 73 : if (((dist+distmin*(1-dist0))/dist0).gt.1) then 74 : hh(1)=-Gradgs(2)/((1+a6)*den1_star)*1E12*XMKel(2,2) 75 : hh(2)=-Gradgs(3)/((1+a6)*den2_star)*1E12*XMKel(3,3) 76 : hh(3)=-Gradgs(4)/((1+a6)*den1_star)*1E12*XMKel(4,4) 77 : hh(4)=-Gradgs(5)/((1+a6)*den2_star)*1E12*XMKel(5,5) 78 : hh(5)=-a6*abs((q(1)*Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2) 79 : &+q(2)*Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3) 80 : &+q(3)*Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4) 81 : &+q(4)*Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5))*1E12)/Xnorm_tau 82 : else 83 : hh(1)=-Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2) 84 : & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0)) 85 : hh(2)=-Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3) 86 : & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0)) 87 : hh(3)=-Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4) 88 : & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0)) 89 : hh(4)=-Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5) 90 : & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0)) 91 : hh(5)=-a6*abs((q(1)*Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2) 92 : &+q(2)*Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3) 93 : &+q(3)*Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4) 94 : &+q(4)*Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5)) 95 : & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0)))/Xnorm_tau 96 : 97 : endif 98 : 99 : 100 : return 101 : end 102 :
© Cast3M 2003 - All rights reserved.
Disclaimer