OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvbric.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fvbric (ivolu, rvolu, ibuf, x, nn)

Function/Subroutine Documentation

◆ fvbric()

subroutine fvbric ( integer, dimension(*) ivolu,
rvolu,
integer, dimension(*) ibuf,
x,
integer nn )

Definition at line 32 of file fvbric.F.

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