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

Go to the source code of this file.

Functions/Subroutines

subroutine tagint_r2r (g1, g2, grs, grm, id_inter, type2, val, tag, i, compt, passe, flag, igrpp_r2r, igrnod, igrsurf, igrslin, igrbric)

Function/Subroutine Documentation

◆ tagint_r2r()

subroutine tagint_r2r ( integer g1,
integer g2,
integer grs,
integer grm,
integer id_inter,
integer type2,
integer val,
integer tag,
integer i,
integer compt,
integer passe,
integer flag,
integer, dimension(2,*) igrpp_r2r,
type (group_), dimension(ngrnod) igrnod,
type (surf_), dimension(nsurf) igrsurf,
type (surf_), dimension(nslin) igrslin,
type (group_), dimension(ngrbric) igrbric )

Definition at line 30 of file tagint_r2r.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE r2r_mod
37 USE groupdef_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "r2r_c.inc"
46#include "com04_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER G1,G2,TAG,TYPE2,VAL,I,
51 . GRS,GRM,ID_INTER,COMPT,PASSE,NBTOT,FLAG,IGRPP_R2R(2,*)
52C-----------------------------------------------
53 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
54 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
55 TYPE (SURF_) , DIMENSION(NSLIN) :: IGRSLIN
56 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER J,TAG2,NF1,NF2,NF1T,NF2T,W
61 INTEGER N_SURFP,N_SURFT,N_NP,N_NT,N_NS
62 INTEGER N_SURFP2,N_SURFT2,I1,I2,N_GRBP,N_GRBT
63 INTEGER N_LINP,N_LINT,N_LINP2,N_LINT2
64C=======================================================================
65C--> Main domain : domain in which contact between domains is treated - where void elts are generated
66C--> Second. domain : domain in which contact between domains is not treated
67C=======================================================================
68C--> TAG = -1 : external interface for current domain
69C--> TAG = 0 : internal interface for current domain
70C--> TAG = 1 : interf. between 2 domains - general case
71C--> TAG = 2 : interf. between 2 domains - main side is only main side of contact interface
72C--> TAG = 3 : interf. between 2 domains - main side is only second. side of contact interface
73C--> TAG = 4 : interf. type2 between 2 domains
74C=======================================================================
75C--> N_np = nb of nodes only in the main domain
76C--> N_nt = N_np + nb of common nodes between domains
77C--> N_ns = nb of nodes in second. domain
78C--> N_surfp = nb of segments only in main domain
79C--> N_surft = Nb_surfp + nb of common segments between domains
80C=======================================================================
81
82 g1 = 0
83 g2 = 0
84 tag = 1
85 tag2 = 1
86
87C--------------------------------------------------------------------C
88C------------FLAG = 0 --> surface / nodes interfaces ----------------C
89C--------------------------------------------------------------------C
90
91 IF (flag==0) THEN
92
93C--> determination of group of secondary nodes and surface of main elements <---
94 DO j=1,ngrnod
95 IF (igrnod(j)%ID==grs) g1 = j
96 END DO
97 DO j=1,nsurf
98 IF (igrsurf(j)%ID==grm) g2 = j
99 END DO
100
101C--> error - error message will be printed in the reading of the interfaces <---
102 IF ((g1==0).OR.(g2==0)) GOTO 149
103
104 IF (igrnod(g1)%R2R_ALL==0) tag2 = 0
105 IF ((isurf_r2r(1,g2)+isurf_r2r(2,g2))==0) tag2 = 0
106
107 IF (iddom/=0) THEN
108C--> treatment of the main side <---
109 val = 1
110 w = 1
111 n_np = igrnod(g1)%NENTITY-igrnod(g1)%R2R_SHARE+igrpp_r2r(1,g1)
112 n_nt = igrnod(g1)%R2R_ALL-igrpp_r2r(2,g1)
113 n_ns = igrnod(g1)%R2R_SHARE-igrpp_r2r(1,g1)
114 n_surfp = isurf_r2r(2,g2)+isurf_r2r(4,g2)
115 n_surft = isurf_r2r(1,g2)-isurf_r2r(5,g2)
116 ELSE
117C--> treatment of the second. side <---
118 val = 0
119 w=0
120 n_np = igrnod(g1)%NENTITY-igrnod(g1)%R2R_ALL+igrpp_r2r(2,g1)
121 n_nt = igrnod(g1)%R2R_SHARE-igrpp_r2r(1,g1)
122 n_ns = igrnod(g1)%R2R_ALL-igrpp_r2r(2,g1)
123 n_surfp = igrsurf(g2)%NSEG-isurf_r2r(1,g2)+isurf_r2r(5,g2)
124 n_surft = igrsurf(g2)%NSEG-isurf_r2r(2,g2)-isurf_r2r(4,g2)
125 ENDIF
126
127C--> determination of the tag <---
128 IF (type2==1) n_np = n_nt
129 IF ((n_np==0).AND.(n_surfp>0)) tag=2
130 IF ((n_np/=0).AND.(n_surfp==0)) tag=3
131 IF ((n_ns==igrnod(g1)%NENTITY).AND.(n_surfp==0)) tag=-w
132 IF (flg_swale==0) THEN
133 IF ((n_nt==igrnod(g1)%NENTITY).AND.(n_surft==igrsurf(g2)%NSEG)) tag=w-1
134 ENDIF
135
136C--> Interfaces TYPE2 <---
137 IF (type2==1) THEN
138 IF (((n_nt>0).AND.(n_ns>0)).OR.(tag>0)) THEN
139 tag = 4
140 val = -100
141 ENDIF
142 ENDIF
143
144C--> detection of splitted interfaces for printout of warnings <---
145 IF ((tag>0).AND.(tag2>0).AND.(tag<4)) THEN
146 w = isurf_r2r(1,g2)+isurf_r2r(2,g2)-isurf_r2r(5,g2)
147 IF (((igrnod(g1)%R2R_ALL-igrpp_r2r(2,g1))/=igrnod(g1)%NENTITY)
148 . .OR.(w/=igrsurf(g2)%NSEG)) THEN
149 tagint_warn(1)=tagint_warn(1)+1
150 tagint_warn(1+tagint_warn(1)) = id_inter
151 ENDIF
152 ENDIF
153
154C--------------------------------------------------------------------C
155C------------FLAG = 1 --> surface / surface interfaces --------------C
156C--------------------------------------------------------------------C
157
158 ELSEIF (flag==1) THEN
159
160 DO j=1,nsurf
161 IF (igrsurf(j)%ID==grs) g1 = j
162 END DO
163 DO j=1,nsurf
164 IF (igrsurf(j)%ID==grm) g2 = j
165 END DO
166
167C--> error - error message will be printed in the reading of the interfaces <---
168 IF ((g1==0).OR.(g2==0)) GOTO 149
169
170 i1 = igrsurf(g1)%NSEG
171 i2 = igrsurf(g2)%NSEG
172 tag = 1
173 tag2 = 1
174 IF ((isurf_r2r(1,g1))==0) tag2=0
175 IF ((isurf_r2r(1,g2))==0) tag2=0
176
177 IF (iddom/=0) THEN
178C--> treatment of the main side <---
179 w = 1
180 val = 1
181 n_surfp=isurf_r2r(2,g1)+isurf_r2r(4,g1)
182 n_surfp2=isurf_r2r(2,g2)+isurf_r2r(4,g2)
183 n_surft=isurf_r2r(1,g1)-isurf_r2r(5,g1)
184 n_surft2=isurf_r2r(1,g2)-isurf_r2r(5,g2)
185 ELSE
186C--> treatment of the second. side <---
187 w = 0
188 val = 0
189 n_surfp=igrsurf(g1)%NSEG-isurf_r2r(1,g1)+isurf_r2r(5,g1)
190 n_surfp2=igrsurf(g2)%NSEG-isurf_r2r(1,g2)+isurf_r2r(5,g2)
191 n_surft=igrsurf(g1)%NSEG-isurf_r2r(2,g1)-isurf_r2r(4,g1)
192 n_surft2=igrsurf(g2)%NSEG-isurf_r2r(2,g2)-isurf_r2r(4,g2)
193 ENDIF
194
195C--> determination of the tag <---
196 IF ((n_surfp==0).AND.(n_surfp2>0)) tag=2
197 IF ((n_surfp>0).AND.(n_surfp2==0)) tag=3
198 IF ((n_surfp==0).AND.(n_surfp2==0)) tag=-w
199 IF (flg_swale==0) THEN
200 IF ((n_surft==i1).AND.(n_surft2==i2)) tag=w-1
201 ENDIF
202
203C--> detection of splitted interfaces for printout of warnings <---
204 IF ((tag>0).AND.(tag2>0)) THEN
205 IF ((n_surft/=i1).OR.(n_surft2/=i2)) THEN
206 tagint_warn(1)=tagint_warn(1)+1
207 tagint_warn(1+tagint_warn(1)) = id_inter
208 ENDIF
209 ENDIF
210
211C--------------------------------------------------------------------C
212C------------FLAG = 2 --> line / line interfaces --------------------C
213C--------------------------------------------------------------------C
214
215 ELSEIF (flag==2) THEN
216
217 DO j=1,nslin
218 IF (igrslin(j)%ID==grs) g1 = j
219 END DO
220 DO j=1,nslin
221 IF (igrslin(j)%ID==grm) g2 = j
222 END DO
223
224C--> error - error message will be printed in the reading of the interfaces <---
225 IF ((g1==0).OR.(g2==0)) GOTO 149
226
227 i1 = igrslin(g1)%NSEG
228 i2 = igrslin(g2)%NSEG
229 tag = 1
230 tag2 = 1
231 IF ((islin_r2r(1,g1))==0) tag2=0
232 IF ((islin_r2r(1,g2))==0) tag2=0
233
234 IF (iddom/=0) THEN
235C--> treatment of the main side <---
236 w = 1
237 val = 1
238 n_linp=islin_r2r(2,g1)
239 n_linp2=islin_r2r(2,g2)
240 n_lint=islin_r2r(1,g1)
241 n_lint2=islin_r2r(1,g2)
242 ELSE
243C--> treatment of the second. side <---
244 w = 0
245 val = 0
246 n_linp=igrslin(g1)%NSEG-islin_r2r(1,g1)
247 n_linp2=igrslin(g2)%NSEG-islin_r2r(1,g2)
248 n_lint=igrslin(g1)%NSEG-islin_r2r(2,g1)
249 n_lint2=igrslin(g2)%NSEG-islin_r2r(2,g2)
250 ENDIF
251
252C--> determination of the tag <---
253 IF ((n_linp==0).AND.(n_linp2>0)) tag=2
254 IF ((n_linp>0).AND.(n_linp2==0)) tag=3
255 IF ((n_linp==0).AND.(n_linp2==0)) tag=-w
256 IF (flg_swale==0) THEN
257 IF ((n_lint==i1).AND.(n_lint2==i2)) tag=w-1
258 ENDIF
259
260C--> detection of splitted interfaces for printout of warnings <---
261 IF ((tag>0).AND.(tag2>0)) THEN
262 IF ((n_lint/=i1).OR.(n_lint2/=i2)) THEN
263 tagint_warn(1)=tagint_warn(1)+1
264 tagint_warn(1+tagint_warn(1)) = id_inter
265 ENDIF
266 ENDIF
267
268C--------------------------------------------------------------------C
269C------------FLAG = 3 --> TYPE18 contact with GR_BRIC ---------------C
270C--------------------------------------------------------------------C
271
272 ELSEIF (flag==3) THEN
273
274 DO j=1,ngrbric
275 IF (igrbric(j)%ID==grs) g1 = j
276 END DO
277 DO j=1,nsurf
278 IF (igrsurf(j)%ID==grm) g2 = j
279 END DO
280
281C--> error - error message will be printed in the reading of the interfaces <--
282 IF ((g1==0).OR.(g2==0)) GOTO 149
283
284 i1 = igrbric(g1)%NENTITY
285 i2 = igrsurf(g2)%NSEG
286 tag = 1
287 tag2 = 1
288 IF ((igrbric_r2r(1,g1))==0) tag2=0
289 IF ((isurf_r2r(1,g2))==0) tag2=0
290
291 IF (iddom/=0) THEN
292C--> treatment of the main side <---
293 w = 1
294 val = 1
295 n_grbp=igrbric_r2r(2,g1)+igrbric_r2r(4,g1)
296 n_surfp2=isurf_r2r(2,g2)+isurf_r2r(4,g2)
297 n_grbt=igrbric_r2r(1,g1)-igrbric_r2r(5,g1)
298 n_surft2=isurf_r2r(1,g2)-isurf_r2r(5,g2)
299 ELSE
300C--> treatment of the second. side <---
301 w = 0
302 val = 0
303 n_grbp=igrbric(g1)%NENTITY-igrbric_r2r(1,g1)+igrbric_r2r(5,g1)
304 n_surfp2=igrsurf(g2)%NSEG-isurf_r2r(1,g2)+isurf_r2r(5,g2)
305 n_grbt=igrbric(g1)%NENTITY-igrbric_r2r(2,g1)-igrbric_r2r(4,g1)
306 n_surft2=igrsurf(g2)%NSEG-isurf_r2r(2,g2)-isurf_r2r(4,g2)
307 ENDIF
308
309C--> determination of the tag <---
310 IF ((n_grbp==0).AND.(n_surfp2>0)) tag=2
311 IF ((n_grbp>0).AND.(n_surfp2==0)) tag=3
312 IF ((n_grbp==0).AND.(n_surfp2==0)) tag=-w
313 IF (flg_swale==0) THEN
314 IF ((n_grbt==i1).AND.(n_surft2==i2)) tag=w-1
315 ENDIF
316
317C--> detection of splitted interfaces for printout of warnings <---
318 IF ((tag>0).AND.(tag2>0)) THEN
319 IF ((n_grbt/=i1).OR.(n_surft2/=i2)) THEN
320 tagint_warn(1)=tagint_warn(1)+1
321 tagint_warn(1+tagint_warn(1)) = id_inter
322 ENDIF
323 ENDIF
324
325 ENDIF
326
327C--------------------------------------------------------------------C
328C--------TAG OF CONTACT INTERFACES IN TAGINT FOR SPLIT---------------C
329C--------------------------------------------------------------------C
330
331C--> if one side is empty interface is not kept <---
332 IF ((tag2>0).AND.(tag>-1)) GOTO 149
333
334 GOTO 150
335
336C--> tag and counting for contact interfaces that will be kept <---
337149 tagint(i) = id_inter
338 compt = compt+1
339
340150 CONTINUE
341
342C-----------
343 RETURN
groupdef_mod
Definition groupdef_mod.F:662
r2r_mod
Definition r2r_mod.F:125
r2r_mod::igrbric_r2r
integer, dimension(:,:), allocatable igrbric_r2r
Definition r2r_mod.F:143
r2r_mod::tagint
integer, dimension(:), allocatable tagint
Definition r2r_mod.F:132
r2r_mod::isurf_r2r
integer, dimension(:,:), allocatable isurf_r2r
Definition r2r_mod.F:143
r2r_mod::tagint_warn
integer, dimension(:), allocatable tagint_warn
Definition r2r_mod.F:137
r2r_mod::islin_r2r
integer, dimension(:,:), allocatable islin_r2r
Definition r2r_mod.F:143