OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_line_from_surface_ext.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 ../starter/source/model/sets/create_line_from_surface_ext.F
25!||--- calls -----------------------------------------------------
26!||--- uses -----------------------------------------------------
27!|| message_mod ../starter/share/message_module/message_mod.F
28!||====================================================================
29 SUBROUTINE create_line_from_surface_ext(CLAUSE)
30C-----------------------------------------------
31C M o d u l e s
32C-----------------------------------------------
33 USE my_alloc_mod
34 USE message_mod
35 USE setdef_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 TYPE (SET_) :: CLAUSE
44C-----------------------------------------------
45C L o c a l V a r i a b l e s
46C-----------------------------------------------
47 INTEGER I,K,J1,J2,SIZEMAX,NSEG,IEXT,NSEG_EDGE_EXT,
48 . NSEG_EDGE_ALL,NSEG_SURF,LINE_NENTITY
49 INTEGER IWORK(70000),IPERM(4)
50!
51 DATA iperm /2,3,4,1/
52!
53 INTEGER , DIMENSION(:),ALLOCATABLE :: INDEX,IW1,IW2,IW5,IW6
54 INTEGER , DIMENSION(:,:),ALLOCATABLE :: ITRI,LINE_ORD
55C=======================================================================
56 sizemax = clause%NB_LINE_SEG + 4*clause%NB_SURF_SEG
57
58 IF (sizemax == 0) RETURN
59
60!
61 line_nentity = 4 ! NOD1, NOD2, ELTYP, ELEM
62 ALLOCATE(line_ord(line_nentity,sizemax))
63 ALLOCATE(itri(3,sizemax))
64 ALLOCATE(index(2*sizemax))
65!
66 ALLOCATE(iw1(4*sizemax))
67 ALLOCATE(iw2(4*sizemax))
68 ALLOCATE(iw5(4*sizemax))
69 ALLOCATE(iw6(4*sizemax))
70!------------------
71 ! NSEG of lines initialization
72 nseg = clause%NB_LINE_SEG ! lines from 1D_element
73! Fill in LINE_ORD array the already stored line from 1D_element
74 DO i=1,nseg
75 line_ord(1,i) = clause%LINE_NODES(i,1)
76 line_ord(2,i) = clause%LINE_NODES(i,2)
77 line_ord(3,i) = clause%LINE_ELTYP(i)
78 line_ord(4,i) = clause%LINE_ELEM(i)
79 ENDDO
80!
81! extract lines from furfaces
82!
83 nseg_surf = clause%NB_SURF_SEG
84 IF (nseg_surf > 0) THEN
85!***********************************
86!***********************************
87 ! -- EXT -- edges form SURFACE
88!***********************************
89!***********************************
90 nseg_edge_ext = 0
91!---
92 k=0
93 iw1 = 0
94 iw2 = 0
95 iw5 = 0
96 iw6 = 0
97 DO i=1,nseg_surf
98 DO j1=1,4
99 j2=iperm(j1)
100 IF (clause%SURF_NODES(i,j2) /= 0 .AND.
101 . clause%SURF_NODES(i,j1) > clause%SURF_NODES(i,j2)) THEN
102 k=k+1
103 iw1(k)=clause%SURF_NODES(i,j2)
104 iw2(k)=clause%SURF_NODES(i,j1)
105 iw5(k)=clause%SURF_ELTYP(i)
106 iw6(k)=clause%SURF_ELEM(i)
107 ELSEIF (clause%SURF_NODES(i,j1) /= 0 .AND.
108 . clause%SURF_NODES(i,j1) < clause%SURF_NODES(i,j2)) THEN
109 k=k+1
110 iw1(k)=clause%SURF_NODES(i,j1)
111 iw2(k)=clause%SURF_NODES(i,j2)
112 iw5(k)=clause%SURF_ELTYP(i)
113 iw6(k)=clause%SURF_ELEM(i)
114 ENDIF
115 ENDDO
116 ENDDO ! DO I=1,NSEG_SURF
117!
118 nseg_edge_ext = k
119C-----------------------------------------------
120 index = 0
121 iwork(1:70000) = 0
122 CALL my_orders( 0,iwork,iw1,index,k,1)
123 iwork(1:70000) = 0
124 CALL my_orders(10,iwork,iw2,index,k,1) ! my_order(10 uses previous index
125!---
126 IF (nseg_edge_ext > 0) THEN
127C-----------------------------------------------
128C REMOVE INTERNAL SEGMENTS (EXCEPT BOUNDARY)
129C-----------------------------------------------
130 IF (iw1(index(1)) /= iw1(index(2)).OR.
131 . iw2(index(1)) /= iw2(index(2)))THEN
132 nseg=nseg+1
133 line_ord(1,nseg) = iw1(index(1))
134 line_ord(2,nseg) = iw2(index(1))
135 line_ord(3,nseg) = iw5(index(1))
136 line_ord(4,nseg) = iw6(index(1))
137 ENDIF
138 DO i=2,k-1
139 IF ((iw1(index(i-1)) /= iw1(index(i)).OR.
140 . iw2(index(i-1)) /= iw2(index(i))).AND.
141 . (iw1(index(i+1)) /= iw1(index(i)).OR.
142 . iw2(index(i+1)) /= iw2(index(i)))) THEN
143 nseg=nseg+1
144 line_ord(1,nseg) = iw1(index(i))
145 line_ord(2,nseg) = iw2(index(i))
146 line_ord(3,nseg) = iw5(index(i))
147 line_ord(4,nseg) = iw6(index(i))
148 ENDIF
149 ENDDO
150 IF (iw1(index(k-1)) /= iw1(index(k)).OR.
151 . iw2(index(k-1)) /= iw2(index(k))) THEN
152 nseg=nseg+1
153 line_ord(1,nseg) = iw1(index(k))
154 line_ord(2,nseg) = iw2(index(k))
155 line_ord(3,nseg) = iw5(index(k))
156 line_ord(4,nseg) = iw6(index(k))
157 ENDIF
158 ENDIF ! IF (NSEG_EDGE_EXT > 0)
159 ENDIF ! IF (NSEG_SURF > 0)
160!------------------------------------------
161!------------------------------------------
162! ORDER LINES and LINE CLAUSE FILLING
163!------------------------------------------
164!------------------------------------------
165 index = 0
166 iwork(1:70000) = 0
167 DO i=1,nseg
168 index(i)=i
169 itri(1,i) = line_ord(1,i)
170 itri(2,i) = line_ord(2,i)
171 itri(3,i) = line_ord(4,i) ! elem_id
172 ENDDO
173 CALL my_orders(0,iwork,itri,index,nseg,3)
174!
175 ! reallocation of the line CLAUSE at the right dimension and final fill
176!
177 IF (ALLOCATED(clause%LINE_NODES)) DEALLOCATE(clause%LINE_NODES)
178 IF (ALLOCATED(clause%LINE_ELTYP)) DEALLOCATE(clause%LINE_ELTYP)
179 IF (ALLOCATED(clause%LINE_ELEM)) DEALLOCATE(clause%LINE_ELEM)
180!
181 clause%NB_LINE_SEG = nseg
182 CALL my_alloc(clause%LINE_NODES,nseg,2)
183 CALL my_alloc(clause%LINE_ELTYP,nseg)
184 CALL my_alloc(clause%LINE_ELEM,nseg)
185!
186 DO i=1,nseg
187 clause%LINE_NODES(i,1) = line_ord(1,index(i))
188 clause%LINE_NODES(i,2) = line_ord(2,index(i))
189 clause%LINE_ELTYP(i) = line_ord(3,index(i))
190 clause%LINE_ELEM(i) = line_ord(4,index(i))
191 ENDDO
192!---
193 IF (ALLOCATED(line_ord)) DEALLOCATE(line_ord)
194 IF (ALLOCATED(itri)) DEALLOCATE(itri)
195 IF (ALLOCATED(index)) DEALLOCATE(index)
196 IF (ALLOCATED(iw1)) DEALLOCATE(iw1)
197 IF (ALLOCATED(iw2)) DEALLOCATE(iw2)
198 IF (ALLOCATED(iw5)) DEALLOCATE(iw5)
199 IF (ALLOCATED(iw6)) DEALLOCATE(iw6)
200C-----------
201 RETURN
202 END
create_line_from_surface_ext
subroutine create_line_from_surface_ext(clause)
Definition create_line_from_surface_ext.F:30
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
setdef_mod
Definition setdef_mod.F:107