Sources Esope | Cast3M

fveh
C FVEH      SOURCE    AM        11/05/26    21:15:32     6982
      subroutine FVEH (da,force,q,XMKel,Gradgs,distmin_prec,hh,distmin)
C     Routine permettant la fonction vectorielle d'écrouissage
 
        IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8(A-H,O-Z)
        DIMENSION da(20), XMKel(5,5), force(5), q(5), Gradgs(5), hh(5)
        DIMENSION Gradf_star(4), force_star(4), tau(4)
*
        a=da(8)
        b=da(9)
        c=da(10)
        d=da(11)
        e=da(12)
        f=da(13)
        a6=da(16)
 
C       projection du vecteur Gradfs dans l'hyperplan (H*,M*)
        gamma=1.
 
      den1_star = a*force(1)**c*(gamma-force(1))**d
      den2_star = b*force(1)**e*(gamma-force(1))**f
      force_star(1)=force(2)/den1_star
        force_star(2)=force(3)/den2_star
        force_star(3)=force(4)/den1_star
        force_star(4)=force(5)/den2_star
 
      Gradf_star(1)=2/q(5)**2*(force_star(1)-q(1))
        Gradf_star(2)=2/q(5)**2*(force_star(2)-q(2))
        Gradf_star(3)=2/q(5)**2*(force_star(3)-q(3))
        Gradf_star(4)=2/q(5)**2*(force_star(4)-q(4))
 
        qinf=1-q(5)
       DO I=1,4
        tau(I)=q(I)
       ENDDO
        call SCALPR(4,tau,tau,Xnorm_tau)
        Xnorm_tau=sqrt(Xnorm_tau)
 
        call SCALPR(4,Gradf_star,Gradf_star,Xnorm_Gradf_star)
        Xnorm_Gradf_star=sqrt(Xnorm_Gradf_star)
        if (Xnorm_Gradf_star.ne.0) then
 
C Test nécessaire pour éviter d'avoir une divergence des variables d'écrouissage
        if (abs(q(1)).gt.abs(Gradf_star(1))/Xnorm_Gradf_star*qinf) then
        q(1)=Gradf_star(1)/Xnorm_Gradf_star*qinf
        endif
        if (abs(q(2)).gt.abs(Gradf_star(2))/Xnorm_Gradf_star*qinf) then
        q(2)=Gradf_star(2)/Xnorm_Gradf_star*qinf
        endif
        if (abs(q(3)).gt.abs(Gradf_star(3))/Xnorm_Gradf_star*qinf) then
        q(3)=Gradf_star(3)/Xnorm_Gradf_star*qinf
        endif
        if (abs(q(4)).gt.abs(Gradf_star(4))/Xnorm_Gradf_star*qinf) then
        q(4)=Gradf_star(4)/Xnorm_Gradf_star*qinf
        endif
 
        dist=(sqrt((Gradf_star(1)/Xnorm_Gradf_star*qinf-q(1))**2+
     & (Gradf_star(2)/Xnorm_Gradf_star*qinf-q(2))**2+
     & (Gradf_star(3)/Xnorm_Gradf_star*qinf-q(3))**2+
     & (Gradf_star(4)/Xnorm_Gradf_star*qinf-q(4))**2))
 
        else
        dist=0.9999999
        endif
 
        if (dist.le.distmin_prec) then
        distmin=dist
        else
        distmin=distmin_prec
        endif
 
 
        dist0=2/(1+a6)
        if (((dist+distmin*(1-dist0))/dist0).gt.1) then
        hh(1)=-Gradgs(2)/((1+a6)*den1_star)*1E12*XMKel(2,2)
        hh(2)=-Gradgs(3)/((1+a6)*den2_star)*1E12*XMKel(3,3)
        hh(3)=-Gradgs(4)/((1+a6)*den1_star)*1E12*XMKel(4,4)
        hh(4)=-Gradgs(5)/((1+a6)*den2_star)*1E12*XMKel(5,5)
        hh(5)=-a6*abs((q(1)*Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2)
     &+q(2)*Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3)
     &+q(3)*Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4)
     &+q(4)*Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5))*1E12)/Xnorm_tau
        else
        hh(1)=-Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2)
     & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
        hh(2)=-Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3)
     & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
        hh(3)=-Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4)
     & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
        hh(4)=-Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5)
     & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0))
        hh(5)=-a6*abs((q(1)*Gradgs(2)/((1+a6)*den1_star)*XMKel(2,2)
     &+q(2)*Gradgs(3)/((1+a6)*den2_star)*XMKel(3,3)
     &+q(3)*Gradgs(4)/((1+a6)*den1_star)*XMKel(4,4)
     &+q(4)*Gradgs(5)/((1+a6)*den2_star)*XMKel(5,5))
     & *(dist)/(1-dist/dist0+distmin/dist0*(1-dist0)))/Xnorm_tau
 
        endif
 
 
        return
        end