anioffc_crk.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "scr17_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	anioffc_crk (xfem_tab, iparg, ipart, ipartc, iparttg, ioff, el2fa, nbf, nbf_l, iad_crkg, iel_crk, indx_crk)

Function/Subroutine Documentation

anioffc_crk()

subroutine anioffc_crk	(	type (elbuf_struct_), dimension(ngroup,nxel), target	xfem_tab,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(lipart1,*)	ipart,
		integer, dimension(*)	ipartc,
		integer, dimension(*)	iparttg,
		integer, dimension(*)	ioff,
		integer, dimension(*)	el2fa,
		integer	nbf,
		integer	nbf_l,
		integer, dimension(nspmd,*)	iad_crkg,
		integer, dimension(*)	iel_crk,
		integer, dimension(*)	indx_crk )

Definition at line 35 of file anioffc_crk.F.

 
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE crackxfem_mod
      USE elbufdef_mod
      use my_alloc_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      "com01_c.inc"
#include      "com04_c.inc"
#include      "com_xfem1.inc"
#include      "scr17_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),EL2FA(*),NBF,IOFF(*),IEL_CRK(*),INDX_CRK(*),
     .        NBF_L,NBPART, IAD_CRKG(NSPMD,*),
     .        IPART(LIPART1,*),IPARTC(*),IPARTTG(*)
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL), TARGET :: XFEM_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NG,NEL,NFT,ITY,LFT,LLT,N,ILEV,MLW,N_FA,IXFEM,NI,NLAY,
     .        ILAY,IXEL,CRKS,NEL_CRK,RBUF,ELCRK
      INTEGER IE(NCRKPART),NELCRK(NCRKPART)
      INTEGER,DIMENSION(:),ALLOCATABLE::IOFFBUF
 
      my_real  offg
      my_real, DIMENSION(:) ,POINTER  ::  xoff
C=======================================================================
      CALL my_alloc(ioffbuf,nbf_l)
      nel_crk = 0
C
      DO crks = 1,ncrkpart
        ilev = indx_crk(crks)
        nelcrk(crks) = nel_crk
        nel_crk = nel_crk + crkshell(ilev)%CRKNUMSHELL
        ie(ilev) = 0
      ENDDO
C
      DO ng=1,ngroup
        mlw   =iparg(1,ng)
        nel   =iparg(2,ng)
        ity   =iparg(5,ng)
        nft   =iparg(3,ng)
        ixfem =iparg(54,ng)
        lft=1
        llt=nel
        IF (ixfem == 0) cycle
C
        IF (ity == 3) THEN
          ni = nft
        ELSE
          ni = nft + numelc
        ENDIF
C-----------------------------------------
C          LOOP OVER PHANTOM ELEMENTS
C-----------------------------------------
        DO ixel=1,nxel
          nlay = xfem_tab(ng,ixel)%NLAY
          DO ilay=1,nlay
C---
            ilev = nxel*(ilay-1) + ixel
            n_fa = nelcrk(ilev)
C---
            IF (nlay > 1) THEN
              xoff => xfem_tab(ng,ixel)%BUFLY(ilay)%LBUF(1,1,1)%OFF
            ELSEIF (nlay == 1) THEN
              xoff => xfem_tab(ng,ixel)%GBUF%OFF
            ENDIF
c---
            IF (ity == 3) THEN
c--  -        SH - 4N
              IF (mlw == 0 .OR. mlw == 13) THEN
                DO i=lft,llt
                  n = i + ni
                  IF (iel_crk(n) > 0) THEN
                    ie(ilev) = ie(ilev) + 1
                    ioff(el2fa(n_fa+ie(ilev))) = 1
                  ENDIF
                ENDDO
              ELSE
                DO i=lft,llt
                  n = i + ni
                  IF (iel_crk(n) > 0) THEN
                    offg = xoff(i)
                    ie(ilev) = ie(ilev) + 1
                    ioff(el2fa(n_fa+ie(ilev))) = nint(min(offg,one))
                  ENDIF
                ENDDO
              ENDIF  !  IF (MLW == 0 .OR. MLW == 13)
c---
            ELSEIF (ity == 7) THEN
c---          SH - 3N
              IF (mlw == 0 .OR. mlw == 13) THEN
                DO i=lft,llt
                  n = i + ni
                  IF (iel_crk(n) > 0) THEN
                    ie(ilev) = ie(ilev) + 1
                    ioff(el2fa(n_fa+ie(ilev))) = 1
                  ENDIF
                ENDDO
              ELSE
                DO i=lft,llt
                  n = i + ni
                  IF (iel_crk(n) > 0) THEN
                    offg = xoff(i)
                    ie(ilev) = ie(ilev) + 1
                    ioff(el2fa(n_fa+ie(ilev)))=nint(min(offg,one))
                  ENDIF
                ENDDO
              ENDIF  !  IF (MLW == 0 .OR. MLW == 13)
            ENDIF  !  IF (ITY == 3)
          ENDDO  !  DO ILAY=1,NLAY
        ENDDO  !  DO IXEL=1,NXEL
      ENDDO  !  DO NG=1,NGROUP
C-----------------------------------------------
      IF (nspmd==1) THEN
        CALL write_c_c(ioff,nbf)
      ELSE
        DO i = 1,nbf_l
          ioffbuf(i) = ioff(i)
        ENDDO
C
        IF (ispmd == 0) THEN
          rbuf = nbf
          CALL spmd_iget_partn(1,nbf_l,ioffbuf,ncrkpart,
     .                         iad_crkg,rbuf,2)
        ELSE
          rbuf = 1
          CALL spmd_iget_partn(1,nbf_l,ioffbuf,ncrkpart,
     .                         iad_crkg,rbuf,2)
        END IF
      ENDIF
C-----------
      DEALLOCATE(ioffbuf)
      RETURN