fillcne_xfem.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	fillcne_xfem (lcne_crkxfem, iparg, iel_crkxfem, inod_crkxfem, ixc, ixtg, cep, addcne_crkxfem, cne_xfe, cel_xfe, cep_xfe, crknodiad)

Function/Subroutine Documentation

fillcne_xfem()

subroutine fillcne_xfem	(	integer	lcne_crkxfem,
		integer, dimension(nparg,ngroup)	iparg,
		integer, dimension(numelc+numeltg)	iel_crkxfem,
		integer, dimension(*)	inod_crkxfem,
		integer, dimension(nixc,*)	ixc,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(*)	cep,
		integer, dimension(0:ncrkxfe+1)	addcne_crkxfem,
		integer, dimension(lcne_crkxfem)	cne_xfe,
		integer, dimension(ecrkxfe)	cel_xfe,
		integer, dimension(ecrkxfe)	cep_xfe,
		integer, dimension(lcne_crkxfem)	crknodiad )

Definition at line 29 of file fillcne_xfem.F.

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      "com01_c.inc"
#include      "com04_c.inc"
#include      "com_xfem1.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LCNE_CRKXFEM
      INTEGER IXC(NIXC,*),IXTG(NIXTG,*),ADDCNE_CRKXFEM(0:NCRKXFE+1),
     .  CNE_XFE(LCNE_CRKXFEM),IEL_CRKXFEM(NUMELC+NUMELTG),INOD_CRKXFEM(*),
     .  CEP(*),CEL_XFE(ECRKXFE),CEP_XFE(ECRKXFE),CRKNODIAD(LCNE_CRKXFEM),
     .  IPARG(NPARG,NGROUP)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,N,NG,NP,NEL,NFT,ITY,ITYO,II,III,NIN,P,PROC,INDX,OFFC,OFFTG
      INTEGER ADSKY(0:NCRKXFE+1)
      INTEGER, ALLOCATABLE, DIMENSION(:)   :: KNOD2ELC
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: TAGSKYC,TAGSKYTG
      INTEGER, DIMENSION(70000)    :: WORK
      INTEGER, DIMENSION(NUMELC)   :: ITRIC
      INTEGER, DIMENSION(NUMELTG)  :: ITRITG
      INTEGER, DIMENSION(NUMELC*2) :: INDXC
      INTEGER, DIMENSION(NUMELTG*2):: INDXTG
C=======================================================================
C   CALCUL DE CNE ADDCNE_CRKXFEM CEL for XFEM part
C-----------------------------------------------
      ALLOCATE(knod2elc(numnod+1))
      knod2elc = 0
      ALLOCATE(tagskyc(4,numelc))
      tagskyc = 0
      ALLOCATE(tagskytg(3,numeltg))
      tagskytg = 0
C
      DO i = 0, ncrkxfe + 1           ! NCRKXFE = Nb of nodes xfem
        adsky(i) = addcne_crkxfem(i)    
      ENDDO
C
      offc  = numels + numelq
      offtg = offc  + numelt + numelp + numelr + numelc
c
c---------------------------
c     Connectivities
c---------------------------
      DO i = 1, numelc
        itric(i) = ixc(7,i)    !  ID elements std dans l'ordre d'input
      ENDDO
      CALL my_orders(0,work,itric,indxc,numelc,1)
c
      DO i = 1, numeltg
        itritg(i) = ixtg(6,i)
      ENDDO
      CALL my_orders(0,work,itritg,indxtg,numeltg,1)
c---------------------------
      DO j=1,numelc
        i = indxc(j)
        DO k=1,4
          n = ixc(k+1,i)
          knod2elc(n)  = knod2elc(n) + 1
          tagskyc(k,i) = knod2elc(n)      ! Nb d'elements std connectes a un noeud
        END DO
      END DO
c---
      DO j=1,numeltg
        i = indxtg(j)
        DO k=1,3
          n = ixtg(k+1,i)
          knod2elc(n)   = knod2elc(n) + 1
          tagskytg(k,i) = knod2elc(n)
        END DO
      END DO
c---------------------------
c     SHELL -4N- Connectivities
c---------------------------
      indx = 0
      DO j=1,numelc
        i = indxc(j)
        IF (iel_crkxfem(i) > 0) THEN
          indx = indx + 1
          DO k=1,4
            n  = ixc(k+1,i)          ! Num noeud std
            np = inod_crkxfem(n)     ! Num noeud phantome
            cne_xfe(adsky(np)) = i  
            crknodiad(adsky(np)) = tagskyc(k,i)
            adsky(np) = adsky(np) + 1
          ENDDO
        ENDIF 
      ENDDO
c---------------------------
c     SHELL -3N- Connectivities
c---------------------------
      DO j=1,numeltg
        i = indxtg(j)
        IF (iel_crkxfem(i+numelc) > 0) THEN
          indx = indx + 1
          DO k=1,3
            n = ixtg(k+1,i)
            np = inod_crkxfem(n)
            cne_xfe(adsky(np)) = i + numelc
            crknodiad(adsky(np)) = tagskytg(k,i)
            adsky(np) = adsky(np) + 1
          ENDDO
        ENDIF 
      ENDDO
C-----------------------------------------------
c     Remplissage de CEL_XFE, CEP_XFE :  Element Xfem Global/Local
C-----------------------------------------------
c     SHELL -4N-
c
      DO proc = 1, nspmd
        nin = 0
        DO ng = 1, ngroup
          nel = iparg(2,ng)
          nft = iparg(3,ng)
          ity = iparg(5,ng)
          p   = iparg(32,ng)+1
          IF (ity == 3) THEN
            IF (p == proc) THEN
              DO i = 1, nel
                n = iel_crkxfem(i+nft)
                IF (n > 0) THEN
                  nin = nin + 1
                  cel_xfe(n) = nin
                  cep_xfe(n) = p-1
                ENDIF
              ENDDO
            ENDIF
          ENDIF
        ENDDO
      ENDDO
c
c     SHELL -3N-
c
      DO proc = 1, nspmd
        nin = 0
        DO ng = 1, ngroup
          nel = iparg(2,ng)
          nft = iparg(3,ng)
          ity = iparg(5,ng)
          p   = iparg(32,ng)+1
          IF (ity == 7) THEN
            IF (p == proc) THEN
              ii = numelc + nft
              DO i = 1, nel
                n = iel_crkxfem(ii + i)
                IF (n > 0) THEN
                  nin = nin + 1
                  cel_xfe(n) = nin
                  cep_xfe(n) = p-1
                ENDIF
              ENDDO
            ENDIF
          ENDIF
        ENDDO
      ENDDO
c-----------
      DEALLOCATE(tagskyc,tagskytg,knod2elc)
c-----------
      RETURN