OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_element_from_part.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!|| create_element_from_part ../starter/source/model/sets/create_element_from_part.F
25!||--- called by ------------------------------------------------------
26!|| hm_set ../starter/source/model/sets/hm_set.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| inverted_group_mod ../starter/share/modules1/inverted_group_mod.F
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE create_element_from_part(CLAUSE ,INV_GROUP,NUMSPH)
33C-----------------------------------------------
34C ROUTINE DESCRIPTION :
35C ===================
36C Create Element list from PART list
37C------------------------------------------------------------------
38C DUMMY ARGUMENTS DESCRIPTION:
39C ===================
40C
41C NAME DESCRIPTION
42C
43C CLAUSE (SET structure) Clause to be treated
44C INV_GROUP Direct access to the list of elements from a given PART
45C============================================================================
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE inverted_group_mod
51 USE setdef_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com04_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 TYPE(invertgroup_struct_) :: INV_GROUP
64 TYPE (SET_) :: CLAUSE
65 INTEGER, INTENT(IN) :: NUMSPH
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER ID,IE,EL,IP,EL_FIRST,EL_LAST,SIZE,IND,SZELMAX,I
70 INTEGER IWORK(70000)
71 INTEGER, DIMENSION(:), ALLOCATABLE :: INDX,SORT
72C=======================================================================
73 szelmax = max(numels,numelq,numelc,numeltg,numeltria,numelt,numelp,numelr,numsph)
74 ALLOCATE(indx(szelmax*2))
75 ALLOCATE(sort(szelmax))
76!
77! SOLID
78 IF (numels > 0) THEN
79 SIZE = 0
80 DO id=1,clause%NB_PART
81 ip=clause%PART(id)
82 el_first = inv_group%INDPARTS(ip)
83 el_last = inv_group%INDPARTS(ip+1)
84 SIZE = SIZE + el_last - el_first
85 ENDDO
86 clause%NB_SOLID = SIZE
87 ALLOCATE( clause%SOLID(size) )
88!
89 ind = 0
90 DO id=1,clause%NB_PART
91 ip=clause%PART(id)
92 el_first = inv_group%INDPARTS(ip)
93 el_last = inv_group%INDPARTS(ip+1)-1
94 DO el=el_first,el_last
95 ind = ind+1
96 ie = inv_group%PARTS(el)
97 clause%SOLID(ind) = ie
98 ENDDO
99 ENDDO
100
101 iwork(1:70000) = 0
102 sort(1:clause%NB_SOLID) = clause%SOLID(1:clause%NB_SOLID)
103 CALL my_orders(0,iwork,sort,indx,clause%NB_SOLID,1)
104
105 DO i=1,clause%NB_SOLID
106 clause%SOLID(i) = sort(indx(i))
107 ENDDO
108
109 ENDIF ! IF (NUMELS > 0)
110!
111! SPHCEL
112 IF (numsph > 0) THEN
113 SIZE = 0
114 DO id=1,clause%NB_PART
115 ip=clause%PART(id)
116 el_first = inv_group%INDPARTSPH(ip)
117 el_last = inv_group%INDPARTSPH(ip+1)
118 SIZE = SIZE + el_last - el_first
119 ENDDO
120 clause%NB_SPHCEL = SIZE
121 ALLOCATE( clause%SPHCEL(size) )
122!
123 ind = 0
124 DO id=1,clause%NB_PART
125 ip=clause%PART(id)
126 el_first = inv_group%INDPARTSPH(ip)
127 el_last = inv_group%INDPARTSPH(ip+1)-1
128 DO el=el_first,el_last
129 ind = ind+1
130 ie = inv_group%PARTSPH(el)
131 clause%SPHCEL(ind) = ie
132 ENDDO
133 ENDDO
134
135 iwork(1:70000) = 0
136 sort(1:clause%NB_SPHCEL) = clause%SPHCEL(1:clause%NB_SPHCEL)
137 CALL my_orders(0,iwork,sort,indx,clause%NB_SPHCEL,1)
138
139 DO i=1,clause%NB_SPHCEL
140 clause%SPHCEL(i) = sort(indx(i))
141 ENDDO
142 ENDIF ! IF (NUMSPH > 0)
143!
144! QUAD
145 IF (numelq > 0) THEN
146 SIZE = 0
147 DO id=1,clause%NB_QUAD
148 ip=clause%PART(id)
149 el_first = inv_group%INDPARTQ(ip)
150 el_last = inv_group%INDPARTQ(ip+1)
151 SIZE = SIZE + el_last - el_first
152 ENDDO
153 clause%NB_QUAD = SIZE
154 ALLOCATE( clause%QUAD(size) )
155!
156 ind = 0
157 DO id=1,clause%NB_QUAD
158 ip=clause%PART(id)
159 el_first = inv_group%INDPARTQ(ip)
160 el_last = inv_group%INDPARTQ(ip+1)-1
161 DO el=el_first,el_last
162 ind = ind+1
163 ie = inv_group%PARTQ(el)
164 clause%QUAD(ind) = ie
165 ENDDO
166 ENDDO
167
168 iwork(1:70000) = 0
169 sort(1:clause%NB_QUAD) = clause%QUAD(1:clause%NB_QUAD)
170 CALL my_orders(0,iwork,sort,indx,clause%NB_QUAD,1)
171
172 DO i=1,clause%NB_QUAD
173 clause%QUAD(i) = sort(indx(i))
174 ENDDO
175
176 ENDIF ! IF (NUMELQ > 0)
177!
178! SHELL (4N)
179 IF (numelc > 0) THEN
180 SIZE = 0
181 DO id=1,clause%NB_PART
182 ip=clause%PART(id)
183 el_first = inv_group%INDPARTC(ip)
184 el_last = inv_group%INDPARTC(ip+1)
185 SIZE = SIZE + el_last - el_first
186 ENDDO
187 clause%NB_SH4N = SIZE
188 ALLOCATE( clause%SH4N(size) )
189!
190 ind = 0
191 DO id=1,clause%NB_PART
192 ip=clause%PART(id)
193 el_first = inv_group%INDPARTC(ip)
194 el_last = inv_group%INDPARTC(ip+1)-1
195 DO el=el_first,el_last
196 ind = ind+1
197 ie = inv_group%PARTC(el)
198 clause%SH4N(ind) = ie
199 ENDDO
200 ENDDO
201
202 iwork(1:70000) = 0
203 sort(1:clause%NB_SH4N) = clause%SH4N(1:clause%NB_SH4N)
204 CALL my_orders(0,iwork,sort,indx,clause%NB_SH4N,1)
205
206 DO i=1,clause%NB_SH4N
207 clause%SH4N(i) = sort(indx(i))
208 ENDDO
209
210 ENDIF ! IF (NUMELC > 0)
211
212!
213! shell(3n)
214 IF (numeltg > 0) THEN
215 SIZE = 0
216 DO id=1,clause%NB_PART
217 ip=clause%PART(id)
218 el_first = inv_group%INDPARTTG(ip)
219 el_last = inv_group%INDPARTTG(ip+1)
220 SIZE = SIZE + el_last - el_first
221 ENDDO
222 clause%NB_SH3N = SIZE
223 ALLOCATE( clause%SH3N(size) )
224!
225 ind=0
226 DO id=1,clause%NB_PART
227 ip=clause%PART(id)
228 el_first = inv_group%INDPARTTG(ip)
229 el_last = inv_group%INDPARTTG(ip+1)-1
230 DO el=el_first,el_last
231 ind = ind+1
232 ie = inv_group%PARTTG(el)
233 clause%SH3N(ind) = ie
234 ENDDO
235 ENDDO
236 iwork(1:70000) = 0
237 sort(1:clause%NB_SH3N) = clause%SH3N(1:clause%NB_SH3N)
238 CALL my_orders(0,iwork,sort,indx,clause%NB_SH3N,1)
239
240 DO i=1,clause%NB_SH3N
241 clause%SH3N(i) = sort(indx(i))
242 ENDDO
243
244 ENDIF ! IF (NUMELTG > 0)
245
246!
247! TRIA
248 IF (numeltria > 0) THEN
249 SIZE = 0
250 DO id=1,clause%NB_PART
251 ip=clause%PART(id)
252 el_first = inv_group%INDPARTTRIA(ip)
253 el_last = inv_group%INDPARTTRIA(ip+1)
254 SIZE = SIZE + el_last - el_first
255 ENDDO
256 clause%NB_TRIA = SIZE
257 ALLOCATE( clause%TRIA(size) )
258!
259 ind = 0
260 DO id=1,clause%NB_PART
261 ip=clause%PART(id)
262 el_first = inv_group%INDPARTTRIA(ip)
263 el_last = inv_group%INDPARTTRIA(ip+1)-1
264 DO el=el_first,el_last
265 ind = ind+1
266 ie = inv_group%PARTTRIA(el)
267 clause%TRIA(ind) = ie
268 ENDDO
269 ENDDO
270 iwork(1:70000) = 0
271 sort(1:clause%NB_TRIA) = clause%SH3N(1:clause%NB_TRIA)
272 CALL my_orders(0,iwork,sort,indx,clause%NB_TRIA,1)
273
274 DO i=1,clause%NB_TRIA
275 clause%SH3N(i) = sort(indx(i))
276 ENDDO
277
278 ENDIF ! IF (NUMELTRIA > 0)
279!
280! TRUSS
281 IF (numelt > 0) THEN
282 SIZE = 0
283 DO id=1,clause%NB_PART
284 ip=clause%PART(id)
285 el_first = inv_group%INDPARTT(ip)
286 el_last = inv_group%INDPARTT(ip+1)
287 SIZE = SIZE + el_last - el_first
288 ENDDO
289 clause%NB_TRUSS = SIZE
290 ALLOCATE( clause%TRUSS(size) )
291!
292 ind = 0
293 DO id=1,clause%NB_PART
294 ip=clause%PART(id)
295 el_first = inv_group%INDPARTT(ip)
296 el_last = inv_group%INDPARTT(ip+1)-1
297 DO el=el_first,el_last
298 ind = ind+1
299 ie = inv_group%PARTT(el)
300 clause%TRUSS(ind) = ie
301 ENDDO
302 ENDDO
303
304 iwork(1:70000) = 0
305 sort(1:clause%NB_TRUSS) = clause%TRUSS(1:clause%NB_TRUSS)
306 CALL my_orders(0,iwork,sort,indx,clause%NB_TRUSS,1)
307
308 DO i=1,clause%NB_TRUSS
309 clause%TRUSS(i) = sort(indx(i))
310 ENDDO
311
312 ENDIF ! IF (NUMELT > 0)
313
314! BEAM
315 IF (numelp > 0) THEN
316
317 SIZE = 0
318 DO id=1,clause%NB_PART
319 ip=clause%PART(id)
320 el_first = inv_group%INDPARTP(ip)
321 el_last = inv_group%INDPARTP(ip+1)
322 SIZE = SIZE + el_last - el_first
323 ENDDO
324
325 clause%NB_BEAM = SIZE
326 ALLOCATE( clause%BEAM(size) )
327!
328 ind = 0
329 DO id=1,clause%NB_PART
330 ip=clause%PART(id)
331 el_first = inv_group%INDPARTP(ip)
332 el_last = inv_group%INDPARTP(ip+1)-1
333 DO el=el_first,el_last
334 ind = ind+1
335 ie = inv_group%PARTP(el)
336 clause%BEAM(ind) = ie
337 ENDDO
338 ENDDO
339 iwork(1:70000) = 0
340 sort(1:clause%NB_BEAM) = clause%BEAM(1:clause%NB_BEAM)
341 CALL my_orders(0,iwork,sort,indx,clause%NB_BEAM,1)
342
343 DO i=1,clause%NB_BEAM
344 clause%BEAM(i) = sort(indx(i))
345 ENDDO
346
347 ENDIF ! IF (NUMELP > 0)
348
349
350!
351! SPRING
352 IF (numelr > 0) THEN
353
354 SIZE = 0
355 DO id=1,clause%NB_PART
356 ip=clause%PART(id)
357 el_first = inv_group%INDPARTR(ip)
358 el_last = inv_group%INDPARTR(ip+1)
359 SIZE = SIZE + el_last - el_first
360 ENDDO
361
362 clause%NB_SPRING = SIZE
363 ALLOCATE( clause%SPRING(size) )
364!
365 ind = 0
366 DO id=1,clause%NB_PART
367 ip=clause%PART(id)
368 el_first = inv_group%INDPARTR(ip)
369 el_last = inv_group%INDPARTR(ip+1)-1
370 DO el=el_first,el_last
371 ind = ind+1
372 ie = inv_group%PARTR(el)
373 clause%SPRING(ind) = ie
374 ENDDO
375 ENDDO
376 iwork(1:70000) = 0
377 sort(1:clause%NB_SPRING) = clause%SPRING(1:clause%NB_SPRING)
378 CALL my_orders(0,iwork,sort,indx,clause%NB_SPRING,1)
379
380 DO i=1,clause%NB_SPRING
381 clause%SPRING(i) = sort(indx(i))
382 ENDDO
383
384 ENDIF ! IF (NUMELR > 0)
385!
386C-------------------------
387 RETURN
388 END
create_element_from_part
subroutine create_element_from_part(clause, inv_group, numsph)
Definition create_element_from_part.F:33
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
inverted_group_mod
Definition inverted_group_mod.F:35
message_mod
Definition message_mod.F:1249
setdef_mod
Definition setdef_mod.F:107
inverted_group_mod::invertgroup_struct_
Definition inverted_group_mod.F:46