OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
update_weight_inter_type_24_25.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine update_weight_inter_type_24_25 (numnod, nelemint, interface_id, nsn, nrtm, ifiend, irect, nsv, i_stok, cand_e, cand_n, dgapload, gap_s, gap_m, x, inter_cand, inter_kind, intbuf_tab, iedge, nledge)

Function/Subroutine Documentation

◆ update_weight_inter_type_24_25()

subroutine update_weight_inter_type_24_25 ( integer, intent(in) numnod,
integer, intent(inout) nelemint,
integer, intent(in) interface_id,
integer, intent(in) nsn,
integer, intent(in) nrtm,
integer, intent(inout) ifiend,
integer, dimension(4,nrtm) irect,
integer, dimension(nsn) nsv,
integer, intent(in) i_stok,
integer, dimension(i_stok), intent(in) cand_e,
integer, dimension(i_stok), intent(in) cand_n,
intent(in) dgapload,
dimension(nsn) gap_s,
dimension(nrtm) gap_m,
intent(in) x,
type(inter_cand_), intent(inout) inter_cand,
integer, intent(in) inter_kind,
type(intbuf_struct_), intent(in) intbuf_tab,
integer, intent(in) iedge,
integer, intent(in) nledge )
Parameters
[in]interface_idinterface id
[in]nsnnumber of S node
[in]nrtmnumber of segment
[in,out]ifiend???
irectlist of M nodes for the NRTM segments
nsvlist of S nodes
[in]i_stoktotal number of pair of candidate
[in]numnodnumber of node
[in]cand_esegment id of the candidate I
[in]cand_npointer to the S node id of the candidate I
[in]inter_kindkind of interface : 24 or 25
[in]iedgeedge to edge option - interface 25
[in]nledge1srt dim of LEDGE array (LEDGE array is defined as a 1d array but is used as a 2d array :( )

Definition at line 32 of file update_weight_inter_type_24_25.F.

36!$COMMENT
37! UPDATE_WEIGHT_INTER_TYPE_24_25 description :
38! save the contact data for interface type 24 and 25
39!
40! UPDATE_WEIGHT_INTER_TYPE_24_25 organization :
41! for each contact, save :
42! * 4 main node ids
43! * 1 secondary node ID
44! * 1 segment ID
45! * type of interface
46! For interface type 24 :
47! * for a fictive node, find the 2 nodes of the edge and add it to the save data
48!$ENDCOMMENT
49 USE inter_cand_mod
50 USE intbufdef_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER, INTENT(inout) :: NELEMINT
59 INTEGER, INTENT(in) :: INTERFACE_ID !< interface id
60 INTEGER, INTENT(in) :: NSN !< number of S node
61 INTEGER, INTENT(in) :: NRTM !< number of segment
62 INTEGER, INTENT(inout) :: IFIEND !< ???
63 INTEGER, DIMENSION(4,NRTM) :: IRECT !< list of M nodes for the NRTM segments
64 INTEGER, DIMENSION(NSN) :: NSV !< list of S nodes
65 INTEGER, INTENT(in) :: I_STOK !< total number of pair of candidate
66 INTEGER, INTENT(in) :: NUMNOD !< number of node
67 INTEGER, DIMENSION(I_STOK), INTENT(in) :: CAND_E !< segment id of the candidate I
68 INTEGER, DIMENSION(I_STOK), INTENT(in) :: CAND_N !< pointer to the S node id of the candidate I
69 INTEGER, INTENT(in) :: INTER_KIND !< kind of interface : 24 or 25
70 INTEGER, INTENT(in) :: IEDGE !< edge to edge option - interface 25
71 INTEGER, INTENT(in) :: NLEDGE !< 1srt dim of %LEDGE array (%LEDGE array is defined as a 1d array but is used as a 2d array :( )
72! INTEGER, DIMENSION(NUMNOD), INTENT(in) :: ITAB !< array to find the node id
73 my_real, INTENT(IN) :: dgapload !< other kind of gap
74 my_real, DIMENSION(NSN) :: gap_s !< gap of S node
75 my_real, DIMENSION(NRTM) :: gap_m!< gap of segment
76 my_real, DIMENSION(3,NUMNOD), INTENT(in) :: x
77 TYPE(INTER_CAND_), INTENT(inout) :: INTER_CAND
78 TYPE(INTBUF_STRUCT_), INTENT(in) :: INTBUF_TAB
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER :: S_NODE_ID
83 INTEGER :: S_EDGE_ID,M_EDGE_ID ! edge id
84 INTEGER :: SEGMENT_ID
85 INTEGER :: SEGMENT_ID_TYPE24 ! id of the edge for type 24 with edge to edge
86 INTEGER :: NODE_ID_1,NODE_ID_2 ! id of the 2 nodes of the edge for type 24 with edge to edge
87 INTEGER :: II,I
88 INTEGER :: IX1,IX2,IX3,IX4
89 my_real
90 . xmin,xmax,ymin,ymax,zmin,zmax,threshold,
91 . xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4
92C-----------------------------------------------
93 inter_cand%IXINT(1:inter_cand%S_IXINT_1,nelemint+1:nelemint+i_stok) = 0
94 inter_cand%ADDRESS(interface_id) = nelemint ! save the adress of the first pair
95 ! ---------------------------
96 ! loop over the S candidates
97 ii = 0
98 DO i = 1, i_stok
99 s_node_id = nsv(cand_n(i)) ! S node id
100 segment_id = cand_e(i) ! segment id
101 ! -------------
102 ! interface 24 : secondary node can be "fictive" node (ID > numnod)
103 ! a fictive node is the barycentre of an edge
104 ! --> the weight is added to the first node of the edge
105 IF (s_node_id >numnod.AND.inter_kind==24) THEN
106 s_node_id = s_node_id - numnod
107 CALL i24fic_getn(s_node_id,intbuf_tab%IRTSE,intbuf_tab%IS2SE,segment_id_type24,node_id_1,node_id_2)
108 s_node_id = node_id_1 ! add the weight to the first node of the edge
109 ENDIF
110 ! -------------
111 ii = ii +1
112
113 ! find the 4 M node id
114 ix1=irect(1,segment_id)
115 ix2=irect(2,segment_id)
116 ix3=irect(3,segment_id)
117 ix4=irect(4,segment_id)
118
119 inter_cand%IXINT(1,nelemint+ii) = ix1
120 inter_cand%IXINT(2,nelemint+ii) = ix2
121 inter_cand%IXINT(3,nelemint+ii) = ix3
122 inter_cand%IXINT(4,nelemint+ii) = ix4
123 inter_cand%IXINT(5,nelemint+ii) = s_node_id
124 inter_cand%IXINT(6,nelemint+ii) = inter_kind
125 inter_cand%IXINT(7,nelemint+ii) = segment_id
126 inter_cand%IXINT(8,nelemint+ii) = interface_id
127
128 zi = x(3,s_node_id)
129 z1=x(3,ix1)
130 z2=x(3,ix2)
131 z3=x(3,ix3)
132 z4=x(3,ix4)
133 threshold=gap_s(cand_n(i))+gap_m(cand_e(i))+dgapload
134 zmin = min(z1,z2,z3,z4)-threshold
135 zmax = max(z1,z2,z3,z4)+threshold
136 IF (zmin<=zi.AND.zmax>=zi) THEN
137 yi = x(2,s_node_id)
138 y1 = x(2,ix1)
139 y2 = x(2,ix2)
140 y3 = x(2,ix3)
141 y4 = x(2,ix4)
142 ymin = min(y1,y2,y3,y4)-threshold
143 ymax = max(y1,y2,y3,y4)+threshold
144 IF (ymin<=yi.AND.ymax>=yi) THEN
145 xi = x(1,s_node_id)
146 x1 = x(1,ix1)
147 x2 = x(1,ix2)
148 x3 = x(1,ix3)
149 x4 = x(1,ix4)
150 xmin = min(x1,x2,x3,x4)-threshold
151 xmax = max(x1,x2,x3,x4)+threshold
152 IF (xmin<=xi.AND.xmax>=xi) THEN
153 inter_cand%IXINT(6,nelemint+ii)=-inter_kind
154 ENDIF
155 ENDIF
156 ENDIF
157 ENDDO
158
159 ! ---------------------------
160 ! loop over the S edge candidates - only for the interface type 25
161 IF(inter_kind==25.AND.iedge>0) THEN
162 ! --------------------
163 ! edge to edge contact for interface 25 : part e / e
164 DO i = 1, intbuf_tab%I_STOK_E(1)
165
166 ii = ii +1
167
168 s_edge_id = intbuf_tab%CANDS_E2E(i) ! S edge id
169 m_edge_id = intbuf_tab%CANDM_E2E(i) ! M edge id
170 ! ------------
171 ! find the first node of S edge (arbitrary choice)
172 s_node_id = intbuf_tab%LEDGE((s_edge_id-1)*nledge+5)!ITAB(INTBUF_TAB%LEDGE((S_EDGE_ID-1)*NLEDGE+5))
173 ! ------------
174
175 ! ------------
176 ! find the nodes of M edge
177 ix1=intbuf_tab%LEDGE((m_edge_id-1)*nledge+5)
178 ix2=intbuf_tab%LEDGE((m_edge_id-1)*nledge+6)
179 ix3=ix1
180 ix4=ix2
181 ! ------------
182
183 inter_cand%IXINT(1,nelemint+ii) = ix1
184 inter_cand%IXINT(2,nelemint+ii) = ix2
185 inter_cand%IXINT(3,nelemint+ii) = ix3
186 inter_cand%IXINT(4,nelemint+ii) = ix4
187 inter_cand%IXINT(5,nelemint+ii) = s_node_id
188 inter_cand%IXINT(6,nelemint+ii) = inter_kind
189 inter_cand%IXINT(7,nelemint+ii) = m_edge_id
190 inter_cand%IXINT(8,nelemint+ii) = interface_id
191 ENDDO
192 ! --------------------
193
194 ! --------------------
195 ! edge to edge contact for interface 25 : part e / s
196 DO i = 1, intbuf_tab%I_STOK_E(2)
197
198 ii = ii +1
199
200 s_edge_id = intbuf_tab%CANDS_E2S(i) ! S edge id
201 segment_id = intbuf_tab%CANDM_E2S(i) ! M segment id
202 ! ------------
203 ! find the first node of S edge (arbitrary choice)
204 s_node_id = intbuf_tab%LEDGE((s_edge_id-1)*nledge+5)!ITAB(INTBUF_TAB%LEDGE((S_EDGE_ID-1)*NLEDGE+5))
205 ! ------------
206
207 ! ------------
208 ! find the 4 M node id
209 ix1=irect(1,segment_id)
210 ix2=irect(2,segment_id)
211 ix3=irect(3,segment_id)
212 ix4=irect(4,segment_id)
213 ! ------------
214
215 inter_cand%IXINT(1,nelemint+ii) = ix1
216 inter_cand%IXINT(2,nelemint+ii) = ix2
217 inter_cand%IXINT(3,nelemint+ii) = ix3
218 inter_cand%IXINT(4,nelemint+ii) = ix4
219 inter_cand%IXINT(5,nelemint+ii) = s_node_id
220 inter_cand%IXINT(6,nelemint+ii) = inter_kind
221 inter_cand%IXINT(7,nelemint+ii) = segment_id
222 inter_cand%IXINT(8,nelemint+ii) = interface_id
223 ENDDO
224 ! --------------------
225 ENDIF
226 ! ---------------------------
227 ifiend = ifiend + ii
228 ! ---------------------------
229 nelemint = nelemint + ii
230 inter_cand%ADDRESS(interface_id+1) = nelemint ! save the adress of the last pair
231 ! ---------------------------
232
233 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i24fic_getn
subroutine i24fic_getn(ns, irtse, is2se, ie, ns1, ns2)
Definition i24surfi.F:1921
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
inter_cand_mod
Definition inter_cand_mod.F:38
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841