OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tagelem_r2r.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!|| tagelem_r2r ../starter/source/coupling/rad2rad/tagelem_r2r.F
25!||--- called by ------------------------------------------------------
26!|| r2r_split ../starter/source/coupling/rad2rad/r2r_split.F
27!||====================================================================
28 SUBROUTINE tagelem_r2r(NUMEL,IPART,TAGBUF,NPART)
29C-----------------------------------------------
30C I m p l i c i t T y p e s
31C-----------------------------------------------
32#include "implicit_f.inc"
33C-----------------------------------------------
34C D u m m y A r g u m e n t s
35C-----------------------------------------------
36 INTEGER NUMEL,IPART(*),TAGBUF(*),NPART
37C-----------------------------------------------
38C L o c a l V a r i a b l e s
39C-----------------------------------------------
40 INTEGER J
41C=======================================================================
42
43 DO j=1,numel
44 IF (tagbuf(ipart(j)) == 1)THEN
45 tagbuf(j+npart)=tagbuf(j+npart)+1
46 ENDIF
47 ENDDO
48
49C-----------
50 RETURN
51 END SUBROUTINE tagelem_r2r
52
53!||====================================================================
54!|| tag_elem_void_r2r ../starter/source/coupling/rad2rad/tagelem_r2r.F
55!||--- called by ------------------------------------------------------
56!|| r2r_prelec ../starter/source/coupling/rad2rad/r2r_prelec.F
57!||--- calls -----------------------------------------------------
58!|| modif_tag ../starter/source/coupling/rad2rad/routines_r2r.F
59!||--- uses -----------------------------------------------------
60!|| nod2el_mod ../starter/share/modules1/nod2el_mod.F
61!|| r2r_mod ../starter/share/modules1/r2r_mod.F
62!|| restmod ../starter/share/modules1/restart_mod.F
63!||====================================================================
64 SUBROUTINE tag_elem_void_r2r(NB,IPARTS,IPARTC,IPARTG,
65 2 IPARTSP,VAL,CONT,MODIF,ITAGL,F2,FLAG,EANI2,
66 3 IGRSURF,IGRNOD,GR_ID)
67C-----------------------------------------------
68C M o d u l e s
69C-----------------------------------------------
70 USE restmod
71 USE r2r_mod
72 USE nod2el_mod
73 USE groupdef_mod
74 use element_mod , only : nixs,nixc,nixtg
75C-----------------------------------------------
76C I m p l i c i t T y p e s
77C-----------------------------------------------
78#include "implicit_f.inc"
79#include "com04_c.inc"
80#include "sphcom.inc"
81C-----------------------------------------------
82C D u m m y A r g u m e n t s
83C-----------------------------------------------
84 INTEGER IPARTS(*),IPARTC(*),IPARTG(*),NB,VAL,GR_ID,
85 . FLAG,CONT,MODIF,IPARTSP(*),F2,ITAGL(*),EANI2(*)
86C-----------------------------------------------
87 TYPE (GROUP_), DIMENSION(NGRNOD) :: IGRNOD
88 TYPE (SURF_) :: IGRSURF
89C-----------------------------------------------
90C L o c a l V a r i a b l e s
91C-----------------------------------------------
92 INTEGER J,K,L,NI,FACE(4),SUM,CUR_ID,ELTAG,CUR_10,CUR_20,CUR_16,OFFSET
93C=======================================================================
94
95 IF (flag==0) THEN
96
97C--------------------------------------------------------------------C
98C---------------FLAG = 0 --> tag of the elements of the surface------C
99C--------------------------------------------------------------------C
100
101 DO j=1,nb
102 face(1) = igrsurf%NODES(j,1)
103 face(2) = igrsurf%NODES(j,2)
104 face(3) = igrsurf%NODES(j,3)
105 face(4) = igrsurf%NODES(j,4)
106 IF (face(4)==0) face(4)=face(3)
107 ni = face(1)
108 eltag = 0
109
110C------------------------> faces of solids <----------------------C
111 DO l = knod2els(ni)+1,knod2els(ni+1)
112 cur_id = nod2els(l)
113 DO k = 1,4
114 itagl(face(k)) = 0
115 END DO
116 DO k = 2,9
117 itagl(ixs(nixs*(cur_id-1)+k)) = 1
118 END DO
119 IF (eani2(cur_id)==10) THEN
120 offset = nixs*numels
121 cur_10 = cur_id-numels8
122 DO k=1,6
123 itagl(ixs(offset+6*(cur_10-1)+k)) = 1
124 ENDDO
125 ELSEIF (eani2(cur_id)==20) THEN
126 offset = nixs*numels+6*numels10
127 cur_20 = cur_id-(numels8+numels10)
128 DO k=1,12
129 itagl(ixs(offset+12*(cur_20-1)+k)) = 1
130 ENDDO
131 ELSEIF (eani2(cur_id)==16) THEN
132 offset = nixs*numels+6*numels10+12*numels20
133 cur_16 = cur_id-(numels8+numels10+numels20)
134 DO k=1,8
135 itagl(ixs(offset+8*(cur_16-1)+k)) = 1
136 ENDDO
137 ENDIF
138 sum=itagl(face(1))+itagl(face(2))+itagl(face(3))+itagl(face(4))
139 IF (sum==4) eltag = 1
140 IF ((tag_els(cur_id+npart)<(1+cont)).AND.
141 . (tagno(iparts(cur_id))/=val).AND.(sum==4)) THEN
142 CALL modif_tag(tag_els(cur_id+npart),1+cont+f2,modif)
143 ENDIF
144 END DO
145
146C------------------------> shells <--------------------------------C
147 DO l = knod2elc(ni)+1,knod2elc(ni+1)
148 cur_id = nod2elc(l)
149 DO k = 1,4
150 itagl(face(k)) = 0
151 END DO
152 DO k = 2,5
153 itagl(ixc(nixc*(cur_id-1)+k)) = 1
154 END DO
155 sum=itagl(face(1))+itagl(face(2))+itagl(face(3))+itagl(face(4))
156 IF (sum==4) eltag = 1
157 IF ((tag_elc(cur_id+npart)<(1+cont)).AND.
158 . (tagno(ipartc(cur_id))/=val).AND.(sum==4)) THEN
159 CALL modif_tag(tag_elc(cur_id+npart),1+cont+f2,modif)
160 ENDIF
161 END DO
162C------------------------> sh3n <---------------------------------C
163 DO l = knod2eltg(ni)+1,knod2eltg(ni+1)
164 cur_id = nod2eltg(l)
165 DO k = 1,4
166 itagl(face(k)) = 0
167 END DO
168 DO k = 2,4
169 itagl(ixtg(nixtg*(cur_id-1)+k)) = 1
170 END DO
171 sum=itagl(face(1))+itagl(face(2))+itagl(face(3))+itagl(face(4))
172 IF (sum==4) eltag = 1
173 IF ((tag_elg(cur_id+npart)<(1+cont)).AND.
174 . (tagno(ipartg(cur_id))/=val).AND.(sum==4)) THEN
175 CALL modif_tag(tag_elg(cur_id+npart),1+cont+f2,modif)
176 ENDIF
177 END DO
178
179C------------------------> segments without elements <------------C
180 IF (eltag==0) THEN
181 DO k = 1,4
182 IF (tagno(face(k)+npart)==-1) THEN
183 CALL modif_tag(tagno(face(k)+npart),0,modif)
184 ENDIF
185 END DO
186 ENDIF
187C
188 END DO
189
190 ELSE
191
192C--------------------------------------------------------------------C
193C---------------FLAG = 1 --> tag of the nodes of the surface---------C
194C--------------------------------------------------------------------C
195
196 DO j=1,nb
197 ni = igrnod(gr_id)%ENTITY(j)
198C------------------------> faces of solids <----------------------C
199 DO l = knod2els(ni)+1,knod2els(ni+1)
200 cur_id = nod2els(l)
201 IF ((tag_els(cur_id+npart)<(1+cont)).AND.
202 . (tagno(iparts(cur_id))/=val)) THEN
203 CALL modif_tag(tag_els(cur_id+npart),1+cont,modif)
204 ENDIF
205 END DO
206C------------------------> shells <-------------------------------C
207 DO l = knod2elc(ni)+1,knod2elc(ni+1)
208 cur_id = nod2elc(l)
209 IF ((tag_elc(cur_id+npart)<(1+cont)).AND.
210 . (tagno(ipartc(cur_id))/=val)) THEN
211 CALL modif_tag(tag_elc(cur_id+npart),1+cont,modif)
212 ENDIF
213 END DO
214C------------------------> sh3n <----------------------------------C
215 DO l = knod2eltg(ni)+1,knod2eltg(ni+1)
216 cur_id = nod2eltg(l)
217 IF ((tag_elg(cur_id+npart)<(1+cont)).AND.
218 . (tagno(ipartg(cur_id))/=val)) THEN
219 CALL modif_tag(tag_elg(cur_id+npart),1+cont,modif)
220 ENDIF
221 END DO
222C-----------------------> SPH Particles <-----------------------
223 IF (numsph>0) THEN
224 cur_id = nod2sp(ni)
225 IF ((tag_elsp(cur_id+npart)<(1+cont)).AND.
226 . (tagno(ipartsp(cur_id))/=val)) THEN
227 CALL modif_tag(tagno(ni+npart),2*(1+cont),modif)
228 ENDIF
229 ENDIF
230 END DO
231
232 ENDIF
233
234C-----------
235 RETURN
236 END SUBROUTINE tag_elem_void_r2r
237
238!||====================================================================
239!|| tag_elem_void_r2r_lin ../starter/source/coupling/rad2rad/tagelem_r2r.F
240!||--- called by ------------------------------------------------------
241!|| r2r_prelec ../starter/source/coupling/rad2rad/r2r_prelec.F
242!||--- calls -----------------------------------------------------
243!|| modif_tag ../starter/source/coupling/rad2rad/routines_r2r.F
244!|| r2r_void_1d ../starter/source/coupling/rad2rad/r2r_void.F
245!||--- uses -----------------------------------------------------
246!|| nod2el_mod ../starter/share/modules1/nod2el_mod.F
247!|| r2r_mod ../starter/share/modules1/r2r_mod.F
248!|| restmod ../starter/share/modules1/restart_mod.F
249!||====================================================================
250 SUBROUTINE tag_elem_void_r2r_lin(NB,IPARTS,
251 2 IPARTC,IPARTG,IPARTT,IPARTP,IPARTR,VAL,CONT,
252 3 MODIF,WARN,IGRSLIN)
253C-----------------------------------------------
254C M o d u l e s
255C-----------------------------------------------
256 USE restmod
257 USE r2r_mod
258 USE nod2el_mod
259 USE groupdef_mod
260 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
261C-----------------------------------------------
262C I m p l i c i t T y p e s
263C-----------------------------------------------
264#include "implicit_f.inc"
265#include "com04_c.inc"
266C-----------------------------------------------
267C D u m m y A r g u m e n t s
268C-----------------------------------------------
269 INTEGER IPARTS(*),IPARTC(*),IPARTG(*),IPARTR(*),
270 . NB,VAL,CONT,MODIF,IPARTT(*),IPARTP(*),WARN
271 TYPE (SURF_) :: IGRSLIN
272C-----------------------------------------------
273C L o c a l V a r i a b l e s
274C-----------------------------------------------
275 INTEGER :: J,K,L,CUR_ID,NI1,NI2,FLAG
276 INTEGER :: OFFSET,CUR_P,CUR_10,CUR_20,CUR_16
277C=======================================================================
278
279C--------------------------------------------------------------------C
280C---------------------tag of elements of the line--------------------C
281C--------------------------------------------------------------------C
282
283 DO j=1,nb
284 ni1 = igrslin%NODES(j,1)
285 ni2 = igrslin%NODES(j,2)
286C------------------------> shells <-------------------------------C
287 DO l = knod2elc(ni1)+1,knod2elc(ni1+1)
288 cur_id = nod2elc(l)
289 flag = 0
290 IF ((tag_elc(cur_id+npart)<(1+cont)).AND.
291 . (tagno(ipartc(cur_id))/=val)) THEN
292 DO k=2,5
293 IF (ixc(nixc*(cur_id-1)+k) == ni2) flag = 1
294 ENDDO
295 ENDIF
296 IF (flag == 1)
297 . CALL modif_tag(tag_elc(cur_id+npart),1+cont,modif)
298 END DO
299C------------------------> sh3n <----------------------------------C
300 DO l = knod2eltg(ni1)+1,knod2eltg(ni1+1)
301 cur_id = nod2eltg(l)
302 flag = 0
303 IF ((tag_elg(cur_id+npart)<(1+cont)).AND.
304 . (tagno(ipartg(cur_id))/=val)) THEN
305 DO k=2,4
306 IF (ixtg(nixtg*(cur_id-1)+k) == ni2) flag = 1
307 ENDDO
308 ENDIF
309 IF (flag == 1)
310 . CALL modif_tag(tag_elg(cur_id+npart),1+cont,modif)
311 END DO
312C------------------------> TRUSS / BEAM / SPRINGS <-----------------C
313 DO l = knod2el1d(ni1)+1,knod2el1d(ni1+1)
314 cur_id = nod2el1d(l)
315 flag = 0
316 IF (cur_id<=numelt) THEN
317C----------> TRUSS
318 IF ((tag_elt(cur_id+npart)<(1+cont)).AND.
319 . (tagno(ipartt(cur_id))/=val)) THEN
320 DO k=2,3
321 IF (ixt(nixt*(cur_id-1)+k) == ni2) flag = 1
322 ENDDO
323 ENDIF
324 IF (flag == 1) CALL r2r_void_1d(ipartt(cur_id),ipart)
325 IF (flag == 1)
326 . CALL modif_tag(tag_elt(cur_id+npart),1+cont,modif)
327 ELSEIF (cur_id<=(numelt+numelp)) THEN
328C----------> BEAM
329 cur_p = cur_id-numelt
330 IF ((tag_elp(cur_p+npart)<(1+cont)).AND.
331 . (tagno(ipartp(cur_p))/=val)) THEN
332 DO k=2,3
333 IF (ixp(nixp*(cur_p-1)+k) == ni2) flag = 1
334 ENDDO
335 ENDIF
336 IF (flag == 1) CALL r2r_void_1d(ipartp(cur_p),ipart)
337 IF (flag == 1)
338 . CALL modif_tag(tag_elp(cur_p+npart),1+cont,modif)
339 ELSE
340C----------> SPRINGS (not yet compatible)
341 cur_p = cur_id-numelt-numelp
342 IF ((tag_elr(cur_p+npart)<(1+cont)).AND.
343 . (tagno(ipartr(cur_p))/=val)) THEN
344 DO k=2,3
345 IF (ixr(nixr*(cur_p-1)+k) == ni2) flag = 1
346 ENDDO
347 ENDIF
348 IF (flag == 1) warn = 1
349 ENDIF
350 END DO
351C------------------------> faces of solids <---------------------C
352 DO l = knod2els(ni1)+1,knod2els(ni1+1)
353 cur_id = nod2els(l)
354 flag = 0
355 IF ((tag_els(cur_id+npart)<(1+cont)).AND.
356 . (tagno(iparts(cur_id))/=val)) THEN
357 DO k=2,9
358 IF(ixs(nixs*(cur_id-1)+k) == ni2) flag = 1
359 ENDDO
360 IF (eani(cur_id)==10) THEN
361 offset = nixs*numels
362 cur_10 = cur_id-numels8
363 DO k=1,6
364 IF(ixs(offset+6*(cur_10-1)+k) == ni2) flag = 1
365 ENDDO
366 ELSEIF (eani(cur_id)==20) THEN
367 offset = nixs*numels+6*numels10
368 cur_20 = cur_id-(numels8+numels10)
369 DO k=1,12
370 IF(ixs(offset+12*(cur_20-1)+k) == ni2) flag = 1
371 ENDDO
372 ELSEIF (eani(cur_id)==16) THEN
373 offset = nixs*numels+6*numels10+12*numels20
374 cur_16 = cur_id-(numels8+numels10+numels20)
375 DO k=1,8
376 IF(ixs(offset+8*(cur_16-1)+k) == ni2) flag = 1
377 ENDDO
378 ENDIF
379 ENDIF
380 IF (flag == 1)
381 . CALL modif_tag(tag_els(cur_id+npart),1+cont,modif)
382 END DO
383 END DO
384
385C-----------
386 RETURN
387 END SUBROUTINE tag_elem_void_r2r_lin
groupdef_mod
Definition groupdef_mod.F:668
nod2el_mod
Definition nod2el_mod.F:36
nod2el_mod::knod2elc
integer, dimension(:), allocatable knod2elc
Definition nod2el_mod.F:58
nod2el_mod::knod2els
integer, dimension(:), allocatable knod2els
Definition nod2el_mod.F:58
nod2el_mod::knod2el1d
integer, dimension(:), allocatable knod2el1d
Definition nod2el_mod.F:58
nod2el_mod::nod2el1d
integer, dimension(:), allocatable nod2el1d
Definition nod2el_mod.F:58
nod2el_mod::nod2eltg
integer, dimension(:), allocatable nod2eltg
Definition nod2el_mod.F:58
nod2el_mod::nod2elc
integer, dimension(:), allocatable nod2elc
Definition nod2el_mod.F:58
nod2el_mod::nod2els
integer, dimension(:), allocatable nod2els
Definition nod2el_mod.F:58
nod2el_mod::knod2eltg
integer, dimension(:), allocatable knod2eltg
Definition nod2el_mod.F:58
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_els
integer, dimension(:), allocatable tag_els
Definition r2r_mod.F:133
r2r_mod::tag_elg
integer, dimension(:), allocatable tag_elg
Definition r2r_mod.F:135
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::tag_elc
integer, dimension(:), allocatable tag_elc
Definition r2r_mod.F:133
r2r_mod::tag_elr
integer, dimension(:), allocatable tag_elr
Definition r2r_mod.F:134
r2r_mod::tag_elt
integer, dimension(:), allocatable tag_elt
Definition r2r_mod.F:134
r2r_mod::tag_elp
integer, dimension(:), allocatable tag_elp
Definition r2r_mod.F:133
r2r_mod::tag_elsp
integer, dimension(:), allocatable tag_elsp
Definition r2r_mod.F:142
restmod::ixs
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
restmod::ipart
integer, dimension(:), allocatable, target ipart
Definition restart_mod.F:60
restmod::ixt
integer, dimension(:), allocatable ixt
Definition restart_mod.F:60
restmod::ixr
integer, dimension(:), allocatable ixr
Definition restart_mod.F:60
restmod::ixtg
integer, dimension(:), allocatable, target ixtg
Definition restart_mod.F:60
restmod::nod2sp
integer, dimension(:), allocatable nod2sp
Definition restart_mod.F:60
restmod::ixp
integer, dimension(:), allocatable ixp
Definition restart_mod.F:60
restmod::ixc
integer, dimension(:), allocatable ixc
Definition restart_mod.F:60
r2r_void_1d
subroutine r2r_void_1d(id_part, ipartl)
Definition r2r_void.F:446
modif_tag
subroutine modif_tag(tag, new_tag, modif)
Definition routines_r2r.F:31
tag_elem_void_r2r_lin
subroutine tag_elem_void_r2r_lin(nb, iparts, ipartc, ipartg, ipartt, ipartp, ipartr, val, cont, modif, warn, igrslin)
Definition tagelem_r2r.F:253
tagelem_r2r
subroutine tagelem_r2r(numel, ipart, tagbuf, npart)
Definition tagelem_r2r.F:29
tag_elem_void_r2r
subroutine tag_elem_void_r2r(nb, iparts, ipartc, ipartg, ipartsp, val, cont, modif, itagl, f2, flag, eani2, igrsurf, igrnod, gr_id)
Definition tagelem_r2r.F:67