OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
update_weight_inter_type_24_25.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| update_weight_inter_type_24_25 ../starter/source/spmd/domain_decomposition/update_weight_inter_type_24_25.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- calls -----------------------------------------------------
28!|| i24fic_getn ../starter/source/interfaces/inter3d1/i24surfi.F
29!||--- uses -----------------------------------------------------
30!|| inter_cand_mod ../starter/share/modules1/inter_cand_mod.F
31!||====================================================================
32 SUBROUTINE update_weight_inter_type_24_25(NUMNOD,NELEMINT,INTERFACE_ID,NSN,NRTM,
33 . IFIEND,IRECT,NSV,I_STOK,CAND_E,
34 . CAND_N,DGAPLOAD,GAP_S,GAP_M,X,INTER_CAND,
35 . INTER_KIND,INTBUF_TAB,IEDGE,NLEDGE)!,ITAB)
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
234 END SUBROUTINE update_weight_inter_type_24_25
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
inter_cand_mod::inter_cand_
Definition inter_cand_mod.F:40
update_weight_inter_type_24_25
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)
Definition update_weight_inter_type_24_25.F:36