c_crkedge.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	c_crkedge (ielc_l, ieltg_l, iedgecrk_l, numedges, iedgesh4, iedgesh3, cep, p, ibordedge, ibordedge_l, numedges_l, nodedge, nodedge_l, nodlocal, iedgesh4_l, iedgesh3_l, iel_crk, iedge_l, iedge, ecrkxfec, edgelocal, nbddedge_l, iedge_tmp, edgeglobal)

Function/Subroutine Documentation

c_crkedge()

subroutine c_crkedge	(	integer, dimension(*)	ielc_l,
		integer, dimension(*)	ieltg_l,
		integer, dimension(*)	iedgecrk_l,
		integer	numedges,
		integer, dimension(4,*)	iedgesh4,
		integer, dimension(3,*)	iedgesh3,
		integer, dimension(*)	cep,
		integer	p,
		integer, dimension(*)	ibordedge,
		integer, dimension(*)	ibordedge_l,
		integer	numedges_l,
		integer, dimension(2,*)	nodedge,
		integer, dimension(2,*)	nodedge_l,
		integer, dimension(*)	nodlocal,
		integer, dimension(4,*)	iedgesh4_l,
		integer, dimension(3,*)	iedgesh3_l,
		integer, dimension(*)	iel_crk,
		integer, dimension(*)	iedge_l,
		integer, dimension(*)	iedge,
		integer	ecrkxfec,
		integer, dimension(*)	edgelocal,
		integer	nbddedge_l,
		integer, dimension(3,*)	iedge_tmp,
		integer, dimension(*)	edgeglobal )

Definition at line 30 of file c_crkedge.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------     
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"
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------
      INTEGER  NLOCAL
      EXTERNAL nlocal    
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IELC_L(*),IELTG_L(*),IEDGECRK_L(*),NUMEDGES,
     .        IEDGESH4(4,*),IEDGESH3(3,*),CEP(*),P,IBORDEDGE(*),
     .        IBORDEDGE_L(*),NUMEDGES_L,NODEDGE(2,*),NODEDGE_L(2,*),
     .        NODLOCAL(*),IEDGESH4_L(4,*),IEDGESH3_L(3,*),IEL_CRK(*),
     .        IEDGE_L(*),IEDGE(*),ECRKXFEC,EDGELOCAL(*),
     .        NBDDEDGE_L,IEDGE_TMP(3,*),EDGEGLOBAL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,OFFC,OFFTG,IED_L,IED_GL,NEXT,IEL_L,IC1,IC2,JCRK,
     . IEL_L1,PROC,EDGEPROC
      INTEGER,DIMENSION(:),ALLOCATABLE :: ITAG_EDGE
C=======================================================================
      offc = numels + numelq
      offtg = offc + numelc + numelt + numelp + numelr
C
      ALLOCATE(itag_edge(numedges))
      itag_edge = 0
C
      next = 0
      iel_l = 0
      ied_l = 0
      iel_l1 = 0
C---
C  tag local edges
C---
C
C shell 4N
C
      DO i=1,numelc
        IF (cep(i+offc) == p) THEN
          iel_l1 = iel_l1 + 1
          IF (iel_crk(i) > 0) THEN
            iel_l = iel_l + 1
CC            JCRK = IELC_L(IEL_L1)
            jcrk = iel_crk(i)
            DO k=1,4  ! edges
              ied_gl = iedgesh4(k,jcrk)   ! Id global des edges dans element xfem
              IF (ied_gl > 0) THEN
                IF (itag_edge(ied_gl) == 0) THEN
                  ied_l = ied_l + 1
C                 local boundary edge
                  ibordedge_l(ied_l) = ibordedge(ied_gl)
                  edgeglobal(ied_l) = ied_gl
                  edgelocal(ied_gl) = ied_l
                  itag_edge(ied_gl) = 1
C                 local edge nodes
                  ic1 = nodedge(1,ied_gl)
                  ic2 = nodedge(2,ied_gl)
                  ic1 = nodlocal(ic1)
                  ic2 = nodlocal(ic2)
                  nodedge_l(1,ied_l) = ic1
                  nodedge_l(2,ied_l) = ic2
C                  IEDGE_L(IED_L) = IED_GL
                  iedge_l(ied_l) = iedge(ied_gl)
                ENDIF
C               local element edges
                iedgesh4_l(k,iel_l) = edgelocal(ied_gl)
C for crk ply:   comptage des edges locales pour 1 ply
                iedgecrk_l(k + next) = edgelocal(ied_gl)
              ENDIF
            ENDDO
            next = next + 4
          ENDIF
        ENDIF
      ENDDO
C
C shell 3N
C
      iel_l = 0
      iel_l1 = 0
      DO i=1,numeltg
        IF(cep(i+offtg) == p)THEN
          iel_l1 = iel_l1 + 1
          IF(iel_crk(i+numelc) > 0)THEN
            iel_l = iel_l + 1
CC           JCRK = IELTG_L(IEL_L1)
            jcrk = iel_crk(i+numelc) - ecrkxfec
            DO k=1,3   ! edges
              ied_gl = iedgesh3(k,jcrk)
              IF(ied_gl /= 0)THEN
                IF(itag_edge(ied_gl) == 0)THEN
                  ied_l = ied_l + 1
C local boundary edge
                  ibordedge_l(ied_l) = ibordedge(ied_gl)
                  edgeglobal(ied_l) = ied_gl
                  edgelocal(ied_gl) = ied_l
                  itag_edge(ied_gl) = 1
C local nodal edges
                  ic1 = nodedge(1,ied_gl)
                  ic2 = nodedge(2,ied_gl)
                  ic1 = nodlocal(ic1)
                  ic2 = nodlocal(ic2)
                  nodedge_l(1,ied_l) = ic1
                  nodedge_l(2,ied_l) = ic2
C                  IEDGE_L(IED_L) = IED_GL
                  iedge_l(ied_l) = iedge(ied_gl)
                ENDIF
C local element edges
                iedgesh3_l(k,iel_l) = edgelocal(ied_gl)
C for crk ply:
                iedgecrk_l(k + next) = edgelocal(ied_gl)
              ENDIF
            ENDDO
            next = next + 3
          ENDIF
        ENDIF
      ENDDO
C---
c      NUMEDGES_L = IED
C---
C---
C  count front local edges  (front entre les procs) => edges d'echange
C---
      proc = p+1
      DO ied_gl=1,numedges
cc       IF(EDGELOCAL(IED_GL) > 0.AND.IEDGE_TMP(1,IED_GL) > 1)THEN
       IF (iedge_tmp(3,ied_gl) < 0) THEN   ! edge interieur
        ic1 = nodedge(1,ied_gl)
        ic2 = nodedge(2,ied_gl)
c       NLOCAL = 1 => noeud sur frontiere entre des procs
        IF((nlocal(ic1,proc)==1).AND.
     .     (nlocal(ic2,proc)==1))THEN
          DO i = 1,nspmd
            edgeproc = 0
            IF(i/=proc)THEN
              IF(nlocal(ic1,i)==1.AND.
     .           nlocal(ic2,i)==1)THEN   ! arrete commune antre deux procs
                 nbddedge_l = nbddedge_l + 1
C---
                 IF(iedge_tmp(2,ied_gl) == 0)THEN
                   edgeproc = edgeproc + 1
                   iedge_tmp(1,ied_gl) = edgeproc   ! num local de l'arrete sur chaque proc
                   iedge_tmp(2,ied_gl) = 1          ! flag pour ne pas repasser cette arrete
c                  IEDGE_TMP(3,I) = IEDGE_TMP0(I)   ! flag bord libre / interieur
                 ENDIF
C---
              ENDIF
            ENDIF
          ENDDO
        END IF
       ENDIF
      ENDDO
C---
      DEALLOCATE(itag_edge)
C---
      RETURN