OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
befil2.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine befil2 (v, fill, dfill, ims, x, dalph1, dalph2, nc1, nc2, nc3, nc4)

Function/Subroutine Documentation

◆ befil2()

subroutine befil2 ( v,
fill,
dfill,
integer, dimension(numnod,*) ims,
x,
dalph1,
dalph2,
integer, dimension(mvsiz) nc1,
integer, dimension(mvsiz) nc2,
integer, dimension(mvsiz) nc3,
integer, dimension(mvsiz) nc4 )

Definition at line 31 of file befil2.F.

34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C G l o b a l P a r a m e t e r s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "vect01_c.inc"
46#include "com04_c.inc"
47#include "com08_c.inc"
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IMS(NUMNOD,*)
53 my_real
54 . v(3,*), fill(numnod,*), dfill(numnod,*),
55 . x(3,*),
56 . dalph1(*), dalph2(*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ), I, N1, N2, N3, N4,
61 . NP
62 my_real
63! . GAMMA(MVSIZ), XMS(MVSIZ),
64 . fi1(mvsiz), fi2(mvsiz), fi3(mvsiz), fi4(mvsiz),
65 . fa(mvsiz), vdy1(mvsiz), vdy2(mvsiz), vdy3(mvsiz), vdy4(mvsiz),
66 . vdz1(mvsiz), vdz2(mvsiz), vdz3(mvsiz), vdz4(mvsiz), vdy(mvsiz), vdz(mvsiz),
67 . abf, dn, p1, p2, p3, p4, pt, psy, psz, pty,
68 . ptz, ps, pst, pts, ds0, dt0, ds, dt,
69 . df1(mvsiz), df2(mvsiz), df3(mvsiz), df4(mvsiz)
70C-----------------------------------------------
71 DO i=lft,llt
72 fi1(i)=fill(nc1(i),1)
73 fi2(i)=fill(nc2(i),1)
74 fi3(i)=fill(nc3(i),1)
75 fi4(i)=fill(nc4(i),1)
76 abf=abs(fi1(i))+abs(fi2(i))+abs(fi3(i))+abs(fi4(i))
77 n1=nint(sign(one,fi1(i)))
78 n2=nint(sign(one,fi2(i)))
79 n3=nint(sign(one,fi3(i)))
80 n4=nint(sign(one,fi4(i)))
81 np=max(0,n1)+max(0,n2)+max(0,n3)+max(0,n4)
82 dn=dt1*np
83 IF(dn/=zero)THEN
84 fa(i)=-dalph1(i)*abf/dn
85 ELSE
86 fa(i)=zero
87 ENDIF
88 ENDDO
89C-----------------------------------------------
90C CALCUL PAR NOEUD DE V MATIERE - V MAILLAGE
91C-----------------------------------------------
92 DO i=lft,llt
93 vdy1(i)=v(2,nc1(i))
94 vdz1(i)=v(3,nc1(i))
95
96 vdy2(i)=v(2,nc2(i))
97 vdz2(i)=v(3,nc2(i))
98
99 vdy3(i)=v(2,nc3(i))
100 vdz3(i)=v(3,nc3(i))
101
102 vdy4(i)=v(2,nc4(i))
103 vdz4(i)=v(3,nc4(i))
104 ENDDO
105C-----------------------------------------------
106C CALCUL DE (V MATIERE - V MAILLAGE) MOYEN
107C-----------------------------------------------
108 DO i=lft,llt
109 p1=fi1(i)+one
110 p2=fi2(i)+one
111 p3=fi3(i)+one
112 p4=fi4(i)+one
113 pt=(p1+p2+p3+p4)
114 pt= max(em15,pt)
115 vdy(i)=(vdy1(i)*p1+vdy2(i)*p2+vdy3(i)*p3+vdy4(i)*p4)/pt
116 vdz(i)=(vdz1(i)*p1+vdz2(i)*p2+vdz3(i)*p3+vdz4(i)*p4)/pt
117 ENDDO
118
119 DO i=lft,llt
120 psy=-x(2,nc1(i))+x(2,nc2(i))+x(2,nc3(i))-x(2,nc4(i))
121 psz=-x(3,nc1(i))+x(3,nc2(i))+x(3,nc3(i))-x(3,nc4(i))
122 pty=-x(2,nc1(i))-x(2,nc2(i))+x(2,nc3(i))+x(2,nc4(i))
123 ptz=-x(3,nc1(i))-x(3,nc2(i))+x(3,nc3(i))+x(3,nc4(i))
124 ps=sqrt(psy**2+psz**2)
125 pt=sqrt(pty**2+ptz**2)
126 pst=psy*ptz-psz*pty
127 pts=-pst
128 ds0=-four*(pty*vdz(i)-ptz*vdy(i))/pts
129 dt0=-four*(psy*vdz(i)-psz*vdy(i))/pst
130 IF(fi1(i)>=zero)THEN
131 ds=-four*(pty*vdz1(i)-ptz*vdy1(i))/pts
132 dt=-four*(psy*vdz1(i)-psz*vdy1(i))/pst
133 ELSE
134 ds=ds0
135 dt=dt0
136 ENDIF
137 ds= max(zero,two*ds)
138 dt= max(zero,two*dt)
139C
140 df1(i)=fourth*((-two*ds-two*dt+ds*dt*dt1)*fi1(i)
141 . +( two*ds -ds*dt*dt1)*fi2(i)
142 . +( ds*dt*dt1)*fi3(i)
143 . +( two*dt-ds*dt*dt1)*fi4(i) )
144 IF(fi2(i)>=zero)THEN
145 ds=-four*(pty*vdz2(i)-ptz*vdy2(i))/pts
146 dt=-four*(psy*vdz2(i)-psz*vdy2(i))/pst
147 ELSE
148 ds=ds0
149 dt=dt0
150 ENDIF
151 ds= min(zero,two*ds)
152 dt= max(zero,two*dt)
153 df2(i)=fourth*((-two*ds +ds*dt*dt1)*fi1(i)
154 . +( two*ds-two*dt-ds*dt*dt1)*fi2(i)
155 . +( +two*dt+ds*dt*dt1)*fi3(i)
156 . +( -ds*dt*dt1)*fi4(i) )
157 IF(fi3(i)>=zero)THEN
158 ds=-four*(pty*vdz3(i)-ptz*vdy3(i))/pts
159 dt=-four*(psy*vdz3(i)-psz*vdy3(i))/pst
160 ELSE
161 ds=ds0
162 dt=dt0
163 ENDIF
164 ds= min(zero,two*ds)
165 dt= min(zero,two*dt)
166 df3(i)=fourth*(( +ds*dt*dt1)*fi1(i)
167 . +( -two*dt-ds*dt*dt1)*fi2(i)
168 . +(+two*ds+two*dt+ds*dt*dt1)*fi3(i)
169 . +(-two*ds -ds*dt*dt1)*fi4(i) )
170 IF(fi4(i)>=zero)THEN
171 ds=-four*(pty*vdz4(i)-ptz*vdy4(i))/pts
172 dt=-four*(psy*vdz4(i)-psz*vdy4(i))/pst
173 ELSE
174 ds=ds0
175 dt=dt0
176 ENDIF
177 ds= max(zero,two*ds)
178 dt= min(zero,two*dt)
179 df4(i)=fourth*(( -two*dt+ds*dt*dt1)*fi1(i)
180 . +( -ds*dt*dt1)*fi2(i)
181 . +(+two*ds +ds*dt*dt1)*fi3(i)
182 . +(-two*ds+two*dt-ds*dt*dt1)*fi4(i) )
183 ENDDO !next I
184
185 CALL idp_lock(2)
186
187 DO i=lft,llt
188 dfill(nc1(i),1)=dfill(nc1(i),1)+df1(i)-fa(i)
189 dfill(nc2(i),1)=dfill(nc2(i),1)+df2(i)-fa(i)
190 dfill(nc3(i),1)=dfill(nc3(i),1)+df3(i)-fa(i)
191 dfill(nc4(i),1)=dfill(nc4(i),1)+df4(i)-fa(i)
192 ims(nc1(i),1)=ims(nc1(i),1)+1
193 ims(nc2(i),1)=ims(nc2(i),1)+1
194 ims(nc3(i),1)=ims(nc3(i),1)+1
195 ims(nc4(i),1)=ims(nc4(i),1)+1
196 ENDDO
197
198 CALL idp_free(2)
199
200C-------------------------------
201 IF(jmult>1)THEN
202
203 DO i=lft,llt
204 fi1(i)=fill(nc1(i),2)
205 fi2(i)=fill(nc2(i),2)
206 fi3(i)=fill(nc3(i),2)
207 fi4(i)=fill(nc4(i),2)
208 abf=abs(fi1(i))+abs(fi2(i))+abs(fi3(i))+abs(fi4(i))
209 n1=nint(sign(one,fi1(i)))
210 n2=nint(sign(one,fi2(i)))
211 n3=nint(sign(one,fi3(i)))
212 n4=nint(sign(one,fi4(i)))
213 np=max(0,n1)+max(0,n2)+max(0,n3)+max(0,n4)
214 dn=dt1*np
215 IF(dn/=zero)THEN
216 fa(i)=-dalph2(i)*abf/dn
217 ELSE
218 fa(i)=zero
219 ENDIF
220 ENDDO
221C-----------------------------------------------
222C CALCUL DE (V MATIERE - V MAILLAGE) MOYEN
223C-----------------------------------------------
224 DO i=lft,llt
225 p1=fi1(i)+one
226 p2=fi2(i)+one
227 p3=fi3(i)+one
228 p4=fi4(i)+one
229 pt=(p1+p2+p3+p4)
230 pt= max(em15,pt)
231 vdy(i)=(vdy1(i)*p1+vdy2(i)*p2+vdy3(i)*p3+vdy4(i)*p4)/pt
232 vdz(i)=(vdz1(i)*p1+vdz2(i)*p2+vdz3(i)*p3+vdz4(i)*p4)/pt
233 ENDDO
234C
235 DO i=lft,llt
236 psy=-x(2,nc1(i))+x(2,nc2(i))+x(2,nc3(i))-x(2,nc4(i))
237 psz=-x(3,nc1(i))+x(3,nc2(i))+x(3,nc3(i))-x(3,nc4(i))
238 pty=-x(2,nc1(i))-x(2,nc2(i))+x(2,nc3(i))+x(2,nc4(i))
239 ptz=-x(3,nc1(i))-x(3,nc2(i))+x(3,nc3(i))+x(3,nc4(i))
240 ps=sqrt(psy**2+psz**2)
241 pt=sqrt(pty**2+ptz**2)
242 pst=psy*ptz-psz*pty
243 pts=-pst
244 ds0=-four*(pty*vdz(i)-ptz*vdy(i))/pts
245 dt0=-four*(psy*vdz(i)-psz*vdy(i))/pst
246 IF(fi1(i)>=zero)THEN
247 ds=-four*(pty*vdz1(i)-ptz*vdy1(i))/pts
248 dt=-four*(psy*vdz1(i)-psz*vdy1(i))/pst
249 ELSE
250 ds=ds0
251 dt=dt0
252 ENDIF
253 ds= max(zero,two*ds)
254 dt= max(zero,two*dt)
255C
256 df1(i)=fourth*((-two*ds-two*dt+ds*dt*dt1)*fi1(i)
257 . + ( two*ds -ds*dt*dt1)*fi2(i)
258 . + ( ds*dt*dt1)*fi3(i)
259 . + ( two*dt-ds*dt*dt1)*fi4(i) )
260 IF(fi2(i)>=zero)THEN
261 ds=-four*(pty*vdz2(i)-ptz*vdy2(i))/pts
262 dt=-four*(psy*vdz2(i)-psz*vdy2(i))/pst
263 ELSE
264 ds=ds0
265 dt=dt0
266 ENDIF
267 ds= min(zero,two*ds)
268 dt= max(zero,two*dt)
269 df2(i)=four*((-two*ds +ds*dt*dt1)*fi1(i)
270 . +( two*ds-two*dt-ds*dt*dt1)*fi2(i)
271 . +( +two*dt+ds*dt*dt1)*fi3(i)
272 . +( -ds*dt*dt1)*fi4(i) )
273 IF(fi3(i)>=zero)THEN
274 ds=-four*(pty*vdz3(i)-ptz*vdy3(i))/pts
275 dt=-four*(psy*vdz3(i)-psz*vdy3(i))/pst
276 ELSE
277 ds=ds0
278 dt=dt0
279 ENDIF
280 ds= min(zero,two*ds)
281 dt= min(zero,two*dt)
282 df3(i)=fourth*(( +ds*dt*dt1)*fi1(i)
283 . +( -two*dt-ds*dt*dt1)*fi2(i)
284 . +(+two*ds+two*dt+ds*dt*dt1)*fi3(i)
285 . +(-two*ds -ds*dt*dt1)*fi4(i) )
286 IF(fi4(i)>=zero)THEN
287 ds=-four*(pty*vdz4(i)-ptz*vdy4(i))/pts
288 dt=-four*(psy*vdz4(i)-psz*vdy4(i))/pst
289 ELSE
290 ds=ds0
291 dt=dt0
292 ENDIF
293 ds= max(zero,two*ds)
294 dt= min(zero,two*dt)
295 df4(i)=fourth*(( -two*dt+ds*dt*dt1)*fi1(i)
296 . +( -ds*dt*dt1)*fi2(i)
297 . +(+two*ds +ds*dt*dt1)*fi3(i)
298 . +(-two*ds+two*dt-ds*dt*dt1)*fi4(i) )
299 ENDDO !next I
300
301C
302 CALL idp_lock(2)
303
304 DO i=lft,llt
305 dfill(nc1(i),2)=dfill(nc1(i),2)+df1(i)-fa(i)
306 dfill(nc2(i),2)=dfill(nc2(i),2)+df2(i)-fa(i)
307 dfill(nc3(i),2)=dfill(nc3(i),2)+df3(i)-fa(i)
308 dfill(nc4(i),2)=dfill(nc4(i),2)+df4(i)-fa(i)
309 ims(nc1(i),2)=ims(nc1(i),2)+1
310 ims(nc2(i),2)=ims(nc2(i),2)+1
311 ims(nc3(i),2)=ims(nc3(i),2)+1
312 ims(nc4(i),2)=ims(nc4(i),2)+1
313 ENDDO
314
315 CALL idp_free(2)
316
317 ENDIF !(JMULT>1)
318C-------------------------------
319C
320 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
idp_lock
subroutine idp_lock(id)
Definition machine.F:269
idp_free
subroutine idp_free(id)
Definition machine.F:299
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21