OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvbric01.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!|| fvbric01 ../starter/source/airbag/fvbric01.F
25!||--- called by ------------------------------------------------------
26!|| init_monvol ../starter/source/airbag/init_monvol.F
27!||--- calls -----------------------------------------------------
28!|| arret ../starter/source/system/arret.F
29!|| iface ../starter/source/ale/ale3d/iface.F
30!||--- uses -----------------------------------------------------
31!||====================================================================
32 SUBROUTINE fvbric01(IBUF, ELEM, NTGI, NB_NODE, NBRIC, IXS,
33 . TBRIC, TFAC)
34C-----------------------------------------------
35C D e s c r i p t i o n
36C-----------------------------------------------
37C Find brick faces connected to internal airbag surface.
38C Faces are flagged -2 in th TFAC array.
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE groupdef_mod
43 use element_mod , only : nixs
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51C NIXS
52C NUMELS
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER, INTENT(IN) :: NBRIC, NTGI, NB_NODE, TBRIC(2, NBRIC), IXS(NIXS, *)
57 INTEGER, INTENT(IN) :: IBUF(*), ELEM(3, NTGI)
58 INTEGER, INTENT(INOUT) :: TFAC(12, NBRIC)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER :: II, KK, KKK, KKKK, JJ, CONNECT_MAX, NODEID, COUNT, ELID, ELID1
63 INTEGER :: NSEG, IFACE, ITYPE, NNODE, NSURFNODE, SUM
64 INTEGER, DIMENSION(:), ALLOCATABLE :: IFLAG
65 INTEGER, DIMENSION(:, :), ALLOCATABLE :: N_E_CONNECT, N_E_CONNECT_LOCID
66 INTEGER, TARGET :: REDIRT(4), REDIRP(6), REDIRB(8), REDIRPY(5),
67 . nod8(6), nod3(4), nod6(5), nod5(5),
68 . fac8(4,6), fac4(3,4), fac6(4,5), fac5(4,5), nface(4)
69 INTEGER, DIMENSION(:), POINTER :: REDIR, NOD
70 INTEGER, DIMENSION(:,:), POINTER :: FAC
71 DATA fac4 /1,5,3,
72 . 3,5,6,
73 . 6,5,1,
74 . 1,3,6/
75 DATA fac8 /1,4,3,2,
76 . 5,6,7,8,
77 . 1,2,6,5,
78 . 2,3,7,6,
79 . 3,4,8,7,
80 . 4,1,5,8/
81 DATA fac6 /1,3,2,0,
82 . 5,6,7,0,
83 . 1,2,6,5,
84 . 2,3,7,6,
85 . 3,4,8,7/
86 DATA nod6 /3,3,4,4,4/
87 DATA nod8 /4,4,4,4,4,4/
88 DATA nod3 /3,3,3,3/
89 DATA fac5 /1,2,5,0,
90 . 2,3,5,0,
91 . 3,4,5,0,
92 . 4,1,5,0,
93 . 1,4,3,2/
94 DATA nod5 /3,3,3,3,4/
95 DATA nface/6,4,5,5/
96
97 LOGICAL :: FACE_OK
98 INTEGER, TARGET :: nothing(1,1)
99
100C-----------------------------------------------
101C S o u r c e l i n e s
102C-----------------------------------------------
103 redir => nothing(:,1)
104 nod => nothing(:,1)
105 fac => nothing
106 nnode = 0
107C TETRA indirection
108 redirt(1)=1
109 redirt(2)=3
110 redirt(3)=5
111 redirt(4)=6
112C BRICK indirection
113 DO kk = 1, 8
114 redirb(kk) = kk
115 ENDDO
116C PENTA indirection
117 redirp(1)=1
118 redirp(2)=2
119 redirp(3)=3
120 redirp(4)=5
121 redirp(5)=6
122 redirp(6)=7
123C PYRAMIDE indirection
124 DO kk = 1, 5
125 redirpy(kk) = kk
126 ENDDO
127
128
129C Start
130
131 nseg = ntgi
132
133C Count maximum connectivity
134 ALLOCATE(iflag(nb_node))
135 iflag(1:nb_node) = 0
136 DO ii = 1, nbric
137 elid = tbric(1, ii)
138 itype = tbric(2, ii)
139 SELECT CASE(itype)
140 CASE(1)
141C Brick
142 nnode = 8
143 redir => redirb(1:8)
144 CASE(2)
145C Tetra
146 nnode = 4
147 redir => redirt(1:4)
148 CASE(3)
149C Penta
150 nnode = 6
151 redir => redirp(1:6)
152 CASE(4)
153C Pyramide
154 nnode = 5
155 redir => redirpy(1:5)
156 CASE DEFAULT
157 nnode = -huge(nnode)
158 redir => null()
159 CALL arret(2)
160 END SELECT
161 DO kk = 1, nnode
162 nodeid = ixs(1 + redir(kk), elid)
163 iflag(nodeid) = iflag(nodeid) + 1
164 ENDDO
165 ENDDO
166
167 connect_max = maxval(iflag(1:nb_node))
168
169C Node element connectivity
170 ALLOCATE(n_e_connect(nb_node, connect_max + 1))
171 ALLOCATE(n_e_connect_locid(nb_node, connect_max + 1))
172 n_e_connect(1:nb_node, 1:connect_max + 1) = 0
173 n_e_connect_locid(1:nb_node, 1:connect_max + 1) = 0
174 DO ii = 1, nbric
175 elid = tbric(1, ii)
176 itype = tbric(2, ii)
177 SELECT CASE(itype)
178 CASE(1)
179C Brick
180 nnode = 8
181 redir => redirb(1:8)
182 CASE(2)
183C Tetra
184 nnode = 4
185 redir => redirt(1:4)
186 CASE(3)
187C Penta
188 nnode = 6
189 redir => redirp(1:6)
190 CASE(4)
191C Pyramide
192 nnode = 5
193 redir => redirpy(1:5)
194 CASE DEFAULT
195 CALL arret(2)
196 END SELECT
197 DO kk = 1, nnode
198 nodeid = ixs(1 + redir(kk), elid)
199 count = n_e_connect(nodeid, 1)
200 count = count + 1
201 n_e_connect(nodeid, 1) = count
202 n_e_connect(nodeid, count + 1) = elid
203 n_e_connect_locid(nodeid, count + 1) = ii
204 ENDDO
205 ENDDO
206
207C Reset IFLAG to 0
208 iflag(1:nb_node) = 0
209 count = 0
210C Find bricks connected to surface element
211 DO ii = 1, nseg
212 nsurfnode = 3
213C Flag surface nodes
214 DO kk = 1, nsurfnode
215 kkk = ibuf(elem(kk, ii))
216 iflag(kkk) = 1
217 ENDDO
218 DO kk = 1, nsurfnode
219 kkk = ibuf(elem(kk, ii))
220 DO jj = 1, n_e_connect(kkk, 1)
221 elid = n_e_connect(kkk, 1 + jj)
222 itype = tbric(2, ii)
223 SELECT CASE(itype)
224 CASE(1)
225C Brick
226 nnode = 8
227 redir => redirb(1:8)
228 fac => fac8(1:4, 1:6)
229 nod => nod8(1:6)
230 CASE(2)
231C Tetra
232 nnode = 4
233 redir => redirt(1:4)
234 fac => fac4(1:3, 1:4)
235 nod => nod3(1:4)
236 CASE(3)
237C Penta
238 nnode = 6
239 redir => redirp(1:6)
240 fac => fac6(1:4, 1:5)
241 nod => nod6(1:5)
242 CASE(4)
243C Pyramide
244 nnode = 5
245 redir => redirpy(1:5)
246 fac => fac5(1:4, 1:5)
247 nod => nod5(1:5)
248 CASE DEFAULT
249 CALL arret(2)
250 END SELECT
251 sum = 0
252 DO kkkk = 1, nnode
253 nodeid = ixs(1 + redir(kkkk), elid)
254 sum = sum + iflag(nodeid)
255 ENDDO
256 IF (sum == nsurfnode) THEN
257C Find the corresponding face
258 face_ok = .false.
259 DO iface = 1, nface(itype)
260 sum = 0
261 DO kkkk = 1, nod(iface)
262 sum = sum + iflag(ixs(1 + fac(kkkk, iface), elid))
263 ENDDO
264 IF (sum == nsurfnode) THEN
265 face_ok = .true.
266 ENDIF
267 IF (face_ok) THEN
268 EXIT
269 ENDIF
270 ENDDO
271 IF (.NOT. face_ok) THEN
272 CALL arret(2)
273 ELSE
274 elid1 = n_e_connect_locid(kkk, 1 + jj)
275 tfac(2 * iface - 1, elid1) = -2
276 count = count + 1
277 ENDIF
278 ENDIF
279 ENDDO
280 ENDDO
281C Unflag surface nodes element
282 DO kk = 1, nsurfnode
283 kkk = ibuf(elem(kk, ii))
284 iflag(kkk) = 0
285 ENDDO
286 ENDDO
287
288C Memory deallocation
289 DEALLOCATE(iflag)
290 DEALLOCATE(n_e_connect)
291 DEALLOCATE(n_e_connect_locid)
292 END SUBROUTINE
fvbric01
subroutine fvbric01(ibuf, elem, ntgi, nb_node, nbric, ixs, tbric, tfac)
Definition fvbric01.F:34
groupdef_mod
Definition groupdef_mod.F:668
arret
subroutine arret(nn)
Definition arret.F:86