upd_failwave_sh3n.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/.
!||====================================================================
!||    set_failwave_sh3n   ../engine/source/materials/fail/failwave/upd_failwave_sh3n.F
!||--- called by ------------------------------------------------------
!||    c3forc3             ../engine/source/elements/sh3n/coque3n/c3forc3.F
!||    cdkforc3            ../engine/source/elements/sh3n/coquedk/cdkforc3.F
!||--- uses       -----------------------------------------------------
!||    element_mod         ../common_source/modules/elements/element_mod.F90
!||    failwave_mod        ../common_source/modules/failwave_mod.F
!||====================================================================
      SUBROUTINE set_failwave_sh3n(FAILWAVE    ,FWAVE_EL  ,DADV     ,
     .           NEL      ,IXTG     ,ITAB      ,NGL       ,OFFLY    )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE failwave_mod
      use element_mod , only : nixtg
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 "com04_c.inc"
#include "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL,IXTG(NIXTG,*)
      INTEGER, DIMENSION(NEL)   , INTENT(IN)    :: NGL,OFFLY
      INTEGER, DIMENSION(NUMNOD), INTENT(IN   ) :: ITAB 
      my_real ,DIMENSION(NEL)   , INTENT(IN)    :: dadv  
      INTEGER, DIMENSION(NEL)   , INTENT(OUT)   :: FWAVE_EL
      TYPE (FAILWAVE_STR_)  :: FAILWAVE 
CC-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,K,N1,N2,N3,FOUND,LEVEL,NINDX,NFAIL,FNOD1,FNOD2,
     .   knext,kprev,ncurr
      INTEGER ,DIMENSION(NEL) :: INDX
      INTEGER ,DIMENSION(3)   :: NDL,NDR,NOD_ID,NOD_NN
c---
      DATA ndr/2,3,1/
      DATA ndl/1,2,3/
c-----------------------------------------------
c set failure flag to elements using nodal frontwave information from neighbors
C=======================================================================
c
c---------------
      SELECT CASE (failwave%WAVE_MOD)
c---------------
        CASE (1)   ! isotropic propagation
c---------------
          DO i=1,nel
            IF (offly(i) == 1 .and. dadv(i) == one) THEN
              n1 = failwave%IDXI(ixtg(2,i))
              n2 = failwave%IDXI(ixtg(3,i))
              n3 = failwave%IDXI(ixtg(4,i))
              nfail = failwave%FWAVE_NOD(1,n1,1) 
     .              + failwave%FWAVE_NOD(1,n2,1)
     .              + failwave%FWAVE_NOD(1,n3,1)
              IF (nfail > 0) THEN
                fwave_el(i) = 1
              ENDIF
            ENDIF
          ENDDO
c---------------
        CASE (2,3)   ! directional propagation
c---------------
          nindx = 0
          DO i=1,nel
            IF (offly(i) == 1 .and. dadv(i) == one) THEN
              nindx = nindx + 1
              indx(nindx) = i
            ENDIF
          ENDDO
c
          DO ii=1,nindx
            i = indx(ii)
            n1 = ixtg(2,i)
            n2 = ixtg(3,i)
            n3 = ixtg(4,i)
            nod_nn(1) = failwave%IDXI(n1)  
            nod_nn(2) = failwave%IDXI(n2)  
            nod_nn(3) = failwave%IDXI(n3)  
            nod_id(1) = itab(n1)   
            nod_id(2) = itab(n2)   
            nod_id(3) = itab(n3)   
            found = 0   
c
            DO k=1,3
              ncurr = nod_nn(k)
              IF (failwave%MAXLEV(ncurr) > 0) THEN
                knext = ndr(k)  
                kprev = ndl(k)
c
                DO level = 1,failwave%MAXLEV(ncurr)
                  fnod1 = failwave%FWAVE_NOD(1,ncurr,level)
                  fnod2 = failwave%FWAVE_NOD(2,ncurr,level)
c
                  IF ((fnod2 == 0 .and. 
     .                (fnod1 == nod_id(knext) .or. fnod1 == nod_id(kprev))) 
     .              .or. 
     .                (fnod1 > 0 .and. fnod2 > 0 .and.
     .              fnod1 /= nod_id(kprev) .and. fnod1 /= nod_id(knext) .and.
     .              fnod2 /= nod_id(kprev) .and. fnod2 /= nod_id(knext)) ) THEN
                    found = 1
                    fwave_el(i) = 1
                    EXIT
                  ENDIF
                ENDDO  !  LEVEL
                IF (found == 1) EXIT
c
              ENDIF
            ENDDO    !  K=1,3 
c
c            IF (FOUND == 1) THEN
c#include "lockon.inc"
c              write(iout,'(A,I10)')'set failwave flag to element=',ngl(I)
c#include "lockoff.inc"
c            ENDIF
c
          ENDDO     !  II=1,NINDX   
c---------------
      END SELECT
c---------------
      RETURN
      END
c