upd_failwave_sh3n.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	set_failwave_sh3n (failwave, fwave_el, dadv, nel, ixtg, itab, ngl, offly)

Function/Subroutine Documentation

set_failwave_sh3n()

subroutine set_failwave_sh3n	(	type (failwave_str_)	failwave,
		integer, dimension(nel), intent(out)	fwave_el,
		intent(in)	dadv,
		integer	nel,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(numnod), intent(in)	itab,
		integer, dimension(nel), intent(in)	ngl,
		integer, dimension(nel), intent(in)	offly )

Definition at line 32 of file upd_failwave_sh3n.F.

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