find__surface__from__remote__proc_8F_source.html

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/.

!||====================================================================

!||    find_surface_from_remote_proc   ../engine/source/interfaces/interf/find_surface_from_remote_proc.F

!||--- called by ------------------------------------------------------

!||    spmd_exch_deleted_surf_edge     ../engine/source/mpi/interfaces/spmd_exch_deleted_surf_edge.F

!||--- calls      -----------------------------------------------------

!||    check_surface_state             ../engine/source/interfaces/interf/check_surface_state.F

!||--- uses       -----------------------------------------------------

!||    element_mod                     ../common_source/modules/elements/element_mod.F90

!||    intbufdef_mod                   ../common_source/modules/interfaces/intbufdef_mod.F90

!||    nodal_arrays_mod                ../common_source/modules/nodal_arrays.F90

!||    shooting_node_mod               ../engine/share/modules/shooting_node_mod.F90

!||====================================================================


        SUBROUTINE find_surface_from_remote_proc(SHOOT_STRUCT,NB_SURFACE,LIST_NODE,INTBUF_TAB,NODES,

     .                                           IPARI,GEO,

     .                                           IXS,IXC,IXT,IXP,IXR,IXTG,IXS10,

     .                                           ADDCNEL,CNEL,TAG_NODE,TAG_ELEM )

!$COMMENT

!       FIND_SURFACE_FROM_REMOTE_PROC description

!           this routine finds the surface id from a list of remote node

!       FIND_SURFACE_FROM_REMOTE_PROC organization

!           loop over the node list:

!           - find the local node id from the global node id

!           - intersection of lists of surface for the node to obtain the surface id

!           - deactivation of the surface

!$ENDCOMMENT

        USE nodal_arrays_mod

        USE intbufdef_mod

        USE shooting_node_mod

        use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg

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"

#include      "scr17_c.inc"

#include      "param_c.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

        INTEGER, INTENT(in) :: NB_SURFACE   ! number of "surface" (ie. 4 nodes)

        INTEGER, DIMENSION(4*NB_SURFACE), INTENT(in) :: LIST_NODE   ! list of 4 nodes

        TYPE(nodal_arrays_), INTENT(INOUT) :: NODES

        TYPE(shooting_node_type), INTENT(inout) :: SHOOT_STRUCT ! structure for shooting node algo

        TYPE(intbuf_struct_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB    ! interface data


        INTEGER, DIMENSION(NIXS,NUMELS), INTENT(in) :: IXS   ! solid array

        INTEGER, DIMENSION(NIXC,NUMELC), INTENT(in) :: IXC   ! shell array

        INTEGER, DIMENSION(NIXT,NUMELT), INTENT(in) :: IXT! truss array

        INTEGER, DIMENSION(NIXP,NUMELP), INTENT(in) :: IXP! beam array

        INTEGER, DIMENSION(NIXR,NUMELR), INTENT(in) :: IXR! spring array

        INTEGER, DIMENSION(NIXTG,NUMELTG), INTENT(in) :: IXTG! triangle array

        INTEGER, DIMENSION(6,NUMELS10), INTENT(in) :: IXS10!< tetra10 data

        INTEGER, DIMENSION(0:NUMNOD+1), INTENT(in) :: ADDCNEL ! address for the CNEL array

        INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI

        my_real, DIMENSION(NPROPG,NUMGEO), INTENT(in) :: geo

        INTEGER, DIMENSION(0:LCNEL), INTENT(in) :: CNEL ! connectivity node-->element

        INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: TAG_NODE

        INTEGER, DIMENSION(NUMELS+NUMELQ+NUMELC+NUMELT+NUMELP+NUMELR+NUMELTG), INTENT(inout) :: TAG_ELEM

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

        INTEGER :: I,J,NODE_ID

        INTEGER :: NB_SURFACE_R_PROC

        INTEGER, DIMENSION(4) :: LOCAL_NODE,GLOBAL_NODE

        INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_SURFACE_R_PROC


        INTEGER :: SHIFT

        INTEGER :: NODE_SURF_NB

        INTEGER :: NB_RESULT_INTERSECT,NB_SURFACE_1,NB_SURFACE_2

        INTEGER, DIMENSION(:), ALLOCATABLE :: RESULT_INTERSECT,INTERSECT_1,INTERSECT_2

        INTEGER, DIMENSION(:), ALLOCATABLE :: TMP_ARRAY

C-----------------------------------------------

C   E x t e r n a l   F u n c t i o n s

C-----------------------------------------------

C-----------------------------------------------

        ALLOCATE( list_surface_r_proc(4*nb_surface) )

        nb_surface_r_proc = 0


        ! --------------------------

        ! working array : surface

        ALLOCATE( result_intersect( shoot_struct%MAX_SURF_NB ) )

        ALLOCATE( intersect_1( shoot_struct%MAX_SURF_NB ) )

        ALLOCATE( intersect_2( shoot_struct%MAX_SURF_NB ) )


        DO i=1,nb_surface

            global_node(1:4) = list_node( (i-1)*4+1:(i-1)*4+4)

            DO j=1,4

                local_node(j) = get_local_node_id(nodes,global_node(j))

            ENDDO

            node_id = local_node(1)    ! get the node ID


            nb_result_intersect = shoot_struct%SHIFT_M_NODE_SURF(node_id+1) - shoot_struct%SHIFT_M_NODE_SURF(node_id)   ! get the number of surface of the node

            shift = shoot_struct%SHIFT_M_NODE_SURF(node_id)

            result_intersect(1:nb_result_intersect) = shoot_struct%M_NODE_SURF( shift+1:shift+nb_result_intersect )


            node_surf_nb = 4

            IF(local_node(3)==local_node(4)) node_surf_nb = 3


            DO j=2,node_surf_nb

                nb_surface_1 = nb_result_intersect

                intersect_1(1:nb_surface_1) = result_intersect(1:nb_result_intersect)

                node_id = local_node(j)    ! get the node ID

                ! -----------------------

                ! intersection of surface

                nb_surface_2 = shoot_struct%SHIFT_M_NODE_SURF(node_id+1) - shoot_struct%SHIFT_M_NODE_SURF(node_id)   ! get the number of surface of the node

                shift = shoot_struct%SHIFT_M_NODE_SURF(node_id)

                intersect_2(1:nb_surface_2) = shoot_struct%M_NODE_SURF( shift+1:shift+nb_surface_2 )

                IF(nb_surface_1>0.AND.nb_surface_2>0) THEN

                    CALL intersect_2_sorted_sets( intersect_1,nb_surface_1,

     .                                            intersect_2,nb_surface_2,

     .                                            result_intersect,nb_result_intersect )

                ELSE

                    nb_result_intersect = 0

                ENDIF

                ! end : intersection of surface

                ! -----------------------

            ENDDO

            IF(nb_surface_r_proc + nb_result_intersect > SIZE(list_surface_r_proc) ) THEN

                ALLOCATE( tmp_array(nb_surface_r_proc) )

                tmp_array(1:nb_surface_r_proc) = list_surface_r_proc(1:nb_surface_r_proc)

                DEALLOCATE( list_surface_r_proc )

                ALLOCATE( list_surface_r_proc( (nb_surface_r_proc+nb_result_intersect) * 2 ) )

                list_surface_r_proc(1:nb_surface_r_proc) = tmp_array(1:nb_surface_r_proc)

                DEALLOCATE( tmp_array )

            ENDIF


            list_surface_r_proc(1+nb_surface_r_proc:nb_surface_r_proc+nb_result_intersect) =

     .            result_intersect(1:nb_result_intersect)

            nb_surface_r_proc = nb_surface_r_proc + nb_result_intersect

        ENDDO


        CALL check_surface_state( -1,nb_surface_r_proc,list_surface_r_proc,shoot_struct%SHIFT_INTERFACE,intbuf_tab,

     .                            ipari,geo,

     .                            ixs,ixc,ixt,ixp,ixr,ixtg,ixs10,

     .                            addcnel,cnel,tag_node,tag_elem,shoot_struct )


        DEALLOCATE( list_surface_r_proc )

        DEALLOCATE( result_intersect )

        DEALLOCATE( intersect_1 )

        DEALLOCATE( intersect_2 )


        RETURN


        END SUBROUTINE find_surface_from_remote_proc

check_surface_state
subroutine check_surface_state(itask, surfarce_nb, surface_id, shift_interface, intbuf_tab, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem, shoot_struct)
Definition check_surface_state.F:40

my_real
#define my_real
Definition cppsort.cpp:32

find_surface_from_remote_proc
subroutine find_surface_from_remote_proc(shoot_struct, nb_surface, list_node, intbuf_tab, nodes, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem)
Definition find_surface_from_remote_proc.F:39