OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvelinte.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!|| fvelinte_mod ../starter/source/airbag/fvelinte.F
25!||--- called by ------------------------------------------------------
26!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
27!||====================================================================
28 MODULE fvelinte_mod
29 CONTAINS
30!||====================================================================
31!|| fvelinte ../starter/source/airbag/fvelinte.F
32!||--- called by ------------------------------------------------------
33!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
34!||--- uses -----------------------------------------------------
35!|| fvbag_mod ../starter/share/modules1/fvbag_mod.F
36!||====================================================================
37 SUBROUTINE fvelinte(IBUF, ELEM, IXC, IXTG, PM, IPM, ILVOUT, IFV,
38 . NNT, NTG, POROSITY, NSEG,SURF_ELTYP,
39 . NTGI,ELTG,NB_NODE,SURF_ELEM)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE fvbag_mod
44 use element_mod , only : nixc,nixtg
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com04_c.inc"
53#include "param_c.inc"
54#include "units_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IXC(NIXC,*), IXTG(NIXTG,*), IPM(NPROPMI,*), ILVOUT, IFV
59 INTEGER IBUF(*), ELEM(3,*), NNT, NTG, SURF_ELTYP(*),SURF_ELEM(*)
60 INTEGER NSEG,NTGI, ELTG(*), NB_NODE
61 my_real pm(npropm,*), porosity(*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I, II, J, JJ, ICMAX, NC, I1, I2, I3, IFOUND
66 INTEGER K, KK, ITY, N1, N2, N3, IEL, ILAW, MAT, LEAK
67 INTEGER J1, J2, J3, NNT_TMP
68 CHARACTER*6 TITL
69 INTEGER, DIMENSION(:,:), ALLOCATABLE :: CNS
70 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG,ITAGC,ITAGTG
71
72
73 ALLOCATE(itag(nb_node))
74 ALLOCATE(itagc(numelc))
75 ALLOCATE(itagtg(numeltg))
76C
77 DO i=1,nb_node
78 itag(i)=0
79 ENDDO
80
81C Number connected surface element to each node
82 DO i = 1, ntgi
83 n1 = elem(1, i)
84 n2 = elem(2, i)
85 n3 = elem(3, i)
86 n1 = ibuf(n1)
87 n2 = ibuf(n2)
88 n3 = ibuf(n3)
89 itag(n1) = itag(n1) + 1
90 itag(n2) = itag(n2) + 1
91 itag(n3) = itag(n3) + 1
92 ENDDO
93C Build connectivity
94 icmax = 0
95 DO i = 1, nb_node
96 icmax = max(icmax, itag(i))
97 ENDDO
98 DO i = 1, ntgi
99 n1 = elem(1, i)
100 n2 = elem(2, i)
101 n3 = elem(3, i)
102 n1 = ibuf(n1)
103 n2 = ibuf(n2)
104 n3 = ibuf(n3)
105 itag(n1) = 0
106 itag(n2) = 0
107 itag(n3) = 0
108 ENDDO
109 ALLOCATE(cns(nb_node,1+icmax*2))
110 DO i=1,nb_node
111 cns(i, 1)=0
112 ENDDO
113 DO i = 1, ntgi
114C Node 1
115 n1 = ibuf(elem(1, i))
116 nc = cns(n1, 1)
117 nc = nc + 1
118 cns(n1, 1) = nc
119 cns(n1, 1 + nc) = i
120C Node 2
121 n2 = ibuf(elem(2, i))
122 nc = cns(n2, 1)
123 nc = nc + 1
124 cns(n2, 1) = nc
125 cns(n2, 1 + nc) = i
126C Node 3
127 n3 = ibuf(elem(3, i))
128 nc = cns(n3, 1)
129 nc = nc + 1
130 cns(n3, 1) = nc
131 cns(n3, 1 + nc) = i
132 ENDDO
133
134 DO i=1,fvdata(ifv)%NNTR
135 iel=fvdata(ifv)%IFVTRI(4,i)
136 IF (iel == 0) THEN
137C Internal triangle Pressing on solid element
138 ifound=0
139 i1=fvdata(ifv)%IFVTRI(1,i)
140 i2=fvdata(ifv)%IFVTRI(2,i)
141 i3=fvdata(ifv)%IFVTRI(3,i)
142 n1=fvdata(ifv)%IFVNOD(1,i1)
143 n2=fvdata(ifv)%IFVNOD(1,i2)
144 n3=fvdata(ifv)%IFVNOD(1,i3)
145 IF(n1==2.AND.n2==2.AND.n3==2) THEN
146 i1=fvdata(ifv)%IFVNOD(2,i1)
147 i2=fvdata(ifv)%IFVNOD(2,i2)
148 i3=fvdata(ifv)%IFVNOD(2,i3)
149 itag(i1) = 1
150 itag(i2) = 1
151 itag(i3) = 1
152C Surface elements connected to node I1
153 DO j = 1, cns(i1,1)
154 n1 = ibuf(elem(1, cns(i1, 1 + j)))
155 n2 = ibuf(elem(2, cns(i1, 1 + j)))
156 n3 = ibuf(elem(3, cns(i1, 1 + j)))
157 IF (itag(n1) * itag(n2) * itag(n3) /= 0) THEN
158 fvdata(ifv)%IFVTRI(4,i) = -cns(i1, 1 + j)
159 ENDIF
160 ENDDO
161C reset tags
162 itag(i1) = 0
163 itag(i2) = 0
164 itag(i3) = 0
165 ENDIF
166 ENDIF
167 ENDDO
168
169 DEALLOCATE(cns)
170
171 DO i=1,numelc
172 itagc(i)=0
173 DO j=1,4
174 jj=ixc(1+j,i)
175 itag(jj)=itag(jj)+1
176 ENDDO
177 ENDDO
178 DO i=1,numeltg
179 itagtg(i)=0
180 DO j=1,3
181 jj=ixtg(1+j,i)
182 itag(jj)=itag(jj)+1
183 ENDDO
184 ENDDO
185C TAG elements of internal surface
186 DO i=1,nseg
187 ity=surf_eltyp(i)
188 ii =surf_elem(i)
189 IF(ity==3) itagc(ii)=1
190 IF(ity==7) itagtg(ii)=1
191 ENDDO
192
193 icmax=0
194 DO i=1,nb_node
195 icmax=max(icmax,itag(i))
196 ENDDO
197
198 ALLOCATE(cns(nb_node,1+icmax*2))
199 DO i=1,nb_node
200 cns(i,1)=0
201 ENDDO
202 DO i=1,numelc
203 IF(itagc(i)==0) cycle
204 DO j=1,4
205 jj=ixc(1+j,i)
206 nc=cns(jj,1)
207 nc=nc+1
208 cns(jj,1)=nc
209 cns(jj,1+2*(nc-1)+1)=1
210 cns(jj,1+2*(nc-1)+2)=i
211 ENDDO
212 ENDDO
213 DO i=1,numeltg
214 IF(itagtg(i)==0) cycle
215 DO j=1,3
216 jj=ixtg(1+j,i)
217 nc=cns(jj,1)
218 nc=nc+1
219 cns(jj,1)=nc
220 cns(jj,1+2*(nc-1)+1)=2
221 cns(jj,1+2*(nc-1)+2)=i
222 ENDDO
223 ENDDO
224
225 DO i=1,nb_node
226 itag(i) = 0
227 ENDDO
228
229 nnt_tmp = 0
230 DO i=1,fvdata(ifv)%NNTR
231 iel=fvdata(ifv)%IFVTRI(4,i)
232 IF (iel < 0) THEN
233C Internal triangle Pressing on solid element
234 ifound=0
235 i1=fvdata(ifv)%IFVTRI(1,i)
236 i2=fvdata(ifv)%IFVTRI(2,i)
237 i3=fvdata(ifv)%IFVTRI(3,i)
238 n1=fvdata(ifv)%IFVNOD(1,i1)
239 n2=fvdata(ifv)%IFVNOD(1,i2)
240 n3=fvdata(ifv)%IFVNOD(1,i3)
241 IF(n1==2.AND.n2==2.AND.n3==2) THEN
242 i1=fvdata(ifv)%IFVNOD(2,i1)
243 i2=fvdata(ifv)%IFVNOD(2,i2)
244 i3=fvdata(ifv)%IFVNOD(2,i3)
245 DO j=1,cns(i1,1)
246 ity=cns(i1,1+2*(j-1)+1)
247 jj=cns(i1,1+2*(j-1)+2)
248 IF (ity==1) THEN
249 DO k=1,4
250 kk=ixc(1+k,jj)
251 itag(kk)=1
252 ENDDO
253 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
254 ifound=jj
255 ENDIF
256 DO k=1,4
257 kk=ixc(1+k,jj)
258 itag(kk)=0
259 ENDDO
260 ELSEIF (ity==2) THEN
261 DO k=1,3
262 kk=ixtg(1+k,jj)
263 itag(kk)=1
264 ENDDO
265 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
266 ifound=numelc+jj
267 ENDIF
268 DO k=1,3
269 kk=ixtg(1+k,jj)
270 itag(kk)=0
271 ENDDO
272 ENDIF
273 IF (ifound /= 0) THEN
274 EXIT
275 ENDIF
276 ENDDO
277 IF(ifound/=0) THEN
278 fvdata(ifv)%IFVTRI(4,i)=-ifound
279 nnt_tmp = nnt_tmp + 1
280 ENDIF
281 ENDIF
282 ENDIF
283 ENDDO
284
285C REDEFINE INTERNAL TRIANGLE FOR COMPATIBILITY WITH BRICKS
286
287 DO i=1,nnt
288 j=ibuf(i)
289 itag(j)=i
290 ENDDO
291 ii=0
292 DO i=1,fvdata(ifv)%NNTR
293 ifound=fvdata(ifv)%IFVTRI(4,i)
294 IF(ifound<0) THEN
295 i1=fvdata(ifv)%IFVTRI(1,i)
296 i2=fvdata(ifv)%IFVTRI(2,i)
297 i3=fvdata(ifv)%IFVTRI(3,i)
298 j1=fvdata(ifv)%IFVNOD(1,i1)
299 j2=fvdata(ifv)%IFVNOD(1,i2)
300 j3=fvdata(ifv)%IFVNOD(1,i3)
301 IF(j1 == 2 .AND. j2==2 .AND. j3==2) THEN
302 n1=fvdata(ifv)%IFVNOD(2,i1)
303 n2=fvdata(ifv)%IFVNOD(2,i2)
304 n3=fvdata(ifv)%IFVNOD(2,i3)
305 ii=ii+1
306 elem(1,ii)=itag(n1)
307 elem(2,ii)=itag(n2)
308 elem(3,ii)=itag(n3)
309 fvdata(ifv)%IFVTRI(4,i)=-ntg-ii
310 eltg(ntg+ii)=-ifound
311 ENDIF
312 ENDIF
313 ENDDO
314
315C DEFINE POROSITY
316
317 IF(ilvout >= 1) WRITE(iout,1000)
318 DO i=1,ntgi
319 iel=eltg(ntg+i)
320 IF (iel<=numelc) THEN
321 mat =ixc(1,iel)
322 kk =ixc(nixc,iel)
323 titl='SHELL:'
324 ELSEIF (iel>numelc) THEN
325 jj=iel-numelc
326 mat =ixtg(1,jj)
327 kk =ixtg(nixtg,jj)
328 titl='SH3N: '
329 ENDIF
330
331 ilaw=ipm(2,mat)
332 leak=ipm(4,mat)
333 IF (ilaw == 0) THEN
334 porosity(i)=one
335 ELSEIF(ilaw == 19 .AND. leak == 0) THEN
336 porosity(i)=pm(56,mat)
337 ELSE
338 porosity(i)=zero
339 ENDIF
340 IF(ilvout >= 1) THEN
341 IF(ilaw == 58 .OR. (ilaw == 19 .AND. leak > 0)) THEN
342 WRITE(iout,1100) i,titl,kk,leak
343 ELSE
344 WRITE(iout,1150) i,titl,kk,porosity(i)
345 ENDIF
346 ENDIF
347 ENDDO
348
349 IF(ilvout >= 5) THEN
350 WRITE(iout,1200)
351 DO i=1,fvdata(ifv)%NNTR
352 i1=fvdata(ifv)%IFVTRI(1,i)
353 i2=fvdata(ifv)%IFVTRI(2,i)
354 i3=fvdata(ifv)%IFVTRI(3,i)
355 n1=fvdata(ifv)%IFVTRI(4,i)
356 n2=fvdata(ifv)%IFVTRI(5,i)
357 n3=fvdata(ifv)%IFVTRI(6,i)
358 WRITE(iout,'(5X,7I8)') i,i1,i2,i3,n1,n2,n3
359 ENDDO
360
361 WRITE(iout,1300)
362 DO i=1,fvdata(ifv)%NNS
363 n1=fvdata(ifv)%IFVNOD(1,i)
364 n2=fvdata(ifv)%IFVNOD(2,i)
365 n3=fvdata(ifv)%IFVNOD(3,i)
366 WRITE(iout,'(5X,4I8)') i,n1,n2,n3
367 ENDDO
368 ENDIF
369C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
370 1000 FORMAT(/5x,'FVMBAG INTERNAL ELEMENTS <-> SHELL or SH3N ',
371 . 3x,'POROSITY/ILEAKAGE'
372 . /5x,'----------------------------------------------------',
373 . '-----------')
374 1100 FORMAT( 5x,'TRIANGLE:',i8,' <-> ',a,i10,10x,i6)
375 1150 FORMAT( 5x,'TRIANGLE:',i8,' <-> ',a,i10,10x,f6.3)
376 1200 FORMAT(/5x,'TRIANGLE',9x,'NODES',10x,'ELEMENT',4x,'FINITE VOLUME')
377 1300 FORMAT(/5x,'FV POINT',4x,'FLAG',1x,'ELEM/NODE',2x,'NODE')
378
379 DEALLOCATE(cns)
380 DEALLOCATE(itag)
381 DEALLOCATE(itagc)
382 DEALLOCATE(itagtg)
383
384
385 RETURN
386 END SUBROUTINE fvelinte
387 END MODULE fvelinte_mod
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128
fvelinte_mod
Definition fvelinte.F:28
fvelinte_mod::fvelinte
subroutine fvelinte(ibuf, elem, ixc, ixtg, pm, ipm, ilvout, ifv, nnt, ntg, porosity, nseg, surf_eltyp, ntgi, eltg, nb_node, surf_elem)
Definition fvelinte.F:40