OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvbric.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!|| fvbric ../starter/source/airbag/fvbric.F
25!||--- called by ------------------------------------------------------
26!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
27!||--- uses -----------------------------------------------------
28!|| fvbag_mod ../starter/share/modules1/fvbag_mod.F
29!||====================================================================
30 SUBROUTINE fvbric(IVOLU, RVOLU, IBUF, X, NN)
31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE fvbag_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER IVOLU(*), IBUF(*), NN
43 my_real
44 . rvolu(*), x(3,*)
45C-----------------------------------------------
46C L o c a l V a r i a b l e s
47C-----------------------------------------------
48 INTEGER I, II, NBX, NBY, NBRIC, NNB, IFV, NNB1, J, K, NV, NALL,
49 . NC, TNC(4), TNV(5,6), KK, L, N1, N2, N3, N4, N5, N6, N7,
50 . N8
51 my_real
52 . vx3, vy3, vz3, vx1, vy1, vz1, norm, ss, vx2, vy2, vz2,
53 . x0, y0, z0, zlmin, zlmax, xx, yy, zz, zl, lx, ly, dx, dy,
54 . xlc, ylc, zlc1, zlc2, xxg, yyg, zzg, xc, yc, zc, l1, l2,
55 . l3, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4,
56 . nx1, ny1, nz1, nx2, ny2, nz2, area1, area2, nx, ny, nz,
57 . rr, xcf, ycf, zcf, vx, vy, vz
58 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
59C
60 INTEGER FAC(4,6)
61 DATA fac /1,4,3,2,
62 . 5,6,7,8,
63 . 1,2,6,5,
64 . 2,3,7,6,
65 . 3,4,8,7,
66 . 4,1,5,8/
67C
68 vx3=rvolu(35)
69 vy3=rvolu(36)
70 vz3=rvolu(37)
71 vx1=rvolu(38)
72 vy1=rvolu(39)
73 vz1=rvolu(40)
74C Repere local
75 norm=sqrt(vx3**2+vy3**2+vz3**2)
76 vx3=vx3/norm
77 vy3=vy3/norm
78 vz3=vz3/norm
79 ss=vx3*vx1+vy3*vy1+vz3*vz1
80 vx1=vx1-ss*vx3
81 vy1=vy1-ss*vy3
82 vz1=vz1-ss*vz3
83 norm=sqrt(vx1**2+vy1**2+vz1**2)
84 vx1=vx1/norm
85 vy1=vy1/norm
86 vz1=vz1/norm
87 vx2=vy3*vz1-vz3*vy1
88 vy2=vz3*vx1-vx3*vz1
89 vz2=vx3*vy1-vy3*vx1
90C
91 x0=rvolu(41)
92 y0=rvolu(42)
93 z0=rvolu(43)
94C
95 zlmin=ep30
96 zlmax=-ep30
97 DO i=1,nn
98 ii=ibuf(i)
99 xx=x(1,ii)
100 yy=x(2,ii)
101 zz=x(3,ii)
102 zl=(xx-x0)*vx3+(yy-y0)*vy3+(zz-z0)*vz3
103 zlmin=min(zlmin,zl)
104 zlmax=max(zlmax,zl)
105 ENDDO
106C
107 ifv=ivolu(45)
108 nbx=ivolu(54)
109 nby=ivolu(55)
110C
111 lx=rvolu(44)
112 ly=rvolu(45)
113 dx=two*lx/nbx
114 dy=two*ly/nby
115 zlc1=zlmin-max(lx,ly)
116 zlc2=zlmax+max(lx,ly)
117 nnb=0
118 nnb1=(nbx+1)*(nby+1)
119 DO i=1,nby+1
120 ylc=-ly+(i-1)*dy
121 DO j=1,nbx+1
122 xlc=-lx+(j-1)*dx
123 nnb=nnb+1
124 fvdata(ifv)%XB(1,nnb)=xlc
125 fvdata(ifv)%XB(2,nnb)=ylc
126 fvdata(ifv)%XB(3,nnb)=zlc1
127 fvdata(ifv)%XB(1,nnb1+nnb)=xlc
128 fvdata(ifv)%XB(2,nnb1+nnb)=ylc
129 fvdata(ifv)%XB(3,nnb1+nnb)=zlc2
130 ENDDO
131 ENDDO
132C
133 nnb=(nbx+1)*(nby+1)*2
134 DO i=1,nnb
135 xx=fvdata(ifv)%XB(1,i)
136 yy=fvdata(ifv)%XB(2,i)
137 zz=fvdata(ifv)%XB(3,i)
138 xxg=x0+xx*vx1+yy*vx2+zz*vx3
139 yyg=y0+xx*vy1+yy*vy2+zz*vy3
140 zzg=z0+xx*vz1+yy*vz2+zz*vz3
141 fvdata(ifv)%XB(1,i)=xxg
142 fvdata(ifv)%XB(2,i)=yyg
143 fvdata(ifv)%XB(3,i)=zzg
144 ENDDO
145C
146 nbric=0
147 DO i=1,nby
148 DO j=1,nbx
149 nbric=nbric+1
150 fvdata(ifv)%BRIC(1,nbric)=(i-1)*(nbx+1)+j
151 fvdata(ifv)%BRIC(2,nbric)=(i-1)*(nbx+1)+j+1
152 fvdata(ifv)%BRIC(3,nbric)=i*(nbx+1)+j+1
153 fvdata(ifv)%BRIC(4,nbric)=i*(nbx+1)+j
154 fvdata(ifv)%BRIC(5,nbric)=nnb1+(i-1)*(nbx+1)+j
155 fvdata(ifv)%BRIC(6,nbric)=nnb1+(i-1)*(nbx+1)+j+1
156 fvdata(ifv)%BRIC(7,nbric)=nnb1+i*(nbx+1)+j+1
157 fvdata(ifv)%BRIC(8,nbric)=nnb1+i*(nbx+1)+j
158 ENDDO
159 ENDDO
160C
161 DO i=1,nbric
162 DO j=1,6
163 fvdata(ifv)%TBRIC(j,i)=0
164 DO k=1,4
165 fvdata(ifv)%SFAC(j,k,i)=zero
166 ENDDO
167 ENDDO
168 DO j=1,7
169 fvdata(ifv)%TBRIC(6+j,i)=0
170 ENDDO
171 ENDDO
172C
173 ALLOCATE(itag(nnb))
174 DO i=1,nnb
175 itag(i)=0
176 ENDDO
177C
178 DO i=1,nbric
179 DO j=1,8
180 itag(fvdata(ifv)%BRIC(j,i))=1
181 ENDDO
182 nv=0
183 DO j=1,nbric
184 IF (j==i) cycle
185 nall=0
186 nc=0
187 DO k=1,8
188 IF (itag(fvdata(ifv)%BRIC(k,j))==1) THEN
189 nc=nc+1
190 tnc(nc)=fvdata(ifv)%BRIC(k,j)
191 ENDIF
192 nall=nall+itag(fvdata(ifv)%BRIC(k,j))
193 ENDDO
194 IF (nall/=4) cycle
195 nv=nv+1
196 tnv(1,nv)=j
197 tnv(2,nv)=tnc(1)
198 tnv(3,nv)=tnc(2)
199 tnv(4,nv)=tnc(3)
200 tnv(5,nv)=tnc(4)
201 ENDDO
202 DO j=1,8
203 itag(fvdata(ifv)%BRIC(j,i))=0
204 ENDDO
205 DO j=1,6
206 DO k=1,4
207 kk=fac(k,j)
208 itag(fvdata(ifv)%BRIC(kk,i))=1
209 ENDDO
210 DO k=1,nv
211 nall=1
212 DO l=1,4
213 nall=nall*itag(tnv(1+l,k))
214 ENDDO
215 IF (nall==1) fvdata(ifv)%TBRIC(j,i)=tnv(1,k)
216 ENDDO
217 DO k=1,4
218 kk=fac(k,j)
219 itag(fvdata(ifv)%BRIC(kk,i))=0
220 ENDDO
221 ENDDO
222 ENDDO
223 DEALLOCATE(itag)
224C
225 DO i=1,nbric
226 n1=fvdata(ifv)%BRIC(1,i)
227 n2=fvdata(ifv)%BRIC(2,i)
228 n3=fvdata(ifv)%BRIC(3,i)
229 n4=fvdata(ifv)%BRIC(4,i)
230 n5=fvdata(ifv)%BRIC(5,i)
231 n6=fvdata(ifv)%BRIC(6,i)
232 n7=fvdata(ifv)%BRIC(7,i)
233 n8=fvdata(ifv)%BRIC(8,i)
234 xc=one_over_8*(fvdata(ifv)%XB(1,n1)+fvdata(ifv)%XB(1,n2)+
235 . fvdata(ifv)%XB(1,n3)+fvdata(ifv)%XB(1,n4)+
236 . fvdata(ifv)%XB(1,n5)+fvdata(ifv)%XB(1,n6)+
237 . fvdata(ifv)%XB(1,n7)+fvdata(ifv)%XB(1,n8))
238 yc=one_over_8*(fvdata(ifv)%XB(2,n1)+fvdata(ifv)%XB(2,n2)+
239 . fvdata(ifv)%XB(2,n3)+fvdata(ifv)%XB(2,n4)+
240 . fvdata(ifv)%XB(2,n5)+fvdata(ifv)%XB(2,n6)+
241 . fvdata(ifv)%XB(2,n7)+fvdata(ifv)%XB(2,n8))
242 zc=one_over_8*(fvdata(ifv)%XB(3,n1)+fvdata(ifv)%XB(3,n2)+
243 . fvdata(ifv)%XB(3,n3)+fvdata(ifv)%XB(3,n4)+
244 . fvdata(ifv)%XB(3,n5)+fvdata(ifv)%XB(3,n6)+
245 . fvdata(ifv)%XB(3,n7)+fvdata(ifv)%XB(3,n8))
246C
247 IF (i==1) THEN
248 vx1=fvdata(ifv)%XB(1,n2)-fvdata(ifv)%XB(1,n1)
249 vy1=fvdata(ifv)%XB(2,n2)-fvdata(ifv)%XB(2,n1)
250 vz1=fvdata(ifv)%XB(3,n2)-fvdata(ifv)%XB(3,n1)
251 vx2=fvdata(ifv)%XB(1,n4)-fvdata(ifv)%XB(1,n1)
252 vy2=fvdata(ifv)%XB(2,n4)-fvdata(ifv)%XB(2,n1)
253 vz2=fvdata(ifv)%XB(3,n4)-fvdata(ifv)%XB(3,n1)
254 vx3=fvdata(ifv)%XB(1,n5)-fvdata(ifv)%XB(1,n1)
255 vy3=fvdata(ifv)%XB(2,n5)-fvdata(ifv)%XB(2,n1)
256 vz3=fvdata(ifv)%XB(3,n5)-fvdata(ifv)%XB(3,n1)
257 l1=sqrt(vx1**2+vy1**2+vz1**2)
258 l2=sqrt(vx2**2+vy2**2+vz2**2)
259 l3=sqrt(vx3**2+vy3**2+vz3**2)
260 fvdata(ifv)%DLH=min(l1,l2,l3)
261 ENDIF
262C
263 DO j=1,6
264 n1=fvdata(ifv)%BRIC(fac(1,j),i)
265 n2=fvdata(ifv)%BRIC(fac(2,j),i)
266 n3=fvdata(ifv)%BRIC(fac(3,j),i)
267 n4=fvdata(ifv)%BRIC(fac(4,j),i)
268 x1=fvdata(ifv)%XB(1,n1)
269 y1=fvdata(ifv)%XB(2,n1)
270 z1=fvdata(ifv)%XB(3,n1)
271 x2=fvdata(ifv)%XB(1,n2)
272 y2=fvdata(ifv)%XB(2,n2)
273 z2=fvdata(ifv)%XB(3,n2)
274 x3=fvdata(ifv)%XB(1,n3)
275 y3=fvdata(ifv)%XB(2,n3)
276 z3=fvdata(ifv)%XB(3,n3)
277 x4=fvdata(ifv)%XB(1,n4)
278 y4=fvdata(ifv)%XB(2,n4)
279 z4=fvdata(ifv)%XB(3,n4)
280C
281 vx1=x2-x1
282 vy1=y2-y1
283 vz1=z2-z1
284 vx2=x3-x1
285 vy2=y3-y1
286 vz2=z3-z1
287 vx3=x4-x1
288 vy3=y4-y1
289 vz3=z4-z1
290 nx1=vy1*vz2-vz1*vy2
291 ny1=vz1*vx2-vx1*vz2
292 nz1=vx1*vy2-vy1*vx2
293 nx2=vy2*vz3-vz2*vy3
294 ny2=vz2*vx3-vx2*vz3
295 nz2=vx2*vy3-vy2*vx3
296 area1=half*sqrt(nx1**2+ny1**2+nz1**2)
297 area2=half*sqrt(nx2**2+ny2**2+nz2**2)
298 fvdata(ifv)%SFAC(j,1,i)=area1+area2
299C
300 nx=half*(nx1+nx2)
301 ny=half*(ny1+ny2)
302 nz=half*(nz1+nz2)
303 rr=sqrt(nx**2+ny**2+nz**2)
304 xcf=fourth*(x1+x2+x3+x4)
305 ycf=fourth*(y1+y2+y3+y4)
306 zcf=fourth*(z1+z2+z3+z4)
307 vx=xc-xcf
308 vy=yc-ycf
309 vz=zc-zcf
310 ss=vx*nx+vy*ny+vz*nz
311 IF(rr == zero) cycle
312 IF (ss<=zero) THEN
313 fvdata(ifv)%SFAC(j,2,i)=nx/rr
314 fvdata(ifv)%SFAC(j,3,i)=ny/rr
315 fvdata(ifv)%SFAC(j,4,i)=nz/rr
316 ELSE
317 fvdata(ifv)%SFAC(j,2,i)=-nx/rr
318 fvdata(ifv)%SFAC(j,3,i)=-ny/rr
319 fvdata(ifv)%SFAC(j,4,i)=-nz/rr
320 ENDIF
321 ENDDO
322 ENDDO
323C
324 RETURN
325 END
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
min
#define min(a, b)
Definition macros.h:20
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
fvbric
subroutine fvbric(ivolu, rvolu, ibuf, x, nn)
Definition fvbric.F:31