OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvvolu.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!|| fvvolu_mod ../starter/source/airbag/fvvolu.F
25!||--- called by ------------------------------------------------------
26!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
27!||====================================================================
28 MODULE fvvolu_mod
29 CONTAINS
30!||====================================================================
31!|| fvvolu ../starter/source/airbag/fvvolu.F
32!||--- called by ------------------------------------------------------
33!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
34!||--- calls -----------------------------------------------------
35!|| fvnormal ../starter/source/airbag/fvmbag1.F
36!||====================================================================
37 SUBROUTINE fvvolu(ITYP ,NNS ,NNTR ,NPOLH,
38 1 IBUF ,IBUFA ,ELEMA ,TAGELA ,
39 2 X ,IVOLU ,RVOLU ,
40 3 IFVNOD ,RFVNOD ,IFVTRI ,
41 4 IFVPOLY,IFVTADR,IFVPOLH,
42 5 IFVPADR,MPOLH ,
43 6 EPOLH ,VPOLH_INI)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47CC USE FVBAG_MOD
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "units_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER ITYP, NNS, NNTR, NPOLH
60 INTEGER IBUF(*), IBUFA(*), ELEMA(3,*), TAGELA(*),
61 . IVOLU(*), IFVNOD(3,*),IFVTRI(6,*),
62 . IFVPOLY(*),IFVTADR(*),IFVPOLH(*), IFVPADR(*)
63 my_real
64 . X(3,*), RVOLU(*), RFVNOD(2,*),
65 . mpolh(*), epolh(*),vpolh_ini(*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, J, K, I1, I2, IEL, JJ, KK,
70 . N1, N2, N3, NN1, NN2, NN3,
71 . NSTR, NCTR, NPOLH_N
72 my_real
73 . X1, Y1, Z1, X2, Y2, Z2, X3, Y3, Z3,
74 . NX, NY, NZ, AREA2, KSI, ETA, AREA, FAC,
75 . pnod(3,nns), pvolu(npolh), volph,
76 . parea(nntr), pnorm(3,nntr), areap
77 my_real
78 . cpai, cpbi, cpci, cpdi, cpei, cpfi,
79 . rmwi, pini, ti, ti2, rhoi, efac
80C---------------------------------------------------
81C Noeuds des volumes finis
82C---------------------------------------------------
83 x1 = zero
84 y1 = zero
85 z1 = zero
86 x2 = zero
87 y2 = zero
88 z2 = zero
89 x3 = zero
90 y3 = zero
91 z3 = zero
92 nx = zero
93 ny = zero
94 nz = zero
95
96
97 DO i=1,nns
98 IF (ifvnod(1,i)==1) THEN
99 iel=ifvnod(2,i)
100 ksi=rfvnod(1,i)
101 eta=rfvnod(2,i)
102C
103 n1=elema(1,iel)
104 n2=elema(2,iel)
105 n3=elema(3,iel)
106C
107 IF (tagela(iel)>0) THEN
108 nn1=ibuf(n1)
109 nn2=ibuf(n2)
110 nn3=ibuf(n3)
111 x1=x(1,nn1)
112 y1=x(2,nn1)
113 z1=x(3,nn1)
114 x2=x(1,nn2)
115 y2=x(2,nn2)
116 z2=x(3,nn2)
117 x3=x(1,nn3)
118 y3=x(2,nn3)
119 z3=x(3,nn3)
120 ELSEIF (tagela(iel)<0) THEN
121 nn1=ibufa(n1)
122 nn2=ibufa(n2)
123 nn3=ibufa(n3)
124 x1=x(1,nn1)
125 y1=x(2,nn1)
126 z1=x(3,nn1)
127 x2=x(1,nn2)
128 y2=x(2,nn2)
129 z2=x(3,nn2)
130 x3=x(1,nn3)
131 y3=x(2,nn3)
132 z3=x(3,nn3)
133 ENDIF
134 pnod(1,i)=(one-ksi-eta)*x1+ksi*x2+eta*x3
135 pnod(2,i)=(one-ksi-eta)*y1+ksi*y2+eta*y3
136 pnod(3,i)=(one-ksi-eta)*z1+ksi*z2+eta*z3
137C
138 ELSEIF (ifvnod(1,i)==2) THEN
139 i2=ifvnod(2,i)
140 pnod(1,i)=x(1,i2)
141 pnod(2,i)=x(2,i2)
142 pnod(3,i)=x(3,i2)
143 ENDIF
144 ENDDO
145C
146 DO i=1,nns
147 IF (ifvnod(1,i)==3) THEN
148 i1=ifvnod(2,i)
149 i2=ifvnod(3,i)
150 fac=rfvnod(1,i)
151 pnod(1,i)=fac*pnod(1,i1)+(one-fac)*pnod(1,i2)
152 pnod(2,i)=fac*pnod(2,i1)+(one-fac)*pnod(2,i2)
153 pnod(3,i)=fac*pnod(3,i1)+(one-fac)*pnod(3,i2)
154 ENDIF
155 ENDDO
156C----------------------------
157C Normale, aire des triangles
158C----------------------------
159 DO i=1,nntr
160 n1=ifvtri(1,i)
161 n2=ifvtri(2,i)
162 n3=ifvtri(3,i)
163 CALL fvnormal(pnod,n1,n2,n3,0,nx,ny,nz)
164 area2=sqrt(nx*nx+ny*ny+nz*nz)
165 parea(i)=half*area2
166 IF (area2>0) THEN
167 pnorm(1,i)=nx/area2
168 pnorm(2,i)=ny/area2
169 pnorm(3,i)=nz/area2
170 ELSE
171 pnorm(1,i)=zero
172 pnorm(2,i)=zero
173 pnorm(3,i)=zero
174 ENDIF
175 ENDDO
176C----------------------
177C Volume des polyhedres
178C----------------------
179 DO i=1,npolh
180 pvolu(i)=zero
181C Boucle sur les polygones du polyhedre
182 DO j=ifvpadr(i),ifvpadr(i+1)-1
183 jj=ifvpolh(j)
184C Boucle sur les triangles du polygone
185 DO k=ifvtadr(jj), ifvtadr(jj+1)-1
186 kk=ifvpoly(k)
187 area=parea(kk)
188 iel=ifvtri(4,kk)
189 IF (iel>0) THEN
190 nx=pnorm(1,kk)
191 ny=pnorm(2,kk)
192 nz=pnorm(3,kk)
193 ELSE
194 IF (ifvtri(5,kk)==i) THEN
195 nx=pnorm(1,kk)
196 ny=pnorm(2,kk)
197 nz=pnorm(3,kk)
198 ELSEIF (ifvtri(6,kk)==i) THEN
199 nx=-pnorm(1,kk)
200 ny=-pnorm(2,kk)
201 nz=-pnorm(3,kk)
202 ENDIF
203 ENDIF
204 n1=ifvtri(1,kk)
205 x1=pnod(1,n1)
206 y1=pnod(2,n1)
207 z1=pnod(3,n1)
208 pvolu(i)=pvolu(i)+third*area*(x1*nx+y1*ny+z1*nz)
209 ENDDO
210 ENDDO
211 ENDDO
212C---------------------------------------------------
213C Impressions
214C---------------------------------------------------
215 volph=zero
216 areap=zero
217 npolh_n=0
218 DO i=1,npolh
219 volph=volph+pvolu(i)
220 IF (pvolu(i)<=zero) npolh_n=npolh_n+1
221 ENDDO
222C
223 nstr=0
224 nctr=0
225 DO i=1,nntr
226 IF (ifvtri(4,i)>0) THEN
227 nstr=nstr+1
228 areap=areap+parea(i)
229 ELSE
230 nctr=nctr+1
231 ENDIF
232 ENDDO
233C
234 WRITE(iout,1000) ivolu(1),nstr,nctr,npolh,npolh_n,volph,areap
235C
236C---------------------------------------------------
237C Update des quantites dans les polyhedres
238C---------------------------------------------------
239 cpai =rvolu(7)
240 cpbi =rvolu(8)
241 cpci =rvolu(9)
242 rmwi =rvolu(10)
243 pini =rvolu(12)
244 ti =rvolu(13)
245 ti2 =ti*ti
246 efac=ti*(cpai+half*cpbi*ti+third*cpci*ti2-rmwi)
247 rhoi=pini/(ti*rmwi)
248 cpdi=rvolu(56)
249 cpei=rvolu(57)
250 cpfi=rvolu(58)
251 IF(ityp == 8) THEN
252 efac=efac+fourth*cpdi*ti2*ti2-cpei/ti+one_fifth*cpfi*ti2*ti2*ti
253 ENDIF
254 DO i=1,npolh
255 mpolh(i)=rhoi*pvolu(i)
256 epolh(i)=mpolh(i)*efac
257 vpolh_ini(i)=pvolu(i)
258 ENDDO
259C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
2601000 FORMAT(
261 . //' fvmbag: finite volume mesh on initial geometry'/
262 . ' ----------------------------------------------'/
263 . /5X,'volume number ',I10,
264 . /5X,'number of surface triangles . . . . . . .=',I10,
265 . /5X,'number of communication triangles . . . .=',I10,
266 . /5X,'number of finite volumes. . . . . . . . .=',I10,
267 . /5X,'number of finite volumes with volume <0 .=',I10,
268 . /5X,'sum volume of finite volumes. . . . . . .=',1PG20.13,
269 . /5X,'sum area surface triangles. . . . . . . .=',1PG20.13/)
270 RETURN
271 END SUBROUTINE FVVOLU
272 END MODULE FVVOLU_MOD
fvnormal
subroutine fvnormal(x, n1, n2, n3, n4, nx, ny, nz)
Definition fvmbag1.F:576
fvvolu_mod
Definition fvvolu.F:28
fvvolu_mod::fvvolu
subroutine fvvolu(ityp, nns, nntr, npolh, ibuf, ibufa, elema, tagela, x, ivolu, rvolu, ifvnod, rfvnod, ifvtri, ifvpoly, ifvtadr, ifvpolh, ifvpadr, mpolh, epolh, vpolh_ini)
Definition fvvolu.F:44