asspar_crk.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	asspar_crk (addcne_crk, inod_crk, crksky, nodft, nodlt, nodenr, nodlevxf, itab)

Function/Subroutine Documentation

asspar_crk()

subroutine asspar_crk	(	integer, dimension(*)	addcne_crk,
		integer, dimension(*)	inod_crk,
		type(xfem_sky_), dimension(*)	crksky,
		integer	nodft,
		integer	nodlt,
		integer, dimension(*)	nodenr,
		integer, dimension(*)	nodlevxf,
		integer, dimension(numnod)	itab )

Definition at line 30 of file asspar_crk.F.

C-----------------------------------------------
      USE crackxfem_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      "com04_c.inc"
#include      "com_xfem1.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NODFT,NODLT
      INTEGER ADDCNE_CRK(*),INOD_CRK(*),NODENR(*),NODLEVXF(*),ITAB(NUMNOD)
      TYPE(XFEM_SKY_), DIMENSION(*) :: CRKSKY
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,KK,NSX,NC_CRK,NCT_CRK,EN0,ILEV,NLEV
      my_real, DIMENSION(:,:),ALLOCATABLE :: xfac0
C=======================================================================
      ALLOCATE(xfac0(6,ienrnod))
c
      DO i = nodft,nodlt
        nsx = inod_crk(i)
        IF (nsx <= 0) cycle
        xfac0 = zero
        nct_crk = addcne_crk(nsx)-1
        nc_crk  = addcne_crk(nsx+1)-addcne_crk(nsx)
        nlev    = nodlevxf(nsx)
c
        DO ilev=1,nlev
          DO kk = nct_crk+1, nct_crk+nc_crk
            en0 = crklvset(ilev)%ENR0(2,kk)
            IF (en0 > 0) THEN
              xfac0(1,en0) = xfac0(1,en0) + crksky(ilev)%FSKY(1,kk)
              xfac0(2,en0) = xfac0(2,en0) + crksky(ilev)%FSKY(2,kk)
              xfac0(3,en0) = xfac0(3,en0) + crksky(ilev)%FSKY(3,kk)
              xfac0(4,en0) = xfac0(4,en0) + crksky(ilev)%FSKY(4,kk)
              xfac0(5,en0) = xfac0(5,en0) + crksky(ilev)%FSKY(5,kk)
              xfac0(6,en0) = xfac0(6,en0) + crksky(ilev)%FSKY(6,kk)
            END IF
C---
          END DO
        END DO
C---
        DO ilev=1,nlev
          DO kk = nct_crk+1, nct_crk+nc_crk
            en0 = crklvset(ilev)%ENR0(2,kk)
            IF (en0 > 0) THEN
              crksky(ilev)%FSKY(1,kk) = xfac0(1,en0)
              crksky(ilev)%FSKY(2,kk) = xfac0(2,en0)
              crksky(ilev)%FSKY(3,kk) = xfac0(3,en0)
              crksky(ilev)%FSKY(4,kk) = xfac0(4,en0)
              crksky(ilev)%FSKY(5,kk) = xfac0(5,en0)
              crksky(ilev)%FSKY(6,kk) = xfac0(6,en0)
            END IF
          END DO
        END DO
C---
      END DO
C---
      DEALLOCATE(xfac0)
C-----------
      RETURN