Numérotation des lignes :

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

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