law36_upd.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	law36_upd (iout, titr, mat_id, nuparam, uparam, nfunc, ifunc, func_id, npc, pld, mtag, nfunct)

Function/Subroutine Documentation

law36_upd()

subroutine law36_upd	(	integer, intent(in)	iout,
		character(len=nchartitle)	titr,
		integer, intent(in)	mat_id,
		integer, intent(in)	nuparam,
			uparam,
		integer, intent(in)	nfunc,
		integer, dimension(nfunc)	ifunc,
		integer, dimension(nfunct)	func_id,
		integer, dimension(*)	npc,
			pld,
		type(mlaw_tag_), intent(inout)	mtag,
		integer, intent(in)	nfunct )

Definition at line 35 of file law36_upd.F.

C----------------------------------------------- 
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE table_mod
      USE elbuftag_mod
      USE names_and_titles_mod , ONLY : nchartitle
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-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: MAT_ID,IOUT,NUPARAM
      INTEGER ,INTENT(IN) :: NFUNC    ! number of functions defined in the law
      INTEGER ,INTENT(IN) :: NFUNCT   ! total number of functions in the system
      INTEGER, DIMENSION(NFUNC)  :: IFUNC
      INTEGER, DIMENSION(NFUNCT) :: FUNC_ID
      INTEGER NPC(*)
      my_real uparam(nuparam),pld(*)
      CHARACTER(LEN=NCHARTITLE)  :: TITR
      TYPE(MLAW_TAG_),INTENT(INOUT)   :: MTAG
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I,J,IFE,IE,IX1,IX2,IY1,IY2,NRATE,IYLD,IFAIL,FUNC1,FUNC2
      my_real :: epsmax,epslast,x1,x2,y1,y2,fac1,fac2,xint,yint
C==================================================================== 
c     Check if scale factor function of Young modulus is decreasing with plastic strain   
c    
      ife = ifunc(nfunc)                   
      IF (ife > 0) THEN 
        ie  = npc(ife)                                                       
        iy2 = npc(ife+1)                                                     
        DO i = ie+1,iy2-3,2                                                  
          IF (pld(i) < pld(i+2)) THEN                                       
             CALL ancmsg(msgid=975, msgtype=msgerror, anmode=aninfo,        
     .            i1 = func_id(nfunc),                                               
     .            c1 = titr   )                                               
             EXIT                                                           
          ENDIF                                                             
        ENDDO                                                                
      ENDIF                                      
c    
c     Check if static yield function decreases to zero (last point or negative slope)
c     In this case we introduce failure at the plastic strain corresponding to sig_yld=0
c  
      nrate  = nint(uparam(1))
      epsmax = uparam(2*nrate + 7)
      ifail  = nint(uparam(2*nrate + 27))
      iyld = ifunc(1)
      ix1  = npc(iyld+1) - 4                                     
      iy1  = npc(iyld+1) - 3                                     
      iy2  = npc(iyld+1) - 1                                     
      ix2  = npc(iyld+1) - 2
      x1 = pld(ix1)                                    
      x2 = pld(ix2)                                    
      y1 = pld(iy1)                                    
      y2 = pld(iy2)                                    
      IF (ix2 > zero .and. y2 == zero) THEN  ! last value of yield curve is 0
        epslast = x2
        epsmax  = uparam(7+2*nrate)
        IF (epslast < epsmax) uparam(2*nrate + 7 ) = epslast
        IF (ifail == 0)       uparam(2*nrate + 27) = 1    ! IFAIL
        uparam(2*nrate + 28) = 1    ! YLDCHECK
        mtag%G_DMG = 1
        mtag%L_DMG = 1        
      ELSE IF (y1 > y2) THEN                 ! yield function slope is negative 
        epslast = (x2*y1 - x1*y2) / (y1 - y2)
        IF (epslast < epsmax) uparam(2*nrate + 7 ) = epslast
        IF (ifail == 0)       uparam(2*nrate + 27) = 1    ! IFAIL
        uparam(2*nrate + 28) = 1    ! YLDCHECK
        mtag%G_DMG = 1
        mtag%L_DMG = 1        
      ENDIF                                      
c-----------------------------------------------------------------------    
c     Check if yield curves for different strain rates do not intersect
c-----------------------------------------------------------------------
      DO i = 1,nrate
        func1 = ifunc(i)
        fac1  = uparam(nrate + 6 + i)
        DO j = i+1,nrate
          func2 = ifunc(j)
          fac2  = uparam(nrate + 6 + j)
          IF (func1 > 0 .and. func2 > 0 .and. func1 /= func2) THEN
            CALL func_inters(titr,mat_id,func1 ,func2 ,fac1 ,fac2 ,
     .                 npc ,pld   ,xint ,yint )
c
            IF (xint > zero .and. yint > zero) THEN
              CALL ancmsg(msgid=2064, msgtype=msgwarning, anmode=aninfo,        
     .                    i1 = mat_id,                                               
     .                    i2 = func_id(func1),                                               
     .                    i3 = func_id(func2),                                               
     .                    c1 = titr   )
            END IF
          END IF
        END DO                                                      
      END DO
c--------------------------------------------------------
      RETURN