c_iebcs.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	c_iebcs (ixs, ixq, ixtg, numels, numelq, numeltg, nebcs, cep, numel, proc, iebcs_nelem_l, iebcs_type, iebcs_listelem_l, iebcs_listfac_l, iebcs_listdp0_l, length, n2d, multi_fvm_is_used, flag, ebcs_tab)

Function/Subroutine Documentation

c_iebcs()

subroutine c_iebcs	(	integer, dimension(nixs, numels), intent(in), target	ixs,
		integer, dimension(nixq, numelq), intent(in), target	ixq,
		integer, dimension(nixtg, numeltg), intent(in), target	ixtg,
		integer, intent(in), target	numels,
		integer, intent(in), target	numelq,
		integer, intent(in), target	numeltg,
		integer, intent(in)	nebcs,
		integer, dimension(*), intent(in)	cep,
		integer, intent(in)	numel,
		integer, intent(in)	proc,
		integer, dimension(nebcs), intent(inout)	iebcs_nelem_l,
		integer, dimension(nebcs), intent(inout)	iebcs_type,
		integer, dimension(*), intent(inout)	iebcs_listelem_l,
		integer, dimension(*), intent(inout)	iebcs_listfac_l,
		dimension(*), intent(inout)	iebcs_listdp0_l,
		integer, intent(inout)	length,
		integer, intent(in)	n2d,
		logical, intent(in)	multi_fvm_is_used,
		integer, intent(in)	flag,
		type(t_ebcs_tab), intent(in), target	ebcs_tab )

Definition at line 31 of file c_iebcs.F.

       USE ebcs_mod
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN), TARGET :: IXS(NIXS, NUMELS), IXQ(NIXQ, NUMELQ), IXTG(NIXTG, NUMELTG),
     .     NUMELS, NUMELQ, NUMELTG
      INTEGER, INTENT(IN) :: NEBCS, CEP(*), NUMEL, PROC, N2D
      INTEGER, INTENT(INOUT) :: LENGTH, IEBCS_NELEM_L(NEBCS), IEBCS_TYPE(NEBCS), 
     .     IEBCS_LISTELEM_L(*), IEBCS_LISTFAC_L(*)
      my_real, INTENT(INOUT) :: iebcs_listdp0_l(*)
      LOGICAL, INTENT(IN) :: MULTI_FVM_IS_USED
      INTEGER, INTENT(IN) :: FLAG ! 0 = count, 1 = fill 
      TYPE(t_ebcs_tab), TARGET, INTENT(IN) :: EBCS_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------   
      INTEGER :: I, KK, TYP, JBUF, K1, K2, K3, NSEG, NSEG_L, IELEM, ELEM_ID, ISEG
      INTEGER :: II
      INTEGER, DIMENSION(:), ALLOCATABLE  :: LOCALID
      INTEGER, DIMENSION(:, :), POINTER :: IX
      my_real :: dp0
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------   
      ALLOCATE(localid(numel))
      IF (n2d == 0) THEN
         ix => ixs(1:nixs, 1:numels)
      ELSEIF(numelq /= 0) THEN
         ix => ixq(1:nixq, 1:numelq)
      ELSEIF (numeltg /= 0 .AND. multi_fvm_is_used) THEN
         ix => ixtg(1:nixtg, 1:numeltg)
      ENDIF
         
      
      ielem = 0
      DO i = 1, numel
         IF (cep(i) == proc) THEN
            ielem = ielem + 1
            localid(i) = ielem
         ENDIF
      ENDDO
 
      length = 0
 
      ! ----------------------------
      ! loop over the ebcs
      DO i = 1, nebcs
         typ = ebcs_tab%tab(i)%poly%type
         iebcs_type(i) = typ
         nseg = ebcs_tab%tab(i)%poly%nb_elem
         nseg_l = 0
         ! ---------------------   
         IF (ebcs_tab%tab(i)%poly%has_ielem ) THEN  
            ! --------------------- 
            ! loop over the element of the surface
            DO iseg = 1, nseg
               ielem = ebcs_tab%tab(i)%poly%ielem(iseg)
               dp0=zero
               IF(ebcs_tab%tab(i)%poly%has_dp0) dp0 = ebcs_tab%tab(i)%poly%dp0(iseg)
               ! --------------
               ! if the element is on the current proc, convert the global id IELEM/iface(ISEG) to local id
               IF (cep(ielem)  == proc) THEN
                    nseg_l = nseg_l + 1
                    IF(flag == 1) THEN
                       iebcs_listelem_l(length + nseg_l) = localid(ielem) ! element id
                       iebcs_listfac_l(length + nseg_l) = ebcs_tab%tab(i)%poly%iface(iseg) ! face id
                       iebcs_listdp0_l(length + nseg_l) = dp0
                    ENDIF
               ENDIF
               ! --------------
            ENDDO
            ! --------------------- 
         ENDIF
         ! --------------------- 
         iebcs_nelem_l(i) = nseg_l
         length = length + nseg_l
      ENDDO ! I = 1, NEBCS
      ! ----------------------------
 
      DEALLOCATE(localid)
      RETURN