mtheta.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	mtheta (pm, eint, theta, amu, c1, c2, df, psh, pc, mat, nel)

Function/Subroutine Documentation

mtheta()

subroutine mtheta	(		pm,
			eint,
			theta,
			amu,
			c1,
			c2,
			df,
			psh,
			pc,
		integer, dimension(*)	mat,
		integer, intent(in)	nel )

Definition at line 28 of file mtheta.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER MAT(*)
C     REAL
      my_real
     .   pm(npropm,*), eint(*), theta(*),
     .   amu(*), c1(*), c2(*), df(*), psh(*), pc(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,MX
      my_real eint0, sph, dmu, plim, c2mu, c1psh, ecold      
C=======================================================================
      mx = mat(1)
      DO i=1,nel
       sph     =pm(69,mx)
       eint0   =pm(23,mx)
       theta(i)=pm(79,mx)
       plim    =pc(i)-c1(i)-psh(i)
       IF(c2(i)>abs(plim/ep36))THEN
         dmu = min(amu(i)-plim/c2(i),zero)
       ELSE
         dmu =zero
       ENDIF
C
       c2mu    =c2(i)*amu(i)
       c1psh   =c1(i)+psh(i)
C              ENERGIE ELASTIQUE
       ecold   =(c1psh + half*c2mu)*amu(i)
C              ENERGIE DE RUPTURE EN TRITENSION (OU CAVITATION)
C              HYP: NE CREEE PAR D'ECHAUFFEMENT
       ecold   =ecold + half*dmu*(c1psh+c2mu-pc(i))
C              ENERGIE INITIALE
       ecold   =ecold+eint0
       theta(i)=theta(i) + (eint(i)*df(i)-ecold)/sph
      ENDDO
c-----------
      RETURN