fail__johnson_8F_source.html

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/.

!||====================================================================

!||    fail_johnson    ../engine/source/materials/fail/johnson_cook/fail_johnson.F

!||--- called by ------------------------------------------------------

!||    mmain           ../engine/source/materials/mat_share/mmain.F90

!||    mmain8          ../engine/source/materials/mat_share/mmain8.F

!||    mulaw           ../engine/source/materials/mat_share/mulaw.F90

!||    mulaw8          ../engine/source/materials/mat_share/mulaw8.F90

!||    usermat_solid   ../engine/source/materials/mat_share/usermat_solid.F

!||====================================================================


      SUBROUTINE fail_johnson(

     1     NEL    ,NUPARAM,NUVAR   ,

     2     TIME   ,TIMESTEP ,UPARAM  ,NGL    ,

     4     SIGNXX ,SIGNYY ,SIGNZZ  ,SIGNXY  ,SIGNYZ  ,SIGNZX ,

     5     DPLA   ,EPSP   ,TSTAR   ,UVAR    ,OFF     ,

     6     DFMAX  ,TDELE  )

c-----------------------------------------------

c    Johnson cook failure model

C-----------------------------------------------

C   I m p l i c i t   T y p e s

C-----------------------------------------------

#include      "implicit_f.inc"

C---------+---------+---+---+--------------------------------------------

C VAR     | SIZE    |TYP| RW| DEFINITION

C---------+---------+---+---+--------------------------------------------

C NEL     |  1      | I | R | SIZE OF THE ELEMENT GROUP NEL

C NUPARAM |  1      | I | R | SIZE OF THE USER PARAMETER ARRAY

C NUVAR   |  1      | I | R | NUMBER OF FAILURE ELEMENT VARIABLES

C---------+---------+---+---+--------------------------------------------

C TIME    |  1      | F | R | CURRENT TIME

C TIMESTEP|  1      | F | R | CURRENT TIME STEP

C UPARAM  | NUPARAM | F | R | USER FAILURE PARAMETER ARRAY

C---------+---------+---+---+--------------------------------------------

C SIGNXX  | NEL     | F | W | NEW ELASTO PLASTIC STRESS XX

C SIGNYY  | NEL     | F | W | NEW ELASTO PLASTIC STRESS YY

C ...     |         |   |   |

C ...     |         |   |   |

C---------+---------+---+---+--------------------------------------------

C UVAR    |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLE ARRAY

C OFF     | NEL     | F |R/W| DELETED ELEMENT FLAG (=1. ON, =0. OFF)

C---------+---------+---+---+--------------------------------------------

#include  "scr17_c.inc"

#include  "units_c.inc"

#include  "comlock.inc"

#include  "param_c.inc"

#include  "impl1_c.inc"

C-----------------------------------------------

      INTEGER NEL, NUPARAM, NUVAR,NGL(NEL)

      my_real TIME,TIMESTEP,UPARAM(NUPARAM),

     .   SIGNXX(NEL),SIGNYY(NEL),SIGNZZ(NEL),

     .   SIGNXY(NEL),SIGNYZ(NEL),SIGNZX(NEL),UVAR(NEL,NUVAR),

     .   DPLA(NEL),EPSP(NEL),TSTAR(NEL),OFF(NEL),DFMAX(NEL),TDELE(NEL)

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER I,J,JJ,IDEL,IDEV,IFLAG,NINDX,IR,IFAIL,ISOLID

      INTEGER ,DIMENSION(NEL) :: INDX

      my_real :: D1,D2,D3,D4,D5,EPSP0,P,EPSF,SVM,SCALE,SXX,SYY,SZZ,EPSF_MIN

C--------------------------------------------------------------

      D1 = uparam(1)

      d2 = uparam(2)

      d3 = uparam(3)

      d4 = uparam(4)

      d5 = uparam(5)

      epsp0 = uparam(6)

      isolid = int(uparam(8))

      epsf_min = uparam(12)


C-----------------------------------------------

      idel=0

      idev=0

      scale = zero

      IF ((isolid==1).OR.(isolid == 4)) THEN

        idel=1

      ELSEIF ((isolid==2).OR.(isolid == 3)) THEN

        idev =1

      ENDIF

C...

      IF(idel==1)THEN

        DO i=1,nel

          IF(off(i)<0.1) off(i)=0.0

          IF(off(i)<1.0) off(i)=off(i)*0.8

        END DO

      END IF

C

      IF(idel==1)THEN

       nindx=0

       DO i=1,nel

        IF ((isolid==1.AND.off(i)==one).OR.(isolid==4))THEN

         IF(dpla(i)/=zero)THEN

           p = third*(signxx(i) + signyy(i) + signzz(i))

           sxx = signxx(i) - p

           syy = signyy(i) - p

           szz = signzz(i) - p

           svm =half*(sxx**2 + syy**2 + szz**2)

     .            +signxy(i)**2 + signzx(i)**2 + signyz(i)**2

           svm=sqrt(three*svm)

           epsf = d3*p/max(em20,svm)

           epsf = d1 + d2*exp(epsf)

           IF(d4/=zero) epsf = epsf * (one + d4*log(max(one,epsp(i)/epsp0))) ! if d4=0, epsp is not correctly defined

           IF(d5/=zero) epsf = epsf * (one + d5*tstar(i)) ! if d5=0, tsart is not correctly defined

           epsf = max(epsf,epsf_min)

           IF(epsf>zero) dfmax(i) = dfmax(i) + dpla(i)/epsf

           dfmax(i) = min(one,dfmax(i))

         ENDIF

         IF (dfmax(i)>=one.AND.off(i)==one) THEN

          IF (isolid == 1) THEN

            off(i)=four_over_5

            nindx=nindx+1

            indx(nindx)=i

            tdele(i) = time

          ELSEIF (isolid == 4) THEN

            dfmax(i)  = one

            off(i)    = one

            signxx(i) = zero

            signyy(i) = zero

            signzz(i) = zero

            signxy(i) = zero

            signyz(i) = zero

            signzx(i) = zero

          ENDIF

         ENDIF

        ENDIF

       ENDDO

       IF(nindx>0.AND.imconv==1)THEN

        DO j=1,nindx

#include "lockon.inc"

         WRITE(iout, 1000) ngl(indx(j))

         WRITE(istdo,1100) ngl(indx(j)),time

#include "lockoff.inc"

        END DO

       END IF

      ENDIF

Cc deviatoric will be vanished

      IF(idev==1)THEN

       nindx=0

       DO i=1,nel

        IF((isolid==2.OR.isolid==3).AND.off(i)==one)THEN

         IF(dfmax(i)<one.AND.dpla(i)/=zero)THEN

          p = third*(signxx(i) + signyy(i) + signzz(i))

          sxx = signxx(i) - p

          syy = signyy(i) - p

          szz = signzz(i) - p

          svm =half*(sxx**2+ syy**2 + szz**2)

     .          +signxy(i)**2 + signzx(i)**2 + signyz(i)**2

          svm=sqrt(three*svm)

          epsf = d3*p/max(em20,svm)

          epsf = (d1 +

     .           d2*exp(epsf))*(one

     .                  + d4*log(max(one,epsp(i)/epsp0)))

     .                    *(one + d5*tstar(i))

          epsf = max(epsf,epsf_min)

          IF(epsf>zero) dfmax(i) = dfmax(i) + dpla(i)/epsf

          dfmax(i) = min(one,dfmax(i))

          IF(dfmax(i)>=one.AND.off(i)==one) THEN

           nindx=nindx+1

           indx(nindx)=i

           dfmax(i) = one

           IF (isolid == 2) THEN

            signxx(i) =   p

            signyy(i) =   p

            signzz(i) =   p

            signxy(i) = zero

            signyz(i) = zero

            signzx(i) = zero

           ELSEIF (isolid == 3) THEN

            signxx(i) = min(p,zero)

            signyy(i) = min(p,zero)

            signzz(i) = min(p,zero)

            signxy(i) = zero

            signyz(i) = zero

            signzx(i) = zero

           ENDIF

          ENDIF

c

         ELSEIF(dfmax(i)>=one)THEN

          p = third*(signxx(i) + signyy(i) + signzz(i))

          dfmax(i) = one

          IF (isolid == 2) THEN

            signxx(i) =   p

            signyy(i) =   p

            signzz(i) =   p

            signxy(i) = zero

            signyz(i) = zero

            signzx(i) = zero

          ELSEIF (isolid == 3) THEN

            signxx(i) = min(p,zero)

            signyy(i) = min(p,zero)

            signzz(i) = min(p,zero)

            signxy(i) = zero

            signyz(i) = zero

            signzx(i) = zero

          ENDIF

         ENDIF

        ENDIF

       ENDDO

       IF(nindx>0.AND.imconv==1)THEN

        DO j=1,nindx

         i = indx(j)

#include "lockon.inc"

         WRITE(iout, 2000) ngl(i)

         WRITE(istdo,2100) ngl(i),time

#include "lockoff.inc"

        END DO

       END IF

      ENDIF

C---------Damage for output  0 < DFMAX < 1 --------------------

c       DO J=1,IR

c          I=JST(J)

c          DFMAX(I)= MIN(ONE,DFMAX(I))

c       ENDDO

C------------------

C-----------------------------------------------

 1000 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10)

 1100 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10,

     .          ' AT TIME :',1pe12.4)

C

 2000 FORMAT(1x,' DEVIATORIC STRESS WILL BE VANISHED',i10)

 2100 FORMAT(1x,' DEVIATORIC STRESS WILL BE VANISHED',i10,

     .          ' AT TIME :',1pe12.4)

      RETURN


      END

fail_johnson
subroutine fail_johnson(nel, nuparam, nuvar, time, timestep, uparam, ngl, signxx, signyy, signzz, signxy, signyz, signzx, dpla, epsp, tstar, uvar, off, dfmax, tdele)
Definition fail_johnson.F:38

min
#define min(a, b)
Definition macros.h:20

max
#define max(a, b)
Definition macros.h:21