m2lawt.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/.
!||====================================================================
!||    m2lawt   ../engine/source/materials/mat/mat002/m2lawt.F
!||--- called by ------------------------------------------------------
!||    tforc3   ../engine/source/elements/truss/tforc3.F
!||====================================================================
      SUBROUTINE m2lawt(
     1   PM,      GEO,     OFF,     FOR,
     2   EINT,    AREA,    AL0,     PLA,
     3   STI,     MAT,     MGM,     NGL,
     4   EPS,     AL,      NEL)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "com08_c.inc"
#include      "units_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER MAT(MVSIZ),MGM(MVSIZ),NGL(MVSIZ)
      my_real
     .   PM(NPROPM,*),GEO(NPROPG,*),OFF(*),FOR(*),EINT(*),
     .   area(*),al0(*),pla(*),sti(*),eps(mvsiz),al(mvsiz)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ICC(MVSIZ)
      INTEGER I,J
      my_real
     .   YM(MVSIZ),GAP(MVSIZ),
     .   ca(mvsiz),cb(mvsiz),cn(mvsiz),ymax(mvsiz),
     .   epmx(mvsiz),yld(mvsiz),ff(mvsiz),hh(mvsiz),
     .   aa(mvsiz),pr(mvsiz),yma
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      my_real
     .   cvmgt
C-----------------------------------------------      
      DO i=1,nel
        ym(i)  =pm(20,mat(i))
        pr(i)  =pm(21,mat(i))
        ca(i)  =pm(38,mat(i))
        cb(i)  =pm(39,mat(i))
        cn(i)  =pm(40,mat(i))
        epmx(i)=pm(41,mat(i))
        ymax(i)=pm(42,mat(i))
        icc(i) =nint(pm(49,mat(i)))
        gap(i) =geo(2,mgm(i))
      ENDDO
c
      DO i=1,nel
        IF (gap(i) > zero .AND. al(i) <= (al0(i)-gap(i))) off(i)=one
      ENDDO
c
      DO i=1,nel
        eint(i)=eint(i)+for(i)*eps(i)*al(i)*dt1*half
      ENDDO
c
      DO i=1,nel
        area(i)=area(i)*(one - two*pr(i)*eps(i)*dt1*off(i))
      ENDDO
c
      DO i=1,nel
        yma = ym(i)*area(i)
        for(i)=for(i)+yma*eps(i)*dt1
        sti(i)=yma / al(i)
      ENDDO
c
      DO i=1,nel
        yld(i)=ca(i)+cb(i)*pla(i)**cn(i)
      ENDDO
C-----------------------
C     MODULE ECROUISSAGE
C-----------------------
      DO i=1,nel
        IF (cn(i) == one) THEN
          hh(i)= cb(i)
        ELSE
          IF (pla(i) /= zero) THEN
            hh(i)= cb(i)*cn(i)/pla(i)**(one -cn(i))
          ELSE
            hh(i)=zero
          ENDIF
        ENDIF
      ENDDO
c
      DO i=1,nel
        aa(i)  = (ym(i)+hh(i))*area(i)
        yld(i) = min(yld(i),ymax(i))
        ff(i)  = abs(for(i))-yld(i)*area(i)
        ff(i)  = max(zero,ff(i))
      ENDDO
c
      DO i=1,nel
        pla(i)=pla(i)+ff(i)/aa(i)
      ENDDO
c
      DO i=1,nel
        for(i)=cvmgt(sign(yld(i)*area(i),for(i)),for(i),ff(i) > zero)
      ENDDO
C--------------------------------
C     TEST DE RUPTURE DUCTILE
C-------------------------------
      DO i=1,nel
        IF (off(i) < em01) off(i)=zero
        IF (off(i) < one) off(i)=off(i)*four_over_5
      ENDDO 
c
      DO i=1,nel
        IF (off(i) < one)      cycle
        IF (pla(i) < epmx(i)) cycle
        off(i)=off(i)*four_over_5
        idel7nok = 1
      ENDDO
c
      DO i=1,nel
        IF (off(i) /= four_over_5) cycle
#include "lockon.inc"
        WRITE(iout,1000)  ngl(i)
        WRITE(istdo,1100) ngl(i),tt
#include "lockoff.inc"
      ENDDO
c
      DO i=1,nel
        sti(i)=sti(i)*off(i)
        for(i)= for(i)*off(i)  
      ENDDO
c
      DO i=1,nel
        eint(i)=eint(i)+for(i)*eps(i)*al(i)*dt1*half
      ENDDO
C
 1000 FORMAT(1x,'-- RUPTURE OF TRUSS ELEMENT NUMBER ',i10)
 1100 FORMAT(1x,'-- RUPTURE OF TRUSS ELEMENT :',i10,' AT TIME :',g11.4)
C-----------------------------------------------
      RETURN
      END