fail_setoff_wind_frwave.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/.
!||====================================================================
!||    fail_setoff_wind_frwave   ../engine/source/materials/fail/fail_setoff_wind_frwave.F
!||--- called by ------------------------------------------------------
!||    mulawc                    ../engine/source/materials/mat_share/mulawc.F90
!||    usermat_shell             ../engine/source/materials/mat_share/usermat_shell.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod              ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    failwave_mod              ../common_source/modules/failwave_mod.F
!||    mat_elem_mod              ../common_source/modules/mat_elem/mat_elem_mod.F90
!||    stack_mod                 ../engine/share/modules/stack_mod.F
!||====================================================================
      SUBROUTINE fail_setoff_wind_frwave(
     .           ELBUF_STR,MAT_ELEM ,GEO      ,PID      ,
     .           NGL      ,NEL      ,IR       ,IS       ,
     .           NLAY     ,NPTTOT   ,THK_LY   ,THKLY    ,
     .           OFF      ,NPG      ,STACK    ,ISUBSTACK,
     .           IGTYP    ,FAILWAVE ,FWAVE_EL ,DMG_FLAG ,
     .           TIME     ,TRELAX   ,TFAIL    ,DMG_SCALE)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE mat_elem_mod
      USE stack_mod
      USE failwave_mod
      USE elbufdef_mod
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"
#include "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  :: NEL,NPTTOT,NLAY,PID,IR,IS,NPG,ISUBSTACK,IGTYP,DMG_FLAG
      my_real  :: TIME,TRELAX
      INTEGER, DIMENSION(NEL) :: NGL,FWAVE_EL
      my_real, DIMENSION(NPTTOT*NEL) :: THKLY
      my_real, DIMENSION(NPROPG,*) :: GEO
      my_real, DIMENSION(NEL   )   :: OFF,TFAIL,DMG_SCALE
      my_real, DIMENSION(NEL,*)    :: thk_ly
      TYPE(elbuf_struct_)  ,TARGET :: ELBUF_STR
      TYPE (FAILWAVE_STR_) ,TARGET :: FAILWAVE 
      TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,IEL,IPOS,IL,IFL,IP,IPT,IG,IPG,JPG,NPTR,NPTS,NPTT,IMAT,
     .   idmg,countpg,nindxpg,nindxly,ipt_all,nfail,ipweight,ipthkly
      INTEGER, DIMENSION(NEL) :: NPTF,INDXPG,INDXLY  
      INTEGER, DIMENSION(10) :: ISTRESS
      INTEGER, DIMENSION(:), POINTER :: OFFLY,OFFPG,FOFF
      my_real, DIMENSION(NLAY,100)   :: PTHKF
      my_real, DIMENSION(NEL) :: uel1,dfmax,tdel,npttf,sigscale
      my_real, DIMENSION(:), POINTER :: dmax
      my_real, DIMENSION(NLAY) :: weight,p_thkly
      my_real :: thk_lay,p_thickg,fail_exp,thfact,norm,dfail
      TYPE(l_bufel_) ,POINTER :: LBUF 
      TYPE (stack_ply) :: stack    
c-----------------------------------------------------------------------
c     NPTT       NUMBER OF INTEGRATION POINTS IN CURRENT LAYER
c     NPTTF      NUMBER OF FAILED INTEGRATION POINTS IN THE LAYER
c     NPTTOT     NUMBER OF INTEGRATION POINTS IN ALL LAYERS (TOTAL)
c     OFFPG(NEL,NPG)  failure flag of PG in each layer  1=alive ,0=dead 
c     THK_LY     Ratio of layer thickness / element thickness
c     THK        Total element thickness
c     TFAIL(NEL) : global element variable - start of relaxation time before element suppression
C=======================================================================
      ipthkly   = 700
      ipweight  = 900
      p_thickg  = geo(42,pid)
      fail_exp  = geo(43,pid)
c
      nptr = elbuf_str%NPTR
      npts = elbuf_str%NPTS
      npg  = nptr*npts            ! number of in-plane Gauss points
      ipg  = (is-1)*nptr + ir     ! current Gauss point
      jpg  = (ipg-1)*nel
c                                                       
      DO il=1,nlay
        nfail = elbuf_str%BUFLY(il)%NFAIL
        imat  = elbuf_str%BUFLY(il)%IMAT
        DO ifl = 1,nfail
          pthkf(il,ifl) = mat_elem%MAT_PARAM(imat)%FAIL(ifl)%PTHK
        END DO
      END DO
c------------------------------------
      IF (nlay == 1) THEN
c------------------------------------
        il = 1
        nfail = elbuf_str%BUFLY(il)%NFAIL
        nptt  = elbuf_str%BUFLY(il)%NPTT
        offpg => elbuf_str%BUFLY(il)%OFFPG(jpg+1:jpg+nel)
        offly => elbuf_str%BUFLY(il)%OFF
c
        IF (nfail == 1 .and. p_thickg > zero) THEN
          pthkf(il,1) = max(p_thickg,em06)
          pthkf(il,1) = min(p_thickg,one-em06)
        ELSE
          DO ifl = 1,nfail
            pthkf(il,ifl) = max(pthkf(il,ifl),em06)
            pthkf(il,ifl) = min(pthkf(il,ifl),one-em06)
          ENDDO
        ENDIF
c------------------
        IF (failwave%WAVE_MOD > 0) THEN                    
          DO ifl = 1,nfail
            DO ipt=1,nptt
              dmax => elbuf_str%BUFLY(il)%FAIL(ir,is,ipt)%FLOC(ifl)%DAMMX
              DO iel=1,nel
                IF (offly(iel) < 0 .and. dmax(iel) == one) THEN
                  fwave_el(iel) = offly(iel)  ! set element frontwave flag 
                  offly(iel) = 0
                ENDIF
              ENDDO     ! IPT=1,NPTT        
            ENDDO       ! IFL = 1,NFAIL
          ENDDO         ! IEL=1,NEL
        ENDIF
c------------------
        DO iel=1,nel
          IF (off(iel) == zero .or. offpg(iel) == 0) cycle
          DO ifl = 1,nfail
            thfact = zero
            DO ipt=1,nptt
              foff => elbuf_str%BUFLY(il)%FAIL(ir,is,ipt)%FLOC(ifl)%OFF
              IF (foff(iel) < one)  THEN
                ipos = (ipt-1)*nel + iel
                thfact = thfact + thkly(ipos)
              ENDIF
              IF (thfact >= pthkf(il,ifl)) THEN  ! delete current PG in the layer
                offpg(iel) = 0
              ENDIF 
            ENDDO     ! IPT=1,NPTT        
          ENDDO       ! IFL = 1,NFAIL
        ENDDO         ! IEL=1,NEL
c------------------
        nindxpg = 0
        DO iel=1,nel
          IF (offpg(iel) == 0) THEN
            nindxpg = nindxpg + 1
            indxpg(nindxpg) = iel
          ENDIF
        ENDDO
c------------------
        IF (ipg == npg) THEN
          IF (dmg_flag == 0) THEN   ! element is deleted immediately after fail crit is reached
            DO iel=1,nel
              IF (off(iel) == one) THEN
                countpg = 0
                DO ig=1,ipg
                  jpg  = (ig-1)*nel
                  countpg = countpg + elbuf_str%BUFLY(il)%OFFPG(jpg+iel)
                ENDDO
                IF (countpg == 0) THEN  ! all gauss pts have failed
                  off(iel) = four_over_5        
                ENDIF
              ENDIF
            ENDDO  ! IEL=1,NEL
          ELSE   ! DMG_FLAG = 1 => Add relaxation time with exp damage before deleting element
            DO iel=1,nel
              IF (off(iel) == one) THEN
                countpg = 0
                DO ig=1,ipg
                  jpg  = (ig-1)*nel
                  countpg = countpg + elbuf_str%BUFLY(il)%OFFPG(jpg+iel)
                ENDDO
                IF (countpg == 0) THEN  ! all Gauss pts have failed
                  off(iel) = one - em6
                  tfail(iel) = time             
                ENDIF
              ENDIF
            ENDDO  ! IEL=1,NEL
            DO iel=1,nel
              IF (tfail(iel) > zero) THEN
                dmg_scale(iel) = exp(-(time - tfail(iel))/trelax)   
              END IF      
            ENDDO  ! IEL=1,NEL
          END IF   ! DMG_FLAG
        ENDIF      ! IPG == NPG
c----------------------------------------
      ENDIF       ! PROPERTY TYPE
c-------------------------------
 2000 FORMAT(1x,'-- FAILURE OF LAYER',i3, ' ,SHELL ELEMENT NUMBER ',i10)
 2100 FORMAT(1x,'-- FAILURE OF LAYER',i3, ' ,SHELL ELEMENT NUMBER ',i10,
     .       1x,'AT TIME :',g11.4)
c-----------
      RETURN
      END