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