split_ebcs.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/.
!||====================================================================
!||    split_ebcs           ../starter/source/boundary_conditions/ebcs/split_ebcs.F
!||--- called by ------------------------------------------------------
!||    ddsplit              ../starter/source/restart/ddsplit/ddsplit.F
!||--- uses       -----------------------------------------------------
!||    front_mod            ../starter/share/modules1/front_mod.F
!||    hm_option_read_mod   ../starter/share/modules1/hm_option_read_mod.F
!||    message_mod          ../starter/share/message_module/message_mod.F
!||    restmod              ../starter/share/modules1/restart_mod.F
!||    submodel_mod         ../starter/share/modules1/submodel_mod.F
!||    table_mod            ../starter/share/modules1/table_mod.F
!||====================================================================
        SUBROUTINE split_ebcs( PROC_ID,LOCAL_NEBCS,LIST_OTHER_EBCS,NUMEL,
     1                         CEP,IGRSURF,LOCAL_ELEMENT_ID,
     2                         EBCS_TAB,EBCS_TAB_LOC_2)
!$COMMENT
!       SPLIT_EBCS description
!       SPLIT_EBCS split the elements/node/data of the ebcs's surface on the different processors
!       
!       SPLIT_EBCS organization :
!       loop over the /EBCS options :
!           * loop over the elements of the surface
!               * if the element is on the current proc PROC_ID, 
!                 convert global data to local data 
!                 example : convert the global element ID to local element ID 
!                           (local = local to the PROC_ID processor)
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE front_mod
        USE unitab_mod
        USE message_mod
        USE multi_fvm_mod
        USE groupdef_mod
        USE restmod
        USE table_mod
        USE submodel_mod
        USE ale_ebcs_mod
        USE ebcs_mod
        USE hm_option_read_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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(IN) :: LOCAL_NEBCS ! number of parallelized ebcs
        INTEGER, INTENT(IN) :: NUMEL ! number of element
        INTEGER, INTENT(IN) :: PROC_ID ! processor ID
        INTEGER, DIMENSION(LOCAL_NEBCS), INTENT(IN) :: LIST_OTHER_EBCS ! list of parallelized ebcs
        INTEGER, DIMENSION(NUMEL), INTENT(IN) :: CEP ! connectivity element/proc 
        INTEGER, DIMENSION(NUMEL), INTENT(IN) :: LOCAL_ELEMENT_ID ! list of local element id (local to the current proc)
        TYPE (SURF_), DIMENSION(NSURF), TARGET, INTENT(IN) :: IGRSURF ! surface structure
        TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB,EBCS_TAB_LOC_2 ! ebcs structure
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: I,J,IJK
        INTEGER :: GLOBAL_INDEX,EBCS_ID,SURF_ID,NSEG
        INTEGER :: ELEM_ID,LOCAL_SEG
        INTEGER, DIMENSION(:,:), ALLOCATABLE :: LIST_NODE,LIST_NODE_2
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
        
        global_index = 0
        ! ---------------------------
        ! loop over the ebcs
        DO i=1,local_nebcs
            ebcs_id = list_other_ebcs(i)
            ! check if a surface is associated to the ebcs
            IF(ebcs_tab_loc_2%tab(i)%poly%surf_id > 0) THEN
                surf_id = ebcs_tab_loc_2%tab(i)%poly%surf_id ! surface id
                nseg = igrsurf(surf_id)%NSEG ! number of surface
                ! --------------
                ! allocation of global element id array : its size is overestimated
                IF(.NOT.ALLOCATED(ebcs_tab_loc_2%tab(i)%poly%global_ielem)) THEN
                    ALLOCATE( ebcs_tab_loc_2%tab(i)%poly%global_ielem(nseg) )
                ENDIF
                ! --------------
                ALLOCATE( list_node(nseg,4) )
                local_seg = 0 
                ! --------------
                ! loop over the element of the surface
                DO j = 1,nseg
                    elem_id = ebcs_tab%tab(ebcs_id)%poly%ielem(j)
                    ! --------------
                    ! check if the element is on the current PROC_ID processor
                    ! if true --> convert global data to local data
                    IF( cep(elem_id)+1 == proc_id) THEN
                        local_seg = local_seg + 1
                        global_index = global_index + 1
                        DO ijk = 1,4
                            list_node(local_seg,ijk) = igrsurf(surf_id)%NODES(j,ijk)
                        ENDDO
                        ebcs_tab_loc_2%tab(i)%poly%iseg(local_seg) = sign(ebcs_tab%tab(ebcs_id)%poly%iseg(j),global_index)
 
                        ebcs_tab_loc_2%tab(i)%poly%ielem(local_seg) = local_element_id(ebcs_tab%tab(ebcs_id)%poly%ielem(j))
                        ebcs_tab_loc_2%tab(i)%poly%itype(local_seg) = ebcs_tab%tab(ebcs_id)%poly%itype(j)
 
                        ebcs_tab_loc_2%tab(i)%poly%global_ielem(local_seg) = ebcs_tab%tab(ebcs_id)%poly%ielem(j)
                    ENDIF
                    ! --------------
                ENDDO
                ! --------------
                ALLOCATE( list_node_2(local_seg,4) )
                list_node_2(1:local_seg,1:4) = list_node(1:local_seg,1:4)
                CALL ebcs_tab_loc_2%tab(i)%poly%set_nodes_elems(local_seg, numnod, list_node_2) ! faces <-> nodes
                DEALLOCATE( list_node,list_node_2 )
            ENDIF
        ENDDO
        ! ---------------------------
        RETURN
 
        END SUBROUTINE split_ebcs