condamage.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
c-----------------------------------------------
!||====================================================================
!||    condamage_mod   ../engine/source/materials/mat/mat190/condamage.F
!||--- called by ------------------------------------------------------
!||    sigeps190       ../engine/source/materials/mat/mat190/sigeps190.f
!||====================================================================
       MODULE condamage_mod
       CONTAINS 
!||====================================================================
!||    condamage               ../engine/source/materials/mat/mat190/condamage.F
!||--- called by ------------------------------------------------------
!||    sigeps190               ../engine/source/materials/mat/mat190/sigeps190.F
!||--- calls      -----------------------------------------------------
!||    table_mat_vinterp       ../engine/source/materials/tools/table_mat_vinterp.F
!||--- uses       -----------------------------------------------------
!||    table4d_mod             ../common_source/modules/table4d_mod.F
!||    table_mat_vinterp_mod   ../engine/source/materials/tools/table_mat_vinterp.F
!||====================================================================
        SUBROUTINE condamage 
     .         (zxx,zyy,zzz,zxy,zzx,zyz,
     .         damage,nel,hu,shape,whysmax,
     .         numtabl ,table,  nvartmp, vartmp)
c-----------------------------------------------
c     computation of damage for hsyteretic unloading
c      computes the damage for unloading at t(n+1)
c      ( new GL strains are used )
c-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
       USE table4d_mod
      USE table_mat_vinterp_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
#include      "scr05_c.inc"
#include      "impl1_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C      A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(IN) :: NEL ,NUMTABL,NVARTMP
        my_real ,INTENT(IN) ::  hu, shape  
        my_real, INTENT(IN) ,DIMENSION(NEL):: zxx ,zyy ,zzz ,zxy ,zzx ,zyz 
        TYPE (TABLE_4D_), DIMENSION(NUMTABL) ,TARGET  ::  TABLE
        my_real, INTENT(INOUT) ,DIMENSION(NEL) :: whysmax
        my_real, INTENT(OUT)   ,DIMENSION(NEL) :: damage
        INTEGER ,DIMENSION(NEL,NVARTMP) ,INTENT(INOUT) :: VARTMP
c-----------------------------------------------
        INTEGER I
        my_real,DIMENSION(NEL) ::  alambda1,alambda2,alambda3,z1,z2,z3,
     .                           fener1,dener1,fener2,dener2,fener3,dener3
        my_real
     .            ratio, whys(nel),epsilon(nel,3)
          
        my_real 
     .     ah1(nel),ah2(nel),ah3(nel),
     .     at2(nel),at3(nel),aa3(nel),aa2(nel)
        INTEGER  IPOS(NEL,1)
        my_real, DIMENSION(NEL,1)   :: xvec
        TYPE(table_4d_), POINTER :: FUNC_ENER , FUNC_SIG
c-----------------------------------------------
c-----------------------------------------------
      func_sig   => table(1)
      func_ener  => table(2)
 
      DO i=1,nel      
c       principal strains
c       note that these are not the same principal strains
c       that were computed in subroutine conversion since
c       we are now 1/2 timestep further
c
c       compute H1, H2 and H3
c
        ah1(i)=zxx(i)+zyy(i)+zzz(i)
        ah2(i)=zyy(i)*zzz(i)+zzz(i)*zxx(i)+zxx(i)*zyy(i)
     .        -zyz(i)**2-zzx(i)**2-zxy(i)**2
        ah3(i)=zxx(i)*zyy(i)*zzz(i)+two*zxy(i)*zyz(i)*zzx(i)
     .        -zxx(i)*zyz(i)**2-zyy(i)*zzx(i)**2-zzz(i)*zxy(i)**2
C
C       COMPUTE T2 AND T3
C
        at3(i)=two*ah1(i)**3/twenty7 - ah1(i)*ah2(i)/three + ah3(i)
        at2(i)=-ah2(i)+ah1(i)**2/three
        at2(i)=max(at2(i),em16)
C
C       COMPUTE COS(A)
C
        aa3(i)=at3(i)/two/sqrt(at2(i)**3/twenty7)
        aa3(i)=min(one,aa3(i)) 
        aa3(i)=max(-one,aa3(i)) 
        aa2(i)=sqrt(at2(i)/three)
C
C       COMPUTE PRINCIPAL STRAINS
C        
        z1(i)=two*aa2(i)*cos(third*acos(aa3(i))) 
        z2(i)=two*aa2(i)*cos(third*acos(aa3(i)) - two*pi/three) 
        z3(i)=two*aa2(i)*cos(third*acos(aa3(i)) - four*pi/three) 
C
C       ADD HYDROSTATIC PART 
C
        z1(i)=z1(i)+ah1(i)/three 
        z2(i)=z2(i)+ah1(i)/three
        z3(i)=z3(i)+ah1(i)/three  
C
      ENDDO
C
C     UPDATE IN THE PRINCIPAL SYSTEM AT T(N+1)
C
      DO i=1,nel
C
C       PRINCIPAL STRETCHES FROM PRINCIPAL GL STRAINS
C
        alambda1(i)=sqrt(two*z1(i) + one)
        alambda2(i)=sqrt(two*z2(i) + one)
        alambda3(i)=sqrt(two*z3(i) + one)
C
C       PRINCIPAL ENGINEERING STRAIN POSITIVE IN COMPRESSION
C
        epsilon(i,1) = one - alambda1(i)
        epsilon(i,2) = one - alambda2(i)
        epsilon(i,3) = one - alambda3(i)
      ENDDO !I=1,NEL
C
C     INTERPOLATE ENERGIES FOR HYSTERESIS MODEL
C
      xvec(1:nel,1)   = epsilon(1:nel,1)
      ipos(1:nel,1)   = vartmp(1:nel,16)
      CALL table_mat_vinterp(func_ener,nel,nel,ipos,xvec,fener1,dener1)
      vartmp(1:nel,16) = ipos(1:nel,1)     
 
      xvec(1:nel,1)   = epsilon(1:nel,2)
      ipos(1:nel,1)   = vartmp(1:nel,17)
      CALL table_mat_vinterp(func_ener,nel,nel,ipos,xvec,fener2,dener2)
      vartmp(1:nel,17) = ipos(1:nel,1)     
 
      xvec(1:nel,1)   = epsilon(1:nel,3)
      ipos(1:nel,1)   = vartmp(1:nel,18)
      CALL table_mat_vinterp(func_ener,nel,nel,ipos,xvec,fener3,dener3)
      vartmp(1:nel,18) = ipos(1:nel,1)
C
C     COMPUTE DAMAGE FOR UNLOADING
C
      DO i=1,nel
        whys(i)   = fener1(i) + fener2(i) + fener3(i)
        whysmax(i)= max(whysmax(i),whys(i))
        ratio     = whys(i) / whysmax(i)
        damage(i) =(one-hu)*(one - ratio**shape)
      ENDDO
C      
      RETURN
      END
      END MODULE