OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_line_from_ext_surface_ext_all.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_line_from_surface_ext_all ../starter/source/model/sets/create_line_from_ext_surface_ext_all.F
25!||--- called by ------------------------------------------------------
26!|| create_line_from_surface ../starter/source/model/sets/create_line_from_surface.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| message_mod ../starter/share/message_module/message_mod.F
30!||====================================================================
31 SUBROUTINE create_line_from_surface_ext_all( CLAUSE ,IEXT ,OPT_E,DELBUF,GO_IN_ARRAY)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE my_alloc_mod
36 USE message_mod
37 USE setdef_mod
38 USE set_scratch_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER IEXT,OPT_E
47 TYPE (SET_) :: CLAUSE
48 TYPE (SET_SCRATCH) :: DELBUF
49 LOGICAL GO_IN_ARRAY
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER I,K,J1,J2,SIZEMAX,NSEG,NSEG_EDGE_EXT,
54 . NSEG_EDGE_ALL,NSEG_SURF,LINE_NENTITY,
55 . NSEG_EXT,NSEG_ALL,ELTYP
56 INTEGER IWORK(70000),IPERM(4)
57!
58 DATA iperm /2,3,4,1/
59!
60 INTEGER , DIMENSION(:),ALLOCATABLE :: INDEX,IW1,IW2,IW5,IW6
61 INTEGER , DIMENSION(:,:),ALLOCATABLE :: ITRI,LINE_ORD
62 INTEGER , DIMENSION(:,:),ALLOCATABLE :: SURF_NODE_EXT,SURF_NODE_ALL
63 INTEGER , DIMENSION(:),ALLOCATABLE :: SURF_ELTYP_EXT,SURF_ELEM_EXT,
64 . SURF_ELTYP_ALL,SURF_ELEM_ALL
65C=======================================================================
66 sizemax = clause%NB_LINE_SEG + 4*clause%NB_SURF_SEG
67
68 IF (sizemax == 0) RETURN
69
70!
71 line_nentity = 4 ! NOD1, NOD2, ELTYP, ELEM
72 ALLOCATE(line_ord(line_nentity,sizemax))
73 ALLOCATE(itri(3,sizemax))
74 ALLOCATE(index(2*sizemax))
75!
76 ALLOCATE(iw1(4*sizemax))
77 ALLOCATE(iw2(4*sizemax))
78 ALLOCATE(iw5(4*sizemax))
79 ALLOCATE(iw6(4*sizemax))
80!
81 ALLOCATE(surf_node_ext(line_nentity,clause%NB_SURF_SEG))
82 ALLOCATE(surf_eltyp_ext(clause%NB_SURF_SEG))
83 ALLOCATE(surf_elem_ext(clause%NB_SURF_SEG))
84
85 ALLOCATE(surf_node_all(line_nentity,clause%NB_SURF_SEG))
86 ALLOCATE(surf_eltyp_all(clause%NB_SURF_SEG))
87 ALLOCATE(surf_elem_all(clause%NB_SURF_SEG))
88!------------------
89 ! NSEG of lines initialization
90 nseg = 0
91 IF (go_in_array .EQV. .true.) THEN
92 nseg = delbuf%SZ_LINE
93 ! Fill in LINE_ORD array the already stored line from 1D_element
94 DO i=1,nseg
95 line_ord(1,i) = delbuf%LINE(i,1)
96 line_ord(2,i) = delbuf%LINE(i,2)
97 line_ord(3,i) = delbuf%LINE(i,3)
98 line_ord(4,i) = delbuf%LINE(i,4)
99 ENDDO
100 ELSE
101 nseg = clause%NB_LINE_SEG ! lines from 1D_element
102 ! Fill in LINE_ORD array the already stored line from 1D_element
103 DO i=1,nseg
104 line_ord(1,i) = clause%LINE_NODES(i,1)
105 line_ord(2,i) = clause%LINE_NODES(i,2)
106 line_ord(3,i) = clause%LINE_ELTYP(i)
107 line_ord(4,i) = clause%LINE_ELEM(i)
108 ENDDO
109 ENDIF
110!
111! extract lines from surfaces
112!
113 nseg_surf = clause%NB_SURF_SEG
114 IF (nseg_surf > 0) THEN
115
116
117 !
118 ! detach solid and shell surfaces from surfaces of all parts
119 !
120
121 nseg_ext = 0
122 nseg_all = 0
123 DO i=1,nseg_surf
124
125 eltyp = clause%SURF_ELTYP(i)
126
127 IF (eltyp == 1. or. eltyp == 2 .OR. eltyp == 0) THEN
128 ! solid + quad + SEG
129
130 ! tag all edges of surf segment
131 nseg_all = nseg_all + 1
132 surf_node_all(1,nseg_all) = clause%SURF_NODES(i,1)
133 surf_node_all(2,nseg_all) = clause%SURF_NODES(i,2)
134 surf_node_all(3,nseg_all) = clause%SURF_NODES(i,3)
135 surf_node_all(4,nseg_all) = clause%SURF_NODES(i,4)
136 surf_eltyp_all(nseg_all) = clause%SURF_ELTYP(i)
137 surf_elem_all(nseg_all) = clause%SURF_ELEM(i)
138
139 ELSEIF (eltyp == 3 . or. eltyp == 7) THEN ! shell + sh3n
140
141 IF ( iext == 1 .AND. opt_e == 1 ) THEN
142
143 ! tag only free edges of surf segment
144 nseg_ext = nseg_ext + 1
145 surf_node_ext(1,nseg_ext) = clause%SURF_NODES(i,1)
146 surf_node_ext(2,nseg_ext) = clause%SURF_NODES(i,2)
147 surf_node_ext(3,nseg_ext) = clause%SURF_NODES(i,3)
148 surf_node_ext(4,nseg_ext) = clause%SURF_NODES(i,4)
149 surf_eltyp_ext(nseg_ext) = clause%SURF_ELTYP(i)
150 surf_elem_ext(nseg_ext) = clause%SURF_ELEM(i)
151
152 ELSE
153
154 ! tag all edges of surf segment
155 nseg_all = nseg_all + 1
156 surf_node_all(1,nseg_all) = clause%SURF_NODES(i,1)
157 surf_node_all(2,nseg_all) = clause%SURF_NODES(i,2)
158 surf_node_all(3,nseg_all) = clause%SURF_NODES(i,3)
159 surf_node_all(4,nseg_all) = clause%SURF_NODES(i,4)
160 surf_eltyp_all(nseg_all) = clause%SURF_ELTYP(i)
161 surf_elem_all(nseg_all) = clause%SURF_ELEM(i)
162
163 ENDIF ! IF (IEXT == 1 .AND. OPT_E == 1 )
164
165 ENDIF ! IF (ELTYP == 1. OR. ELTYP == 2 .OR. ELTYP == 0)
166
167 ENDDO ! DO I=1,NSEG_SURF
168
169
170
171!***********************************
172!***********************************
173 ! -- EXT -- edges form SURFACE
174!***********************************
175!***********************************
176
177 nseg_edge_ext = 0
178!---
179 k=0
180 iw1 = 0
181 iw2 = 0
182 iw5 = 0
183 iw6 = 0
184
185 DO i=1,nseg_ext
186 DO j1=1,4
187 j2=iperm(j1)
188 IF (surf_node_ext(j2,i) /= 0 .AND.
189 . surf_node_ext(j1,i) > surf_node_ext(j2,i)) THEN
190 k=k+1
191 iw1(k)=surf_node_ext(j2,i)
192 iw2(k)=surf_node_ext(j1,i)
193 iw5(k)=surf_eltyp_ext(i)
194 iw6(k)=surf_elem_ext(i)
195 ELSEIF (surf_node_ext(j1,i) /= 0 .AND.
196 . surf_node_ext(j1,i) < surf_node_ext(j2,i)) THEN
197 k=k+1
198 iw1(k)=surf_node_ext(j1,i)
199 iw2(k)=surf_node_ext(j2,i)
200 iw5(k)=surf_eltyp_ext(i)
201 iw6(k)=surf_elem_ext(i)
202 ENDIF
203 ENDDO
204 ENDDO ! DO I=1,NSEG_EXT
205!
206 nseg_edge_ext = k
207C-----------------------------------------------
208 index = 0
209 iwork(1:70000) = 0
210 CALL my_orders( 0,iwork,iw1,index,k,1)
211 iwork(1:70000) = 0
212 CALL my_orders(10,iwork,iw2,index,k,1) ! my_order(10 uses previous index
213!---
214 IF (nseg_edge_ext > 0) THEN
215C-----------------------------------------------
216C REMOVE INTERNAL SEGMENTS (EXCEPT BOUNDARY)
217C-----------------------------------------------
218 IF (iw1(index(1)) /= iw1(index(2)).OR.
219 . iw2(index(1)) /= iw2(index(2)))THEN
220 nseg=nseg+1
221 line_ord(1,nseg) = iw1(index(1))
222 line_ord(2,nseg) = iw2(index(1))
223 line_ord(3,nseg) = iw5(index(1))
224 line_ord(4,nseg) = iw6(index(1))
225 ENDIF
226 DO i=2,k-1
227 IF ((iw1(index(i-1)) /= iw1(index(i)).OR.
228 . iw2(index(i-1)) /= iw2(index(i))).AND.
229 . (iw1(index(i+1)) /= iw1(index(i)).OR.
230 . iw2(index(i+1)) /= iw2(index(i)))) THEN
231 nseg=nseg+1
232 line_ord(1,nseg) = iw1(index(i))
233 line_ord(2,nseg) = iw2(index(i))
234 line_ord(3,nseg) = iw5(index(i))
235 line_ord(4,nseg) = iw6(index(i))
236 ENDIF
237 ENDDO
238 IF (iw1(index(k-1)) /= iw1(index(k)).OR.
239 . iw2(index(k-1)) /= iw2(index(k))) THEN
240 nseg=nseg+1
241 line_ord(1,nseg) = iw1(index(k))
242 line_ord(2,nseg) = iw2(index(k))
243 line_ord(3,nseg) = iw5(index(k))
244 line_ord(4,nseg) = iw6(index(k))
245 ENDIF
246 ENDIF ! IF (NSEG_EDGE_EXT > 0)
247
248
249!***********************************
250!***********************************
251 ! -- ALL -- edges form SURFACE
252!***********************************
253!***********************************
254
255 nseg_edge_all = 0
256!---
257 k=0
258 iw1 = 0
259 iw2 = 0
260 iw5 = 0
261 iw6 = 0
262 DO i=1,nseg_all
263 DO j1=1,4
264 j2=iperm(j1)
265 IF (surf_node_all(j2,i) /= 0 .AND.
266 . surf_node_all(j1,i) > surf_node_all(j2,i)) THEN
267 k=k+1
268 iw1(k)=surf_node_all(j2,i)
269 iw2(k)=surf_node_all(j1,i)
270 iw5(k)=surf_eltyp_all(i)
271 iw6(k)=surf_elem_all(i)
272 ELSEIF (surf_node_all(j1,i) /= 0 .AND.
273 . surf_node_all(j1,i) < surf_node_all(j2,i)) THEN
274 k=k+1
275 iw1(k)=surf_node_all(j1,i)
276 iw2(k)=surf_node_all(j2,i)
277 iw5(k)=surf_eltyp_all(i)
278 iw6(k)=surf_elem_all(i)
279 ENDIF
280 ENDDO
281 ENDDO ! DO I=1,NSEG_ALL
282!
283 nseg_edge_all = k
284C-----------------------------------------------
285 index = 0
286 iwork(1:70000) = 0
287 CALL my_orders( 0,iwork,iw1,index,k,1)
288 iwork(1:70000) = 0
289 CALL my_orders(10,iwork,iw2,index,k,1)
290!---
291 IF (nseg_edge_all > 0) THEN
292C-----------------------------------------------
293C REMOVE DOUBLE SEGMENTS
294C-----------------------------------------------
295 nseg = nseg + 1
296 line_ord(1,nseg) = iw1(index(1))
297 line_ord(2,nseg) = iw2(index(1))
298 line_ord(3,nseg) = iw5(index(1))
299 line_ord(4,nseg) = iw6(index(1))
300 DO i=2,k
301 IF (iw1(index(i-1)) /= iw1(index(i)).OR.
302 . iw2(index(i-1)) /= iw2(index(i))) THEN
303 nseg = nseg + 1
304 line_ord(1,nseg) = iw1(index(i))
305 line_ord(2,nseg) = iw2(index(i))
306 line_ord(3,nseg) = iw5(index(i))
307 line_ord(4,nseg) = iw6(index(i))
308 ENDIF
309 ENDDO
310 ENDIF ! IF (NSEG_EDGE_ALL > 0)
311
312 ENDIF ! IF (NSEG_SURF > 0)
313
314!------------------------------------------
315!------------------------------------------
316! ORDER LINES and LINE CLAUSE FILLING
317!------------------------------------------
318!------------------------------------------
319 index = 0
320 iwork(1:70000) = 0
321 DO i=1,nseg
322 index(i)=i
323 itri(1,i) = line_ord(1,i)
324 itri(2,i) = line_ord(2,i)
325 itri(3,i) = line_ord(4,i) ! elem_id
326 ENDDO
327 CALL my_orders(0,iwork,itri,index,nseg,3)
328!
329 ! reallocation of the line CLAUSE at the right dimension and final fill
330!------------------
331!
332! Decide whether the result is stored in an array or in the clause.
333! In certain cases it is useful to store in ARRAY.
334! Example : Clause with delete clause. Lines must be recreated & merged...
335! ----------------------------------------------------------------------------
336 IF (go_in_array .EQV. .true.) THEN
337 delbuf%SZ_LINE = nseg
338 IF(ALLOCATED(delbuf%LINE)) DEALLOCATE(delbuf%LINE)
339 ALLOCATE(delbuf%LINE(nseg,4))
340 DO i=1,nseg
341 delbuf%LINE(i,1) = line_ord(1,index(i))
342 delbuf%LINE(i,2) = line_ord(2,index(i))
343 delbuf%LINE(i,3) = line_ord(3,index(i))
344 delbuf%LINE(i,4) = line_ord(4,index(i))
345 ENDDO
346 ELSE
347 IF (ALLOCATED(clause%LINE_NODES)) DEALLOCATE(clause%LINE_NODES)
348 IF (ALLOCATED(clause%LINE_ELTYP)) DEALLOCATE(clause%LINE_ELTYP)
349 IF (ALLOCATED(clause%LINE_ELEM)) DEALLOCATE(clause%LINE_ELEM)
350!
351 clause%NB_LINE_SEG = nseg
352 CALL my_alloc(clause%LINE_NODES,nseg,2)
353 CALL my_alloc(clause%LINE_ELTYP,nseg)
354 CALL my_alloc(clause%LINE_ELEM,nseg)
355!
356 DO i=1,nseg
357 clause%LINE_NODES(i,1) = line_ord(1,index(i))
358 clause%LINE_NODES(i,2) = line_ord(2,index(i))
359 clause%LINE_ELTYP(i) = line_ord(3,index(i))
360 clause%LINE_ELEM(i) = line_ord(4,index(i))
361 ENDDO
362 ENDIF ! IF (GO_IN_ARRAY .EQV. .TRUE.)
363!---
364 IF (ALLOCATED(line_ord)) DEALLOCATE(line_ord)
365 IF (ALLOCATED(itri)) DEALLOCATE(itri)
366 IF (ALLOCATED(index)) DEALLOCATE(index)
367 IF (ALLOCATED(iw1)) DEALLOCATE(iw1)
368 IF (ALLOCATED(iw2)) DEALLOCATE(iw2)
369 IF (ALLOCATED(iw5)) DEALLOCATE(iw5)
370 IF (ALLOCATED(iw6)) DEALLOCATE(iw6)
371!
372 IF (ALLOCATED(surf_node_ext)) DEALLOCATE(surf_node_ext)
373 IF (ALLOCATED(surf_eltyp_ext)) DEALLOCATE(surf_eltyp_ext)
374 IF (ALLOCATED(surf_elem_ext)) DEALLOCATE(surf_elem_ext)
375 IF (ALLOCATED(surf_node_all)) DEALLOCATE(surf_node_all)
376 IF (ALLOCATED(surf_eltyp_all)) DEALLOCATE(surf_eltyp_all)
377 IF (ALLOCATED(surf_elem_all)) DEALLOCATE(surf_elem_all)
378C-----------
379 RETURN
380 END
create_line_from_surface_ext_all
subroutine create_line_from_surface_ext_all(clause, iext, opt_e, delbuf, go_in_array)
Definition create_line_from_ext_surface_ext_all.F:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1249
set_scratch_mod
Definition setdef_mod.F:247
setdef_mod
Definition setdef_mod.F:107