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