m16law.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	m16law (pm, off, sig, nel, epxe, theta, epd, xist, mat, d1, d2, d3, d4, d5, d6, pold)

Function/Subroutine Documentation

m16law()

subroutine m16law	(		pm,
			off,
			sig,
		integer	nel,
			epxe,
			theta,
			epd,
			xist,
		integer, dimension(*)	mat,
			d1,
			d2,
			d3,
			d4,
			d5,
			d6,
			pold )

Definition at line 28 of file m16law.F.

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), epxe(*), theta(*),
     .   epd(*), xist(*), d1(*), d2(*),
     .   d3(*), d4(*), d5(*), d6(*), pold(*)
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), 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(mvsiz), dpla(mvsiz)
C------------------------------------------------------------------------------------------
      mx = mat(1)
      DO i=1,nel
        g(i)    =pm(22,mx)*off(i)
        ca(i)   =pm(38,mx)
        cb(i)   =pm(39,mx)
        cn(i)   =pm(40,mx)
        cc(i)   =pm(43,mx)
        cmx(i)  =pm(45,mx)
        tmelt(i)=pm(46,mx)
        epdr(i) =pm(44,mx)
        thetl(i)=pm(47,mx)
        epmx(i) =pm(41,mx)
        sigmx(i)=pm(42,mx)
      ENDDO
C
      DO i=1,nel
        pold(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)
      ENDDO
C-------------------------------
C     CONTRAINTES DEVIATORIQUES
C-------------------------------
      DO i=1,nel
        sig(i,1)=sig(i,1)+pold(i)+g2(i)*(d1(i)+dav(i))
        sig(i,2)=sig(i,2)+pold(i)+g2(i)*(d2(i)+dav(i))
        sig(i,3)=sig(i,3)+pold(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)
        sig(i,6)=sig(i,6)+g1(i)*d6(i)
      ENDDO
C
      DO 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
        aj2(i)=sqrt(three*aj2(i))
      ENDDO
C
      DO i=1,nel
        IF(theta(i)>=tmelt(i)) cycle
C
        tstar=zero
        ct=one
        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)),half*abs(d5(i)),half*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
        ELSEIF(epxe(i)/=zero)THEN
          qh(i)= (cb(i)*cn(i)/epxe(i)**(one-cn(i)))*ce*ct
        ELSE
          qh(i)=zero
        ENDIF
C-------------------------------
C     PROJECTION
C-------------------------------
        IF(aj2(i)<=ak(i)) THEN
          scale(i)=one
        ELSEIF(aj2(i)/=zero) THEN
          scale(i)=ak(i)/aj2(i)
        ELSE
          scale(i)=zero
        ENDIF
      ENDDO
C
      DO i=1,nel
        IF(theta(i)>=tmelt(i) .OR. xist(i)/=zero) THEN
          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    
        ELSEIF(aj2(i)>ak(i)) THEN
          dpla(i)=(one -scale(i))*aj2(i)/(three*g(i)+qh(i))
          ak(i)=ak(i)+dpla(i)*qh(i)
          scale(i)= min(one,ak(i)/ max(aj2(i),em15))
          sig(i,1)=scale(i)*sig(i,1)
          sig(i,2)=scale(i)*sig(i,2)
          sig(i,3)=scale(i)*sig(i,3)
          sig(i,4)=scale(i)*sig(i,4)
          sig(i,5)=scale(i)*sig(i,5)
          sig(i,6)=scale(i)*sig(i,6)
          epxe(i)=epxe(i)+dpla(i)
          epxe(i)=epxe(i)*off(i)
        ENDIF
      ENDDO
C
      RETURN