c_iebcs.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    c_iebcs    ../starter/source/restart/ddsplit/c_iebcs.F
!||--- called by ------------------------------------------------------
!||    ddsplit    ../starter/source/restart/ddsplit/ddsplit.F
!||--- calls      -----------------------------------------------------
!||    iface      ../starter/source/ale/ale3d/iface.F
!||--- uses       -----------------------------------------------------
!||====================================================================
       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)
       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
      END SUBROUTINE c_iebcs