m26law.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	m26law (pm, off, sig, rho, epxe, theta, epd, z, mat, voln, dvol, d1, d2, d3, d4, d5, d6, nel, p, rho0, df)

Function/Subroutine Documentation

m26law()

subroutine m26law	(		pm,
			off,
			sig,
			rho,
			epxe,
			theta,
			epd,
			z,
		integer, dimension(*)	mat,
			voln,
			dvol,
			d1,
			d2,
			d3,
			d4,
			d5,
			d6,
		integer	nel,
			p,
			rho0,
			df )

Definition at line 28 of file m26law.F.

C
C     LOI DE COMPORTEMENT TYPE JOHNSON - COOK - SESAME
C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com08_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER MAT(*),NEL
      my_real
     .   pm(npropm,*), off(*), sig(nel,6), rho(*), epxe(*), theta(*),
     .   epd(*), z(*), voln(mvsiz), dvol(*), d1(*), d2(*), d3(*), d4(*),
     .   d5(*), d6(*), p(*), rho0(*), df(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, MX
      my_real
     .   g(mvsiz), g1(mvsiz), g2(mvsiz), ak(mvsiz), qh(mvsiz), tmelt(mvsiz),
     .   aj2(mvsiz), dmu(mvsiz), dav(mvsiz), epmx(mvsiz),
     .   thetl(mvsiz), ca(mvsiz), cb(mvsiz), cc(mvsiz), cn(mvsiz), epdr(mvsiz), cmx(mvsiz),
     .   sigmx(mvsiz),  tstar, ct, ce, ch, scale,
     .   rho0_1, ca_1, cb_1, cn_1, cc_1,
     .   cmx_1, tmelt_1, epdr_1, thetl_1,epmx_1,
     .   sigmx_1
C-----------------------------------------------
C
      mx      =mat(1)
C
      rho0_1 =pm( 1,mx)
      ca_1   =pm(38,mx)
      cb_1   =pm(39,mx)
      cn_1   =pm(40,mx)
      cc_1   =pm(43,mx)
      cmx_1  =pm(45,mx)
      tmelt_1=pm(46,mx)
      epdr_1 =pm(44,mx)
      thetl_1=pm(47,mx)
      epmx_1 =pm(41,mx)
      sigmx_1=pm(42,mx)
C
      DO 10 i=1,nel
      rho0(i) =rho0_1
      g(i)    =pm(22,mx)*off(i)
      ca(i)   =ca_1
      cb(i)   =cb_1
      cn(i)   =cn_1
      cc(i)   =cc_1
      cmx(i)  =cmx_1
      tmelt(i)=tmelt_1
      epdr(i) =epdr_1
C      SPH(I)  =PM(48,MX)
C      PC(I)   =PM(37,MX)
      thetl(i)=thetl_1
      epmx(i) =epmx_1
      sigmx(i)=sigmx_1
   10 CONTINUE
C
      DO 15 i=1,nel
   15 df(i)=rho0(i)/rho(i)
C
      DO 30 i=1,nel
      p(i)  =-third*(sig(i,1)+sig(i,2)+sig(i,3))
      dav(i)=-third*(d1(i)+d2(i)+d3(i))
      g1(i)=dt1*g(i)
      g2(i)=two*g1(i)
      dmu(i)=-dvol(i)/voln(i)
   30 CONTINUE
C-------------------------------
C     CONTRAINTES DEVIATORIQUES
C-------------------------------
      DO 40 i=1,nel
      sig(i,1)=sig(i,1)+p(i)+g2(i)*(d1(i)+dav(i))
      sig(i,2)=sig(i,2)+p(i)+g2(i)*(d2(i)+dav(i))
      sig(i,3)=sig(i,3)+p(i)+g2(i)*(d3(i)+dav(i))
      sig(i,4)=sig(i,4)+g1(i)*d4(i)
      sig(i,5)=sig(i,5)+g1(i)*d5(i)
   40 sig(i,6)=sig(i,6)+g1(i)*d6(i)
C
      DO 50 i=1,nel
      aj2(i)=half*(sig(i,1)**2+sig(i,2)**2+sig(i,3)**2)
     1              +sig(i,4)**2+sig(i,5)**2+sig(i,6)**2
   50 aj2(i)=sqrt(3.*aj2(i))
C
      DO 90 i=1,nel
      IF(theta(i)>=tmelt(i)) GOTO 90
C
      tstar=0.
      ct=1.
      IF(theta(i)<=three100) GOTO 60
      tstar=(theta(i)-three100)/(tmelt(i)-three100)
      IF(theta(i)>thetl(i)) cmx(i)=one
      ct=one -tstar**cmx(i)
C
   60 ce=one
C
      epd(i)=off(i)* max(   abs(d1(i)),   abs(d2(i)),   abs(d3(i)),
     .             half*abs(d4(i)),.5*abs(d5(i)),.5*abs(d6(i)))
C----------------------------------------------------------
      IF(epd(i)<=epdr(i)) GOTO 70
      ce=one + cc(i) * log(epd(i)/epdr(i))
C
   70 ch=ca(i)
      IF(epxe(i)<=zero) GOTO 80
      ch=ca(i)+cb(i)*epxe(i)**cn(i)
      IF(epxe(i)>epmx(i)) ch=ca(i)+cb(i)*epmx(i)**cn(i)
C
   80 ak(i)= min(sigmx(i),ch)*ce*ct
C-----------------------
C     MODULE ECROUISSAGE
C-----------------------
      IF(cn(i)>=1) THEN
       qh(i)= (cb(i)*cn(i)*epxe(i)**(cn(i)-one))*ce*ct
      ELSE
       IF(epxe(i)/=zero)THEN
        qh(i)= (cb(i)*cn(i)/epxe(i)**(one-cn(i)))*ce*ct
       ELSE
       qh(i)=zero
       ENDIF
      ENDIF
   90 CONTINUE
C
      DO 110 i=1,nel
      IF(theta(i)>=tmelt(i)) GOTO 100
      IF(aj2(i)<=ak(i))      GOTO 110
C
      scale=zero
      IF(aj2(i)/=zero) scale=ak(i)/aj2(i)
      sig(i,1)=scale*sig(i,1)
      sig(i,2)=scale*sig(i,2)
      sig(i,3)=scale*sig(i,3)
      sig(i,4)=scale*sig(i,4)
      sig(i,5)=scale*sig(i,5)
      sig(i,6)=scale*sig(i,6)
      epxe(i)=epxe(i)+(one-scale)*aj2(i)/(three*g(i)+qh(i))
      GOTO 110
C
  100 ak(i)=zero
      epxe(i)=zero
      sig(i,1)=zero
      sig(i,2)=zero
      sig(i,3)=zero
      sig(i,4)=zero
      sig(i,5)=zero
      sig(i,6)=zero   
C
  110 CONTINUE
      RETURN