law92_upd.F File Reference

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

Go to the source code of this file.

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

Function/Subroutine Documentation

law92_upd()

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

Definition at line 35 of file law92_upd.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE law92_nlsqf_mod
      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
      INTEGER ,INTENT(IN) :: NFUNC
      INTEGER ,INTENT(IN) :: NFUNCT
      INTEGER NPC(*), FUNC_ID(NFUNCT), 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 K,ITEST,II,JJ,NSTART,IC1,IC2,NOGD,NDATA,NMULA,IFC
      my_real nu,gs,rbulk,d,young,errtol,ave_slope,mu,mu_max,mu_min,dx,
     .   lam,beta,lam_max,lam_min,scalefac,amula(2)
      my_real , DIMENSION(:), ALLOCATABLE :: stress,stretch!      
      LOGICAL  IS_ENCRYPTED         
C==================================================================== 
!       IDENTIFICATION
!====================================================================
       is_encrypted = .false.
       CALL hm_option_is_encrypted(is_encrypted)
  !!
       nstart = 2
       errtol = fiveem3   
       ifc = ifunc(1)
       ic1 = npc(ifc)
       ic2 = npc(ifc+1)
       scalefac =  uparam(14)
       nogd=(ic2-ic1)/2
       ndata=nogd
c
       ALLOCATE (stretch(nogd))                              
       ALLOCATE (stress(nogd))                               
c
       ave_slope = zero
       jj=0                                                  
       stretch=zero                                          
       stress=zero                                           
       mu=zero                                               
       rbulk=zero                                            
       gs=zero                                               
       lam_max= zero                                         
       lam_min= zero                                         
c
       DO ii = ic1,ic2-2,2                                   
            jj=jj+1                                          
            stretch(jj) = pld(ii) + one                       
            stress(jj)  = scalefac *  pld(ii+1)                          
            lam_max = max(lam_max, abs(stretch(jj)))         
       ENDDO                                                 
c
       nogd = jj                                             
       mu_max = zero                                          
       mu_min = 1e20                                          
       DO k = 1, ndata                                        
        dx = stretch(k) - one                                  
c       avolid dx to be too small                             
        IF (dx >= zero) THEN                                  
          dx = max(dx, em6)                                   
        ELSE                                                  
            dx = abs(dx)                                      
        ENDIF                                                 
        mu_max = max(mu_max, stress(k)  / dx)                
        ave_slope = ave_slope + abs(stress(k))  / dx          
       ENDDO                                                   
c
       ave_slope = ave_slope / (one * ndata)                  
       mu= ave_slope                                           
c      initial value  
       lam = max(seven,three*lam_max)         
C                                            
       nmula  = 2                            
       amula(1) = max(mu,mu_max)             
       amula(2) = lam                        
       itest  =  uparam(12) 
      !----------------       
        IF(is_encrypted)THEN
          WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
       ELSE 
         WRITE(iout,1000)    
         WRITE(iout,1001)trim(titr),mat_id
       ENDIF  
      !----        
c------------------------------------------------------
       CALL law92_nlsqf(stretch,stress,nmula,nogd,amula,
     .                   nstart, errtol,mat_id,titr,itest)
c------------------------------------------------------
        DEALLOCATE (stretch)                                                 
        DEALLOCATE (stress)                                                  
        nu  = uparam(11)                                             
        mu  = amula(1)                                                       
        lam = amula(2)                                                       
        beta = one/lam/lam
        gs = mu*(one +  three*beta /five + eighty19*beta*beta/175. 
     .         + 513.*beta**3/875. + 42039.*beta**4/67375.) 
        rbulk=two*gs*(one+nu)                                               
     .        /max(em30,three*(one-two*nu))                                  
        d= two/rbulk                                                        
        uparam(1)=mu                                                  
        uparam(2)=d                                                   
        uparam(3)=lam 
        uparam(4)=gs                                                  
        uparam(5)=rbulk       
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(.NOT.is_encrypted) WRITE(iout,1100)mu,d,lam,gs,rbulk
c----------------
c     end of optimization loop
c----------------
      RETURN
c----------------
 1000 FORMAT
     & (//5x, 'FITTED PARAMETERS FOR HYPERELASTIC_MATERIAL LAW92 ' ,/,
     &    5x, ' --------------------------------------------------')
 1001 FORMAT(
     & 5x,a,/,
     &    5x, 'MATERIAL NUMBER =',i10,//)
 1100 FORMAT(
C
     & 5x,'ARRUDA-BOYCE LAW',/,
     & 5x,'MU . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
     & 5x,'D. . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
     & 5x,'LAM. . . . . . . . . . . . . . . . . . . .=',1pg20.13/
     & 5x,'INITIAL SHEAR MODULUS. . . . . . . . . . .=',1pg20.13/
     & 5x,'BULK MODULUS . . . . . . . . . . . . . . .=',1pg20.13//)
c-----------
      RETURN