law111_upd.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	law111_upd (iout, titr, mat_id, uparam, nfunc, ifunc, func_id, npc, pld, pm, ipm)

Function/Subroutine Documentation

law111_upd()

subroutine law111_upd	(	integer	iout,
		character(len=nchartitle)	titr,
		integer	mat_id,
			uparam,
		integer	nfunc,
		integer, dimension(nfunc)	ifunc,
		integer, dimension(*)	func_id,
		integer, dimension(*)	npc,
			pld,
			pm,
		integer, dimension(npropmi)	ipm )

Definition at line 36 of file law111_upd.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE table_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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      CHARACTER(LEN=NCHARTITLE)  :: TITR
      INTEGER MAT_ID,IOUT, NFUNC
      INTEGER NPC(*), FUNC_ID(*), IPM(NPROPMI)
      my_real uparam(*),pld(*),pm(npropm)
      INTEGER, DIMENSION(NFUNC):: IFUNC
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N,K,ITEST,II,JJ,NSTART,IC1,IC2,NOGD,NDATA,NMULA,IFC,ICRYPT,
     .        ICHECK,NCOMP
      my_real e,nu,gs,rbulk,d,young,errtol,ave_slope,mu,mu_max,mu_min,dx,
     .   scalefac,stiffmin,stiffmax,stiffini,stfavg
      my_real , DIMENSION(:), ALLOCATABLE :: stress,stretch
C==================================================================== 
!       IDENTIFICATION
!====================================================================
       icrypt = 0    !
       nstart = 2
       errtol = fiveem3   
       ifc = ifunc(1)
       ic1 = npc(ifc)
       ic2 = npc(ifc + 1)
       scalefac =  uparam(3)
       nogd=(ic2-ic1)/2
       ndata=nogd   
C
C  !! check if the curve don't have (0,0) point.
C        
         icheck = 0
         ncomp  = 0
         DO jj = ic1,ic2 - 4,2
              IF (pld(jj) == zero .AND. pld(jj + 1) == zero )icheck = 1
              IF (pld(jj) <  zero ) ncomp = ncomp + 1
         ENDDO 
         IF (icheck == 0 ) THEN
                              ! Error message
                 CALL ancmsg(msgid=1896,
     .                           msgtype=msgerror,
     .                           anmode=aninfo,
     .                           i1=mat_id,
     .                           c1=titr,
     .                           i2=func_id(ifc)) ! Id_function
                   CALL arret(2)
         ENDIF               
!!         IF (NCOMP == 0 ) THEN   ! No curve definition in compression => warning
!!                 CALL ANCMSG(MSGID=1917,
!!     .                       MSGTYPE=MSGWARNING,
!!     .                       ANMODE=ANINFO,
!!     .                       I1=MAT_ID,
!!     .                       C1=TITR,
!!     .                       I2=FUNC_ID(IFC)) ! Id_function
!!         ENDIF               
c
       ALLOCATE (stretch(nogd))                              
       ALLOCATE (stress(nogd))                               
c
       ave_slope = zero
       jj=0                                                  
       stretch=zero                                          
       stress=zero                                           
       mu=zero                                               
       rbulk=zero                                            
       gs=zero                           
c    
       CALL func_slope(ifunc(1),scalefac,npc,pld,stiffmin,stiffmax,stiffini,stfavg) 
C                                                                                        
        nu  = uparam(1)                                             
        !!GS  = STIFFMAX  
        gs  = stiffini 
C        
        rbulk=two*gs*(one+nu)                                               
     .        /max(em30,three*(one-two*nu)) 
        uparam(4) = gs                                                  
        uparam(5) = rbulk
        uparam(6) = uparam(4)
        IF(ncomp == 0) uparam(7) = 1  
!!        UPARAM(6)=TWO*STIFFMIN*(ONE+NU)
!!     .        /MAX(EM30,THREE*(ONE-TWO*NU))
c       parameters    
        young  = two*gs*(one + nu)               
        pm(20) = young                      
        pm(21) = nu                         
        pm(22) = gs                         
        pm(24) = young/(one - nu**2)         
        pm(32) = rbulk                      
        pm(100) = rbulk  !PARMAT(1) 
C-----------
C     Formulation for solid elements time step computation.
        ipm(252)= 2
        pm(105) = two*gs/(rbulk + four_over_3*gs)        
C                          
        IF (icrypt == 0) THEN
          WRITE(iout,1000)
          WRITE(iout,1100)gs,rbulk
        ENDIF
c----------------
c     end of optimization loop
c----------------
      RETURN
c----------------
 1000 FORMAT
     & (//5x, ' PARAMETERS FOR HYPERELASTIC_MATERIAL LAW111 ' ,/,
     &    5x, ' --------------------------------------------------')
 1100 FORMAT(
C
     & 5x,'MARLOW LAW',/,
     & 5x,'INITIAL SHEAR MODULUS. . . . . . . . . . .=',1pg20.13/
     & 5x,'BULK MODULUS . . . . . . . . . . . . . . .=',1pg20.13//)
c-----------
      RETURN