law158_upd.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	law158_upd (mat_param, titr, npc, pld, nfunc, nfunl, ifunc, mat_id, func_id, pm, sensors)

Function/Subroutine Documentation

law158_upd()

subroutine law158_upd	(	type(matparam_struct_), intent(inout)	mat_param,
		character(len=nchartitle), intent(in)	titr,
		integer, dimension(snpc), intent(in)	npc,
		intent(in)	pld,
		integer, intent(in)	nfunc,
		integer, intent(in)	nfunl,
		integer, dimension(nfunc+nfunl), intent(inout)	ifunc,
		integer, intent(in)	mat_id,
		integer, dimension(nfunc), intent(in)	func_id,
		intent(out)	pm,
		type (sensors_), intent(in)	sensors )

Definition at line 35 of file law158_upd.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE table_mod
      USE sensor_mod
      USE matparam_def_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-----------------------------------------------
#include      "param_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      CHARACTER(LEN=NCHARTITLE)       ,INTENT(IN)    :: TITR
      INTEGER                         ,INTENT(IN)    :: MAT_ID,NFUNC,NFUNL
      INTEGER ,DIMENSION(NFUNC)       ,INTENT(IN)    :: FUNC_ID
      INTEGER ,DIMENSION(NFUNC+NFUNL) ,INTENT(INOUT) :: IFUNC
      INTEGER ,DIMENSION(SNPC)        ,INTENT(IN)    :: NPC
      my_real ,DIMENSION(STF)         ,INTENT(IN)    :: pld
      my_real ,DIMENSION(NPROPM)      ,INTENT(OUT)   :: pm
      TYPE (SENSORS_)                 ,INTENT(IN)    :: SENSORS
      TYPE(MATPARAM_STRUCT_)          ,INTENT(INOUT) :: MAT_PARAM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ISENS,SENS_ID,FUNC
      my_real kcmax,ktmax,gmax,stiff,stiffmin,stiffini,stiffmax,stiffavg,
     .  yfac1,yfac2,yfac3,kflex1,kflex2
C=======================================================================
c     Transform FUNC_ID ->  Function number , leakmat only
c     NFUNL = IPM(6)     :  LEAK_MAT functions
c
      kcmax = zero
      IF (nfunl > 0) THEN
        CALL matfun_usr2sys(titr,mat_id,nfunl,ifunc(nfunc+1),func_id  )
      ENDIF
c---------------------------------------------------------------
      kflex1  = mat_param%UPARAM(6)
      kflex2  = mat_param%UPARAM(7)
      yfac1   = mat_param%UPARAM(12) 
      yfac2   = mat_param%UPARAM(13) 
      yfac3   = mat_param%UPARAM(14)
     
      sens_id = mat_param%IPARAM(1)
C----------------------------
C     SENSOR NUMBERING CHECK
C----------------------------
      isens   = 0
      IF (sens_id > 0 ) THEN
        DO i=1,sensors%NSENSOR
          IF (sens_id == sensors%SENSOR_TAB(i)%SENS_ID) THEN
            isens = i
            EXIT
          END IF
        ENDDO
        IF (isens == 0)  
     .    CALL ancmsg(msgid=1240,anmode=aninfo,msgtype=msgwarning,
     .          i1=mat_id,c1=titr,i2=isens) 
      ENDIF
      mat_param%IPARAM(1) = isens
c---------------------------------------------------------------
c
c     fiber stiffness dir1 (load) 
c
      func = ifunc(1)                                                            
      IF (func > 0 ) THEN       
                                                  
        CALL func_slope(func,yfac1,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
c
        IF (stiffmin <= zero) THEN
          CALL ancmsg(msgid=1581,msgtype=msgerror,anmode=aninfo_blind_2,
     .             i1=mat_id,
     .             i2=func_id(ifunc(1)),
     .             c1=titr)
        ENDIF
        kcmax = stiffmax
c        
      ENDIF
c
c     fiber stiffness dir2 (load) 
c
      func = ifunc(2)                                                            
      ktmax = zero
      IF (func > 0 ) THEN                                                         
        CALL func_slope(func,yfac2,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)    
c
        IF (stiffmin <= zero) THEN
          CALL ancmsg(msgid=1582 ,msgtype=msgerror,anmode=aninfo_blind_2,
     .             i1=mat_id,
     .             i2=func_id(ifunc(2)),
     .             c1=titr)
        ENDIF
        ktmax = stiffmax
      ENDIF
c
c     shear modulus  (load) 
c
      func = ifunc(3)                                                            
      gmax = zero
      IF (func > 0 ) THEN                                                         
        CALL func_slope(func,yfac3,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)    
c
        IF (stiffmin <= zero) THEN
          CALL ancmsg(msgid=1583 ,msgtype=msgerror,anmode=aninfo_blind_2,
     .             i1=mat_id,
     .             i2=func_id(ifunc(3)),
     .             c1=titr)
        ENDIF
        gmax  = stiffmax
      ENDIF                                       
c
c-------------------------------------------------
c     Flex stiffness dir1
c
      func = ifunc(4)                                                            
      IF (func > 0 )THEN                                                         
                                                      
        CALL func_slope(func,kflex1,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)    
c
        IF (stiffmin <= zero) THEN
          CALL ancmsg(msgid=1581 , msgtype=msgerror, anmode=aninfo_blind_2,
     .             i1=mat_id,
     .             i2=func_id(ifunc(4)),
     .             c1=titr)
        ENDIF
      ENDIF                                                                     
c
c     Flex stiffness dir2
c
      func = ifunc(5)                                                            
      IF (func > 0 )THEN                                                         
        CALL func_slope(func,kflex2,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)    
c
        IF (stiffmin <= zero) THEN
          CALL ancmsg(msgid=1582 , msgtype=msgerror, anmode=aninfo_blind_2,
     .             i1=mat_id,
     .             i2=func_id(ifunc(5)),
     .             c1=titr)
        ENDIF
      ENDIF                                                                     
c-----------
      stiff = max(kcmax,ktmax)
      mat_param%UPARAM(10) = stiff
      mat_param%UPARAM(11) = gmax
c-----------
      pm(20) = stiff        ! Stiffness contact
      pm(21) = zero         ! NU
      pm(22) = stiff*half   ! GMAX
      pm(23) = em01*stiffavg  ! Hourglass stiffness for QEPH
      pm(24) = stiff        ! Stiffness for time step computation
c-----------
      RETURN