OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvlength.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!|| fvlength_mod ../starter/source/airbag/fvlength.F
25!||--- called by ------------------------------------------------------
26!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
27!||====================================================================
28 MODULE fvlength_mod
29 CONTAINS
30!||====================================================================
31!|| fvlength ../starter/source/airbag/fvlength.F
32!||--- called by ------------------------------------------------------
33!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
34!||--- calls -----------------------------------------------------
35!|| fvnormal ../starter/source/airbag/fvmbag1.F
36!||====================================================================
37 SUBROUTINE fvlength(NNS ,NNTR ,NPOLH,
38 1 IBUF ,IBUFA ,ELEMA ,TAGELA ,
39 2 X ,IVOLU ,
40 3 IFVNOD ,RFVNOD ,IFVTRI ,
41 4 IFVPOLY,IFVTADR,IFVPOLH,
42 5 IFVPADR,IBPOLH ,DLH )
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-----------------------------------------------
50#include "units_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NNS, NNTR, NPOLH
55 INTEGER IBUF(*), IBUFA(*), ELEMA(3,*), TAGELA(*),
56 . IVOLU(*), IBPOLH(*), IFVNOD(3,*),IFVTRI(6,*),
57 . IFVPOLY(*),IFVTADR(*),IFVPOLH(*), IFVPADR(*)
58 my_real X(3,*), RFVNOD(2,*), DLH
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I, J, K, I1, I2, IEL, JJ, KK,
63 . n1, n2, n3, nn1, nn2, nn3,
64 . nadbr
65 INTEGER IDBR1, IDBR2, IDBR3
66 my_real
67 . x1, y1, z1, x2, y2, z2, x3, y3, z3,
68 . nx, ny, nz, area2, ksi, eta, area, fac,
69 . areapoly, areapolymax,
70 . pnod(3,nns), pvolu(npolh),
71 . parea(nntr), pnorm(3,nntr)
72 my_real
73 . x12, y12, z12, x23, y23, z23, x31, y31, z31,
74 . l12, l23, l31, dl0, dl1, dl2, dll, dlbr1, dlbr2, dlbr3
75C---------------------------------------------------
76C Noeuds des volumes finis
77C---------------------------------------------------
78 x12 = zero
79 y12 = zero
80 z12 = zero
81 x23 = zero
82 y23 = zero
83 z23 = zero
84 x31 = zero
85 y31 = zero
86 z31 = zero
87 dl0 = dlh
88 dl1 = ep30
89 dl2 = ep30
90 dlbr1 = ep30
91 dlbr2 = ep30
92 dlbr3 = ep30
93 x1 = zero
94 y1 = zero
95 z1 = zero
96 x2 = zero
97 y2 = zero
98 z2 = zero
99 x3 = zero
100 y3 = zero
101 z3 = zero
102
103
104 DO i=1,nns
105 IF (ifvnod(1,i)==1) THEN
106 iel=ifvnod(2,i)
107 ksi=rfvnod(1,i)
108 eta=rfvnod(2,i)
109C
110 n1=elema(1,iel)
111 n2=elema(2,iel)
112 n3=elema(3,iel)
113C
114 IF (tagela(iel)>0) THEN
115 nn1=ibuf(n1)
116 nn2=ibuf(n2)
117 nn3=ibuf(n3)
118 x1=x(1,nn1)
119 y1=x(2,nn1)
120 z1=x(3,nn1)
121 x2=x(1,nn2)
122 y2=x(2,nn2)
123 z2=x(3,nn2)
124 x3=x(1,nn3)
125 y3=x(2,nn3)
126 z3=x(3,nn3)
127 ELSEIF (tagela(iel)<0) THEN
128 nn1=ibufa(n1)
129 nn2=ibufa(n2)
130 nn3=ibufa(n3)
131 x1=x(1,nn1)
132 y1=x(2,nn1)
133 z1=x(3,nn1)
134 x2=x(1,nn2)
135 y2=x(2,nn2)
136 z2=x(3,nn2)
137 x3=x(1,nn3)
138 y3=x(2,nn3)
139 z3=x(3,nn3)
140 ENDIF
141 pnod(1,i)=(one-ksi-eta)*x1+ksi*x2+eta*x3
142 pnod(2,i)=(one-ksi-eta)*y1+ksi*y2+eta*y3
143 pnod(3,i)=(one-ksi-eta)*z1+ksi*z2+eta*z3
144C
145 ELSEIF (ifvnod(1,i)==2) THEN
146 i2=ifvnod(2,i)
147 pnod(1,i)=x(1,i2)
148 pnod(2,i)=x(2,i2)
149 pnod(3,i)=x(3,i2)
150 ENDIF
151 ENDDO
152C
153 DO i=1,nns
154 IF (ifvnod(1,i)==3) THEN
155 i1=ifvnod(2,i)
156 i2=ifvnod(3,i)
157 fac=rfvnod(1,i)
158 pnod(1,i)=fac*pnod(1,i1)+(one-fac)*pnod(1,i2)
159 pnod(2,i)=fac*pnod(2,i1)+(one-fac)*pnod(2,i2)
160 pnod(3,i)=fac*pnod(3,i1)+(one-fac)*pnod(3,i2)
161 ENDIF
162 ENDDO
163C----------------------------
164C Normale, aire des triangles
165C----------------------------
166 DO i=1,nntr
167 n1=ifvtri(1,i)
168 n2=ifvtri(2,i)
169 n3=ifvtri(3,i)
170 CALL fvnormal(pnod,n1,n2,n3,0,nx,ny,nz)
171 area2=sqrt(nx*nx+ny*ny+nz*nz)
172 parea(i)=half*area2
173 IF (area2>0) THEN
174 pnorm(1,i)=nx/area2
175 pnorm(2,i)=ny/area2
176 pnorm(3,i)=nz/area2
177 ELSE
178 pnorm(1,i)=zero
179 pnorm(2,i)=zero
180 pnorm(3,i)=zero
181 ENDIF
182 ENDDO
183C------------------------------------------
184C Volume des polyhedres et longueur minimum
185C------------------------------------------
186 dl0=dlh
187 dl1=ep30
188 dl2=ep30
189 dlbr1=ep30
190 dlbr2=ep30
191 dlbr3=ep30
192 nadbr=0
193 DO i=1,npolh
194 pvolu(i)=zero
195 areapolymax=zero
196C Boucle sur les polygones du polyhedre
197 DO j=ifvpadr(i),ifvpadr(i+1)-1
198 jj=ifvpolh(j)
199 areapoly=zero
200C Boucle sur les triangles du polygone
201 DO k=ifvtadr(jj), ifvtadr(jj+1)-1
202 kk=ifvpoly(k)
203 area=parea(kk)
204 areapoly=areapoly+area
205 iel=ifvtri(4,kk)
206 IF (iel>0) THEN
207 nx=pnorm(1,kk)
208 ny=pnorm(2,kk)
209 nz=pnorm(3,kk)
210 ELSE
211 IF (ifvtri(5,kk)==i) THEN
212 nx=pnorm(1,kk)
213 ny=pnorm(2,kk)
214 nz=pnorm(3,kk)
215 ELSEIF (ifvtri(6,kk)==i) THEN
216 nx=-pnorm(1,kk)
217 ny=-pnorm(2,kk)
218 nz=-pnorm(3,kk)
219 ENDIF
220 ENDIF
221 n1=ifvtri(1,kk)
222 x1=pnod(1,n1)
223 y1=pnod(2,n1)
224 z1=pnod(3,n1)
225 pvolu(i)=pvolu(i)+third*area*(x1*nx+y1*ny+z1*nz)
226C Compute minimum length DL2
227 n2=ifvtri(2,kk)
228 x2=pnod(1,n2)
229 y2=pnod(2,n2)
230 z2=pnod(3,n2)
231 n3=ifvtri(3,kk)
232 x3=pnod(1,n3)
233 y3=pnod(2,n3)
234 z3=pnod(3,n3)
235 x12=x2-x1
236 y12=y2-y1
237 z12=z2-z1
238 x23=x3-x2
239 y23=y3-y2
240 z23=z3-z2
241 x31=x1-x3
242 y31=y1-y3
243 z31=z1-z3
244 l12=x12**2+y12**2+z12**2
245 l23=x23**2+y23**2+z23**2
246 l31=x31**2+y31**2+z31**2
247 IF(ibpolh(i)==0) THEN
248 dl2=min(dl2,l12,l23,l31)
249 ELSE
250 dll=min(l12,l23,l31)
251 IF(dll < dlbr2) THEN
252 dlbr2=dll
253 idbr2=i
254 ENDIF
255 ENDIF
256 ENDDO
257 areapolymax=max(areapolymax,areapoly)
258 ENDDO
259C Compute minimum length DL1
260 IF(ibpolh(i)==0) THEN
261 dl1=min(dl1,pvolu(i))
262 ELSE
263 nadbr=nadbr+1
264 IF(pvolu(i) < dlbr1) THEN
265 dlbr1=pvolu(i)
266 idbr1=i
267 ENDIF
268 dll=pvolu(i)/areapolymax
269 IF(dll < dlbr3) THEN
270 dlbr3=dll
271 idbr3=i
272 ENDIF
273C
274 IF(pvolu(i)<0)THEN
275 WRITE(iout,'(A,E12.4,3I10)') 'NEGATIVE VOLUME',
276 . pvolu(i),i,ibpolh(i),nadbr
277 ENDIF
278 ENDIF
279 ENDDO ! I=1,NPOLH
280C
281 IF(dl1 > zero) THEN
282 dl1=dl1**third
283 ELSE
284 dl1=zero
285 ENDIF
286 dl2=sqrt(dl2)
287 IF(dlbr1 > zero) THEN
288 dlbr1=dlbr1**third
289 ELSE
290 dlbr1=zero
291 ENDIF
292 dlbr2=sqrt(dlbr2)
293 IF(dl0==zero) dlh=dlbr2
294C---------------------------------------------------
295C Impressions
296C---------------------------------------------------
297 WRITE(iout,1000) ivolu(1),npolh,npolh-nadbr,dl0,dl1,dl2
298 IF(nadbr > 0) THEN
299 WRITE(iout,1001) nadbr,
300 . dlbr1,idbr1,iabs(ibpolh(idbr1)),
301 . dlbr2,idbr2,iabs(ibpolh(idbr2)),
302 . dlbr3,idbr3,iabs(ibpolh(idbr3))
303 ENDIF
304C
3051000 FORMAT(
306 . //' FVMBAG: FINITE VOLUME MINIMUM LENGTH '/
307 . ' -------------------------------------'/
308 . /5x,'VOLUME NUMBER ',i10,
309 . /5x,'TOTAL NUMBER OF FINITE VOLUMES.. . . . . . .=',i10,
310 . /5x,'NUMBER OF POLYHEDRA . . . . .. . . . . . . .=',i10,
311 . /5x,' MINIMUM LENGTH USED FOR TIME STEP. . . .=',1pg20.13,
312 . /5x,' MINIMUM LENGTH BASED ON VOLUME . . . . .=',1pg20.13,
313 . /5x,' MINIMUM LENGTH BASED ON NODAL DISTANCE .=',1pg20.13)
3141001 FORMAT(
315 . 5x,'NUMBER OF ADDITIONAL BRICKS. . . . . . . . .=',i10,
316 . /5x,' MINIMUM LENGTH BASED ON VOLUME . . . . .=',1pg20.13,' (FINITE VOLUME ID ',i10,')',' (BRICK ID ',i10,')',
317 . /5x,' MINIMUM LENGTH BASED ON NODAL DISTANCE .=',1pg20.13,' (FINITE VOLUME ID ',i10,')',' (BRICK ID ',i10,')',
318 . /5x,' MINIMUM LENGTH BASED ON VOLUME/AREA. . .=',1pg20.13,' (FINITE VOLUME ID ',i10,')',' (BRICK ID ',i10,')',/)
319C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0----+----1----+----2----+----3--
320 RETURN
321 END SUBROUTINE fvlength
322 END MODULE fvlength_mod
fvnormal
subroutine fvnormal(x, n1, n2, n3, n4, nx, ny, nz)
Definition fvmbag1.F:576
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
fvlength_mod
Definition fvlength.F:28
fvlength_mod::fvlength
subroutine fvlength(nns, nntr, npolh, ibuf, ibufa, elema, tagela, x, ivolu, ifvnod, rfvnod, ifvtri, ifvpoly, ifvtadr, ifvpolh, ifvpadr, ibpolh, dlh)
Definition fvlength.F:43