law88_upd.F File Reference

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

Go to the source code of this file.

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

Function/Subroutine Documentation

law88_upd()

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

Definition at line 37 of file law88_upd.F.

      USE message_mod
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
      INTEGER ,INTENT(IN) :: NFUNC
      INTEGER ,INTENT(IN) :: NFUNCT
      INTEGER NPC(*), FUNC_ID(NFUNCT),IFUNC(NFUNC)
      my_real uparam(*),pld(*)
      my_real , DIMENSION(NPROPM), INTENT(INOUT) :: pm
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,FUNC,FUND,PN,IOK,NL,IUNL_FOR,ICASE,NV,
     .  IC1,IC2,NOGD,II,JJ,ICHECK,ITENS
      my_real kc,kt,kfc,kft,gmax,deri,stiff,stiffmin,stiffini, 
     .  stiffmax,stiffavg,xint1,yint1,xint2,yint2,fac,fac1,fac2,
     .  dx,dy, xinc,yinc,xint,yint
      my_real 
     .     emax, emin,eini,scalefac,e0,ec_max,nu,gs
      my_real , DIMENSION(:), ALLOCATABLE :: stress,stretch
C=======================================================================
C----------------------------
       DO j = 1, nfunc
         k = ifunc(j) 
         ic1  =  npc(k)
         ic2  =  npc(k+1)
         nogd =  (ic2-ic1)/2
         ALLOCATE (stretch(nogd), stress(nogd))   
         jj = 0       
         icheck = 0
         DO ii = ic1,ic2-2,2                                 
              jj=jj+1                                        
              stretch(jj) = pld(ii) + one                     
              stress(jj)  = pld(ii + 1)   
                IF(pld(ii) <=  - one) THEN
                  CALL ancmsg(msgid=3085,
     .                         msgtype=msgwarning,
     .                         anmode=aninfo,
     .                         i1=mat_id,
     .                         c1=titr,
     .                         i2=func_id(k)) ! Id_function
              ENDIF
              !! check if the curve don't have (0,0) point.
              IF( pld(ii) == zero .AND. pld(ii + 1) == zero )icheck = 1
         ENDDO 
         IF(icheck == 0 ) THEN
                              ! Error message
                 CALL ancmsg(msgid=1896,
     .                           msgtype=msgerror,
     .                           anmode=aninfo,
     .                           i1=mat_id,
     .                           c1=titr,
     .                           i2=func_id(k)) ! Id_function
                   CALL arret(2)
         ENDIF            
C  check if the curve is monotonic
         DO jj =1,nogd - 1                                
           dx = stretch(jj + 1) - stretch(jj)               
           dy = stress(jj  + 1) - stress(jj) 
           IF(dx * dy < zero) THEN            
             CALL ancmsg(msgid=1176,                     
     .              msgtype=msgerror,                  
     .              anmode=aninfo,                     
     .              i1=mat_id,                         
     .              c1=titr,                           
     .              i2=func_id(k))  
           ENDIF                                    
         ENDDO                              
          DEALLOCATE( stretch,stress)   
        ENDDO ! NFUNC   
c
c       Intersection - quasistatic curve and unloading curve but is not used 
c
        nl = int(uparam(4))
        iunl_for = nint(uparam(5))
        itens    = nint(uparam(8))
        icase    = nint(uparam(9))
        nv = 9 + 2*nfunc
c
        xinc = zero
        yinc = zero
        xint = zero
        yint = zero
        func = ifunc(1)
        IF(nfunc > nl ) THEN
           fund = ifunc(nl + 1)
           fac1 = uparam(11  )
           fac2 = uparam(11 + 2*nl  )
C intersection pt of tension if existing
           uparam(nv + 1) = 0  ! not existing
           IF(func /= 0 .AND. fund /= 0) THEN
               CALL func_inters(titr   ,mat_id ,func   ,fund   ,fac1   ,
     .                            fac2   ,npc    ,pld    ,xint  ,yint  )
               uparam(nv + 2) = xint   
               uparam(nv + 3) = yint
               IF(xint*yint /= zero)uparam(nv + 1) = 1 ! only tension 
C intersection pt of compression if existing 
               CALL func_inters_c(titr   ,mat_id ,func   ,fund   ,fac1   ,
     .                            fac2   ,npc    ,pld    ,xinc  ,yinc  )
               uparam(nv + 4) = xinc   
               uparam(nv + 5) = yinc
               IF(xinc*yinc /= zero ) THEN
                  IF(int(uparam(nv + 1)) == 0 )THEN
                     uparam(nv + 1) = -1  ! only compression 
                   ELSE  
                      uparam(nv + 1) = 2  ! tension & compression
                   ENDIF
               ENDIF
           ENDIF  
        ENDIF 
        WRITE(iout,1000)
        IF(xint*yint > zero) WRITE(iout,1600) xint,yint
        IF(xinc*yinc > zero) WRITE(iout,1700) xinc,yinc
C-----check E_MAX        
           emax = zero
           emin = ep20
           eini = zero
          DO j = 1, nfunc 
              scalefac= uparam(9 + 2*j )  
              CALL func_slope(ifunc(j),scalefac,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)  
              emax = max(emax,  stiffmax )
              emin = min(emin,  stiffmin)
              eini = max(eini, stiffini)
          ENDDO ! NFUNC 
          nu =uparam(2)
          gs =uparam(3)
          e0 = two*gs*(one + nu)
          ec_max = max(e0,emax)
          pm(24) = ec_max
          WRITE(iout,1003) ec_max    
c----- ------
 1000 FORMAT
     & (5x,'TABULATED OGDEN LAW',/,
     &  5x,'-------------',//)
 1600 FORMAT
     & (5x,  'STRAIN TENSION OF INTERSECTION PT BETWEEN QUASISTAIC AND UNLOADING CURVES. . . . .  . . .=',1pg20.13/
     & ,5x,  'STRESS TENSION OF INTERSECTION PT BETWEEN QUASISTAIC AND UNLOADING CURVES. . . . . . . . =',1pg20.13//)
     
 1700 FORMAT
     & (5x,  'STRAIN COMPRESSION OF INTERSECTION PT BETWEEN QUASISTAIC AND UNLOADING CURVES. . . . .  . . .=',1pg20.13/
     & ,5x,  'STRESS COMPRESSION OF INTERSECTION PT BETWEEN QUASISTAIC AND UNLOADING CURVES. . . . . . . . =',1pg20.13//)
 1003   FORMAT(
     & 5x,'YOUNG''S MODULUS FOR HG COMPUTE . . . .=',1pg20.13/)
      RETURN