s4voln_m.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "scr18_c.inc"
#include "scr05_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s4voln_m (sfem_nodvar, nc1, nc2, nc3, nc4, mat, offg, rho, rho0, fxx, fxy, fxz, fyx, fyy, fyz, fzx, fzy, fzz, vol0, voln, vol0dp, voldp, amu0, dxx, dyy, dzz, matparam, nel, ismstr, s_sfem_nodvar)

Function/Subroutine Documentation

s4voln_m()

subroutine s4voln_m	(	dimension(s_sfem_nodvar), intent(inout)	sfem_nodvar,
		integer, dimension(*)	nc1,
		integer, dimension(*)	nc2,
		integer, dimension(*)	nc3,
		integer, dimension(*)	nc4,
		integer, dimension(*)	mat,
			offg,
			rho,
			rho0,
			fxx,
			fxy,
			fxz,
			fyx,
			fyy,
			fyz,
			fzx,
			fzy,
			fzz,
			vol0,
			voln,
		double precision, dimension(*)	vol0dp,
		double precision, dimension(*)	voldp,
			amu0,
			dxx,
			dyy,
			dzz,
		type(matparam_struct_), dimension(nummat)	matparam,
		integer	nel,
		integer, intent(in)	ismstr,
		integer, intent(in)	s_sfem_nodvar )

Definition at line 32 of file s4voln_m.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE matparam_def_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER NC1(*),NC2(*),NC3(*),NC4(*),MAT(*),NEL
      INTEGER,INTENT(IN) :: S_SFEM_NODVAR
      my_real :: offg(*),vol0(*),amu0(*),
     .           dxx(*),dyy(*),dzz(*),voln(*),
     .           fxx(*), fxy(*), fxz(*),
     .           fyx(*), fyy(*), fyz(*),
     .           fzx(*), fzy(*), fzz(*),
     .           rho(*),rho0
      my_real,INTENT(INOUT) :: sfem_nodvar(s_sfem_nodvar)
      TYPE(MATPARAM_STRUCT_), DIMENSION(NUMMAT) :: MATPARAM
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr18_c.inc"
#include      "scr05_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,MX
      my_real amu(mvsiz), sum,dtr,dtrep_r,divde(mvsiz),jac_m(mvsiz),jac(mvsiz),fac,base,jfac,dvdp
      DOUBLE PRECISION VOL0DP(*),VOLDP(*),SUMDP
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      mx = mat(1)
      IF(ismstr == 1 .OR. ismstr == 11)THEN
        IF (tt==zero) THEN
          DO i=1,nel
           IF(offg(i) == zero) cycle
           amu0(i) = rho(i)/rho0-one
          ENDDO
        ELSE
          DO i=1,nel
           IF(offg(i) == zero) cycle
           sum=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
           amu(i) = four/sum -one
           divde(i) = amu0(i)-amu(i)
           dtr=divde(i)/dt1             
           dtrep_r = third*(dtr-dxx(i)-dyy(i)-dzz(i))
           dxx(i) = dxx(i) + dtrep_r
           dyy(i) = dyy(i) + dtrep_r
           dzz(i) = dzz(i) + dtrep_r 
           amu0(i)= rho(i)/rho0-one-divde(i)
          ENDDO
        END IF
      ELSE
c-------------------------------------------------------------------------
        IF(iresp == 1)THEN
          DO i=1,nel
           IF(offg(i) == zero .OR. abs(offg(i)) > one) cycle
           sumdp=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
           voldp(i) = fourth*sumdp*vol0dp(i) 
           voln(i) = voldp(i)
          ENDDO
        ELSE
          DO i=1,nel
           IF(offg(i) == zero .OR. abs(offg(i)) > one) cycle
           sum=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
           voln(i)=fourth*sum*vol0(i) 
          ENDDO
        END IF            
        IF (matparam(mx)%STRAIN_FORMULATION == 1) THEN
C------compute AMU(t+dt) for large strain   
          IF(iresp == 1)THEN
            amu(1:nel) = vol0dp(1:nel)/voldp(1:nel) - one
          ELSE
            amu(1:nel) = vol0(1:nel)/voln(1:nel) - one
          END IF
          IF (tt == zero) THEN
            amu0(1:nel) = amu(1:nel)
          ELSE          
            DO i = 1,nel
              IF(offg(i)==zero.OR.abs(offg(i))>one) cycle
              dtr   = (dxx(i) + dyy(i) + dzz(i))*dt1
              dtrep_r = third*((amu(i)-amu0(i))+dtr)/dt1
              dxx(i) = dxx(i) - dtrep_r
              dyy(i) = dyy(i) - dtrep_r
              dzz(i) = dzz(i) - dtrep_r  
              amu0(i) = amu(i)
            ENDDO
          END IF            
        ENDIF
        IF(ismstr >= 10)THEN
           DO i=1,nel
            IF(offg(i)==zero) cycle
            jac_m(i)=voln(i)/vol0(i)             
           ENDDO
        ENDIF
        IF((ismstr == 2.OR.ismstr == 12).AND.idtmin(1) == 3) THEN
          IF (tt==zero) THEN
            DO i=1,nel
             IF(offg(i)==zero) cycle
             amu0(i) = rho(i)/rho0-one
            ENDDO
          ELSE
            DO i=1,nel
             IF(offg(i) == zero .OR. abs(offg(i)) <= one) cycle
             sum=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
             amu(i) = four/sum -one
             divde(i) = amu0(i)-amu(i)
             dtr=divde(i)/dt1             
             dtrep_r = third*(dtr-dxx(i)-dyy(i)-dzz(i))
             dxx(i) = dxx(i) + dtrep_r
             dyy(i) = dyy(i) + dtrep_r
             dzz(i) = dzz(i) + dtrep_r  
             dvdp = divde(i)*(vol0(i)/voln(i))
             amu0(i)= rho(i)/rho0-one-dvdp
            ENDDO
C for total strain modif in the next
            IF(iresp == 1 .AND. ismstr == 12)THEN
              DO i=1,nel
               IF(offg(i) == zero .OR. abs(offg(i)) <= one) cycle
               dvdp = divde(i)*(vol0(i)/voln(i))
               amu0(i) = vol0dp(i)/voldp(i)-one-dvdp
              ENDDO
            END IF
          END IF !(TT==ZERO) THEN
         ENDIF
      ENDIF
C--------total strain modif      
       IF (ismstr == 11) THEN
C---- modify Dii w/ rho/rho_0       
        DO i=1,nel
          dtrep_r = -third*(amu0(i)+fxx(i)+fyy(i)+fzz(i))
          fxx(i) = fxx(i) + dtrep_r
          fyy(i) = fyy(i) + dtrep_r
          fzz(i) = fzz(i) + dtrep_r 
        ENDDO
       ELSEIF(ismstr >= 10) THEN
        DO i=1,nel
          IF(abs(offg(i))<=one) cycle
          dtrep_r = -third*(amu0(i)+fxx(i)+fyy(i)+fzz(i))
          fxx(i) = fxx(i) + dtrep_r
          fyy(i) = fyy(i) + dtrep_r
          fzz(i) = fzz(i) + dtrep_r 
        ENDDO
        CALL jacob_j33(
     1   jac,     fxx,     fxy,     fxz,
     2   fyx,     fyy,     fyz,     fzx,
     3   fzy,     fzz,     nel)
C
        fac=third
        DO i=1,nel
         IF(abs(offg(i)) > one) cycle
         base = jac_m(i)/max(em20,jac(i))
         jfac =exp(fac*log(max(em20,base)))
         fxx(i) = jfac*fxx(i)+jfac-one
         fyy(i) = jfac*fyy(i)+jfac-one
         fzz(i) = jfac*fzz(i)+jfac-one
         fxy(i) = jfac*fxy(i)
         fyx(i) = jfac*fyx(i)
         fzx(i) = jfac*fzx(i)
         fxz(i) = jfac*fxz(i)
         fyz(i) = jfac*fyz(i)
         fzy(i) = jfac*fzy(i)
        ENDDO
       END IF
      RETURN