OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
find_surface_from_remote_proc.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ find_surface_from_remote_proc()

subroutine find_surface_from_remote_proc ( type(shooting_node_type), intent(inout) shoot_struct,
integer, intent(in) nb_surface,
integer, dimension(4*nb_surface), intent(in) list_node,
type(intbuf_struct_), dimension(ninter), intent(inout) intbuf_tab,
type(nodal_arrays_), intent(inout) nodes,
integer, dimension(npari,ninter), intent(in) ipari,
intent(in) geo,
integer, dimension(nixs,numels), intent(in) ixs,
integer, dimension(nixc,numelc), intent(in) ixc,
integer, dimension(nixt,numelt), intent(in) ixt,
integer, dimension(nixp,numelp), intent(in) ixp,
integer, dimension(nixr,numelr), intent(in) ixr,
integer, dimension(nixtg,numeltg), intent(in) ixtg,
integer, dimension(6,numels10), intent(in) ixs10,
integer, dimension(0:numnod+1), intent(in) addcnel,
integer, dimension(0:lcnel), intent(in) cnel,
integer, dimension(numnod), intent(inout) tag_node,
integer, dimension(numels+numelq+numelc+numelt+numelp+numelr+numeltg), intent(inout) tag_elem )
Parameters
[in]ixs10tetra10 data

Definition at line 35 of file find_surface_from_remote_proc.F.

39!$COMMENT
40! FIND_SURFACE_FROM_REMOTE_PROC description
41! this routine finds the surface id from a list of remote node
42! FIND_SURFACE_FROM_REMOTE_PROC organization
43! loop over the node list:
44! - find the local node id from the global node id
45! - intersection of lists of surface for the node to obtain the surface id
46! - deactivation of the surface
47!$ENDCOMMENT
48 USE nodal_arrays_mod
49 USE intbufdef_mod
50 USE shooting_node_mod
51 use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com04_c.inc"
60#include "scr17_c.inc"
61#include "param_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER, INTENT(in) :: NB_SURFACE ! number of "surface" (ie. 4 nodes)
66 INTEGER, DIMENSION(4*NB_SURFACE), INTENT(in) :: LIST_NODE ! list of 4 nodes
67 TYPE(nodal_arrays_), INTENT(INOUT) :: NODES
68 TYPE(shooting_node_type), INTENT(inout) :: SHOOT_STRUCT ! structure for shooting node algo
69 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB ! interface data
70
71 INTEGER, DIMENSION(NIXS,NUMELS), INTENT(in) :: IXS ! solid array
72 INTEGER, DIMENSION(NIXC,NUMELC), INTENT(in) :: IXC ! shell array
73 INTEGER, DIMENSION(NIXT,NUMELT), INTENT(in) :: IXT! truss array
74 INTEGER, DIMENSION(NIXP,NUMELP), INTENT(in) :: IXP! beam array
75 INTEGER, DIMENSION(NIXR,NUMELR), INTENT(in) :: IXR! spring array
76 INTEGER, DIMENSION(NIXTG,NUMELTG), INTENT(in) :: IXTG! triangle array
77 INTEGER, DIMENSION(6,NUMELS10), INTENT(in) :: IXS10!< tetra10 data
78 INTEGER, DIMENSION(0:NUMNOD+1), INTENT(in) :: ADDCNEL ! address for the CNEL array
79 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI
80 my_real, DIMENSION(NPROPG,NUMGEO), INTENT(in) :: geo
81 INTEGER, DIMENSION(0:LCNEL), INTENT(in) :: CNEL ! connectivity node-->element
82 INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: TAG_NODE
83 INTEGER, DIMENSION(NUMELS+NUMELQ+NUMELC+NUMELT+NUMELP+NUMELR+NUMELTG), INTENT(inout) :: TAG_ELEM
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER :: I,J,NODE_ID
88 INTEGER :: NB_SURFACE_R_PROC
89 INTEGER, DIMENSION(4) :: LOCAL_NODE,GLOBAL_NODE
90 INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_SURFACE_R_PROC
91
92 INTEGER :: SHIFT
93 INTEGER :: NODE_SURF_NB
94 INTEGER :: NB_RESULT_INTERSECT,NB_SURFACE_1,NB_SURFACE_2
95 INTEGER, DIMENSION(:), ALLOCATABLE :: RESULT_INTERSECT,INTERSECT_1,INTERSECT_2
96 INTEGER, DIMENSION(:), ALLOCATABLE :: TMP_ARRAY
97C-----------------------------------------------
98C E x t e r n a l F u n c t i o n s
99C-----------------------------------------------
100C-----------------------------------------------
101 ALLOCATE( list_surface_r_proc(4*nb_surface) )
102 nb_surface_r_proc = 0
103
104 ! --------------------------
105 ! working array : surface
106 ALLOCATE( result_intersect( shoot_struct%MAX_SURF_NB ) )
107 ALLOCATE( intersect_1( shoot_struct%MAX_SURF_NB ) )
108 ALLOCATE( intersect_2( shoot_struct%MAX_SURF_NB ) )
109
110
111 DO i=1,nb_surface
112 global_node(1:4) = list_node( (i-1)*4+1:(i-1)*4+4)
113 DO j=1,4
114 local_node(j) = get_local_node_id(nodes,global_node(j))
115 ENDDO
116 node_id = local_node(1) ! get the node ID
117
118 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
119 shift = shoot_struct%SHIFT_M_NODE_SURF(node_id)
120 result_intersect(1:nb_result_intersect) = shoot_struct%M_NODE_SURF( shift+1:shift+nb_result_intersect )
121
122 node_surf_nb = 4
123 IF(local_node(3)==local_node(4)) node_surf_nb = 3
124
125 DO j=2,node_surf_nb
126 nb_surface_1 = nb_result_intersect
127 intersect_1(1:nb_surface_1) = result_intersect(1:nb_result_intersect)
128 node_id = local_node(j) ! get the node ID
129 ! -----------------------
130 ! intersection of surface
131 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
132 shift = shoot_struct%SHIFT_M_NODE_SURF(node_id)
133 intersect_2(1:nb_surface_2) = shoot_struct%M_NODE_SURF( shift+1:shift+nb_surface_2 )
134 IF(nb_surface_1>0.AND.nb_surface_2>0) THEN
135 CALL intersect_2_sorted_sets( intersect_1,nb_surface_1,
136 . intersect_2,nb_surface_2,
137 . result_intersect,nb_result_intersect )
138 ELSE
139 nb_result_intersect = 0
140 ENDIF
141 ! end : intersection of surface
142 ! -----------------------
143 ENDDO
144 IF(nb_surface_r_proc + nb_result_intersect > SIZE(list_surface_r_proc) ) THEN
145 ALLOCATE( tmp_array(nb_surface_r_proc) )
146 tmp_array(1:nb_surface_r_proc) = list_surface_r_proc(1:nb_surface_r_proc)
147 DEALLOCATE( list_surface_r_proc )
148 ALLOCATE( list_surface_r_proc( (nb_surface_r_proc+nb_result_intersect) * 2 ) )
149 list_surface_r_proc(1:nb_surface_r_proc) = tmp_array(1:nb_surface_r_proc)
150 DEALLOCATE( tmp_array )
151 ENDIF
152
153 list_surface_r_proc(1+nb_surface_r_proc:nb_surface_r_proc+nb_result_intersect) =
154 . result_intersect(1:nb_result_intersect)
155 nb_surface_r_proc = nb_surface_r_proc + nb_result_intersect
156 ENDDO
157
158 CALL check_surface_state( -1,nb_surface_r_proc,list_surface_r_proc,shoot_struct%SHIFT_INTERFACE,intbuf_tab,
159 . ipari,geo,
160 . ixs,ixc,ixt,ixp,ixr,ixtg,ixs10,
161 . addcnel,cnel,tag_node,tag_elem,shoot_struct )
162
163 DEALLOCATE( list_surface_r_proc )
164 DEALLOCATE( result_intersect )
165 DEALLOCATE( intersect_1 )
166 DEALLOCATE( intersect_2 )
167
168 RETURN
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