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