OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbodvp.F File Reference
#include "implicit_f.inc"
#include "com08_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fxbodvp1 (fxbrpm, fxbglm, fxblm, mvn, mcd, se, sv, fxbvit, fxbacc, nme, nmod, ish, dmt, fsav, fxbfc, fxbedp, iblo)
subroutine fxbodvp2 (fxbrpm, fxbnod, fxbmod, fxbvit, fxbacc, nme, nmod, v, vr, a, ar, ms, in, nsn, idmast, ish, lmod, nsnt, ifile, nsni, ircm, pmain, iad_elem, fr_elem)

Function/Subroutine Documentation

◆ fxbodvp1()

subroutine fxbodvp1 ( fxbrpm,
fxbglm,
fxblm,
mvn,
mcd,
se,
sv,
fxbvit,
fxbacc,
integer nme,
integer nmod,
integer ish,
integer dmt,
fsav,
fxbfc,
fxbedp,
integer iblo )

Definition at line 32 of file fxbodvp.F.

36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com08_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NME, NMOD, ISH, DMT, IBLO
48 my_real
49 . fxbrpm(*), fxbglm(*), fxblm(*), mvn(*), mcd(nme,*),
50 . se(*), sv(*), fxbvit(*), fxbacc(*), fsav(*),
51 . fxbfc(*), fxbedp
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I, II, IAD
56 my_real
57 . cr(6,nme), sr(6), mt(dmt,dmt), st(dmt), alpha, fac,
58 . dt05, vitn(nme+nmod), glm(nme,nme), ecin, dwdamp
59C
60 IF (iblo==1) THEN
61 DO i=1,nme
62 fxbacc(i)=zero
63 ENDDO
64 GOTO 100
65 ENDIF
66C-----------------------------------------------
67C RESOLUTION SYSTEME LOCAL
68C-----------------------------------------------
69 CALL fxlink(cr , sr, dt1, dt2, fxbrpm,
70 . fxbvit, nme)
71C
72 DO i=1,nme
73 DO ii=1,nme
74 mt(i,ii)=mcd(i,ii)
75 ENDDO
76 DO ii=1,6
77 mt(nme+ii,i)=-cr(ii,i)
78 mt(i,nme+ii)=-cr(ii,i)
79 ENDDO
80 st(i)=se(i)
81 ENDDO
82 DO i=1,6
83 DO ii=1,6
84 mt(nme+i,nme+ii)=zero
85 ENDDO
86 st(nme+i)=-sr(i)
87 ENDDO
88 IF (ish>0) CALL splink(mt, st, dt1, fxbrpm, fxbvit,
89 . dmt)
90C
91 CALL fxbsys(mt,st,dmt)
92C
93 DO i=1,nme
94 fxbacc(i)=st(i)
95 ENDDO
96C
97 100 CONTINUE
98C
99 alpha=fxbrpm(13)
100 fac=one+half*dt2*alpha
101 IF (nmod>0) THEN
102 DO i=1,nmod
103 fxbacc(nme+i)=sv(i)/fxblm(i)/fac
104 ENDDO
105 IF (iblo==0) THEN
106 DO i=1,nme
107 iad=nmod*(i-1)
108 DO ii=1,nmod
109 fxbacc(nme+ii)=fxbacc(nme+ii)-mvn(iad+ii)*fxbacc(i)
110 ENDDO
111 ENDDO
112 ENDIF
113 ENDIF
114C
115 dt05=half*dt1
116 DO i=1,nme+nmod
117 vitn(i)=fxbvit(i)+dt05*fxbacc(i)
118 fxbvit(i)=fxbvit(i)+dt12*fxbacc(i)
119 ENDDO
120 iad=0
121 DO i=1,nme
122 DO ii=i,nme
123 iad=iad+1
124 glm(i,ii)=fxbglm(iad)
125 IF (i/=ii) glm(ii,i)=glm(i,ii)
126 ENDDO
127 ENDDO
128 ecin=zero
129 DO i=1,nme
130 DO ii=1,nme
131 ecin=ecin+half*vitn(i)*glm(i,ii)*vitn(ii)
132 ENDDO
133 iad=nmod*(i-1)
134 DO ii=1,nmod
135 ecin=ecin+half*vitn(i)
136 . *mvn(iad+ii)*fxblm(ii)*vitn(nme+ii)
137 ENDDO
138 ENDDO
139 dwdamp=zero
140 DO i=1,nmod
141 DO ii=1,nme
142 ecin=ecin+half*vitn(nme+i)
143 . *fxblm(i)*mvn(nmod*(ii-1)+i)*vitn(ii)
144 ENDDO
145 ecin=ecin+half*vitn(nme+i)*fxblm(i)*vitn(nme+i)
146 dwdamp=dwdamp+vitn(nme+i)*
147 . (fxbfc(i)+alpha*fxblm(i)*vitn(nme+i))
148 ENDDO
149 fxbedp=fxbedp+dwdamp*dt12
150 fxbrpm(11)=fxbrpm(11)+fxbedp
151 fxbrpm(12)=ecin
152 fsav(2)=ecin
153 fsav(4)=fxbedp
154C
155 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
splink
subroutine splink(mt, st, dt1, fxbrpm, fxbvit, dmt)
Definition fxbodv.F:176
fxlink
subroutine fxlink(cr, sr, dt1, dt2, fxbrpm, fxbvit, nme)
Definition fxbodv.F:30
fxbsys
subroutine fxbsys(mt, st, n)
Definition fxbsys.F:31

◆ fxbodvp2()

subroutine fxbodvp2 ( fxbrpm,
integer, dimension(*) fxbnod,
fxbmod,
fxbvit,
fxbacc,
integer nme,
integer nmod,
v,
vr,
a,
ar,
ms,
in,
integer nsn,
integer idmast,
integer ish,
integer lmod,
integer nsnt,
integer ifile,
integer nsni,
integer ircm,
integer pmain,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem )

Definition at line 164 of file fxbodvp.F.

169C-----------------------------------------------
170C I m p l i c i t T y p e s
171C-----------------------------------------------
172#include "implicit_f.inc"
173C-----------------------------------------------
174C C o m m o n B l o c k s
175C-----------------------------------------------
176#include "com01_c.inc"
177#include "com04_c.inc"
178#include "com08_c.inc"
179#include "units_c.inc"
180#include "task_c.inc"
181C-----------------------------------------------
182C D u m m y A r g u m e n t s
183C-----------------------------------------------
184 INTEGER FXBNOD(*), NME, NMOD, NSN, IDMAST, ISH, LMOD, NSNT,
185 . IFILE, NSNI, IRCM, PMAIN, IAD_ELEM(2,*), FR_ELEM(*)
186 my_real
187 . fxbrpm(*), fxbmod(*), fxbvit(*), fxbacc(*), v(3,*),
188 . vr(3,*), a(3,*), ar(3,*), ms(*), in(*)
189C-----------------------------------------------
190C L o c a l V a r i a b l e s
191C-----------------------------------------------
192 INTEGER I, IAD, II, N, J, IFAC(NUMNOD), JJ
193 my_real
194 . spin(3), r12(9), vt(3,nsn), vtr(3,nsn), vmod(nsnt*6),
195 . usdt, ecbidt, ecbidr, vv(6), dt05, vx, vy, vz, vrx, vry,
196 . vrz
197C-----------------------------------------------
198C RESTITUTION DES VITESSES SUR LES SECNDS
199C-----------------------------------------------
200 CALL fxspin(fxbrpm, fxbvit, spin, r12, dt2)
201C
202 DO i=1,nsn
203 vt(1,i)=zero
204 vt(2,i)=zero
205 vt(3,i)=zero
206 IF (ish>0) THEN
207 vtr(1,i)=zero
208 vtr(2,i)=zero
209 vtr(3,i)=zero
210 ELSE
211 vtr(1,i)=spin(1)
212 vtr(2,i)=spin(2)
213 vtr(3,i)=spin(3)
214 ENDIF
215 ENDDO
216 DO i=1,12
217 iad=(i-1)*lmod
218 DO ii=1,lmod
219 vmod(ii)=fxbmod(iad+ii)
220 ENDDO
221 IF (ifile==1.AND.nsn>nsni) THEN
222 iad=nsni*6
223 DO ii=1,nsn-nsni
224 ircm=ircm+1
225 READ(ifxm,rec=ircm) (vv(j),j=1,6)
226 DO j=1,6
227 vmod(iad+j)=vv(j)
228 ENDDO
229 iad=iad+6
230 ENDDO
231 ENDIF
232 iad=0
233 DO ii=1,nsn
234 vt(1,ii)=vt(1,ii)+fxbvit(i)*vmod(iad+1)
235 vt(2,ii)=vt(2,ii)+fxbvit(i)*vmod(iad+2)
236 vt(3,ii)=vt(3,ii)+fxbvit(i)*vmod(iad+3)
237 iad=iad+6
238 ENDDO
239 ENDDO
240 IF (ish>0) THEN
241 DO i=13,nme
242 iad=(i-1)*lmod
243 DO ii=1,lmod
244 vmod(ii)=fxbmod(iad+ii)
245 ENDDO
246 IF (ifile==1.AND.nsn>nsni) THEN
247 iad=nsni*6
248 DO ii=1,nsn-nsni
249 ircm=ircm+1
250 READ(ifxm,rec=ircm) (vv(j),j=1,6)
251 DO j=1,6
252 vmod(iad+j)=vv(j)
253 ENDDO
254 iad=iad+6
255 ENDDO
256 ENDIF
257 iad=0
258 DO ii=1,nsn
259 vtr(1,ii)=vtr(1,ii)+fxbvit(i)*vmod(iad+4)
260 vtr(2,ii)=vtr(2,ii)+fxbvit(i)*vmod(iad+5)
261 vtr(3,ii)=vtr(3,ii)+fxbvit(i)*vmod(iad+6)
262 iad=iad+6
263 ENDDO
264 ENDDO
265 ENDIF
266C
267 IF (nmod>0) THEN
268 DO i=1,nmod
269 iad=(nme+i-1)*lmod
270 DO ii=1,lmod
271 vmod(ii)=fxbmod(iad+ii)
272 ENDDO
273 IF (ifile==1.AND.nsn>nsni) THEN
274 iad=nsni*6
275 DO ii=1,nsn-nsni
276 ircm=ircm+1
277 READ(ifxm,rec=ircm) (vv(j),j=1,6)
278 DO j=1,6
279 vmod(iad+j)=vv(j)
280 ENDDO
281 iad=iad+6
282 ENDDO
283 ENDIF
284 iad=0
285 DO ii=1,nsn
286 vt(1,ii)=vt(1,ii)+fxbvit(nme+i)*
287 . (r12(1)*vmod(iad+1)+r12(2)*vmod(iad+2)+
288 . r12(3)*vmod(iad+3))
289 vt(2,ii)=vt(2,ii)+fxbvit(nme+i)*
290 . (r12(4)*vmod(iad+1)+r12(5)*vmod(iad+2)+
291 . r12(6)*vmod(iad+3))
292 vt(3,ii)=vt(3,ii)+fxbvit(nme+i)*
293 . (r12(7)*vmod(iad+1)+r12(8)*vmod(iad+2)+
294 . r12(9)*vmod(iad+3))
295 vtr(1,ii)=vtr(1,ii)+fxbvit(nme+i)*
296 . (r12(1)*vmod(iad+4)+r12(2)*vmod(iad+5)+
297 . r12(3)*vmod(iad+6))
298 vtr(2,ii)=vtr(2,ii)+fxbvit(nme+i)*
299 . (r12(4)*vmod(iad+4)+r12(5)*vmod(iad+5)+
300 . r12(6)*vmod(iad+6))
301 vtr(3,ii)=vtr(3,ii)+fxbvit(nme+i)*
302 . (r12(7)*vmod(iad+4)+r12(8)*vmod(iad+5)+
303 . r12(9)*vmod(iad+6))
304 iad=iad+6
305 ENDDO
306 ENDDO
307 ENDIF
308 usdt=one/dt12
309 ecbidt=zero
310 ecbidr=zero
311 dt05 = half*dt2
312C
313 DO i=1,numnod
314 ifac(i)=1
315 ENDDO
316 IF (nspmd>1) THEN
317 DO i=1,nspmd
318 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
319 jj=fr_elem(j)
320 ifac(jj)=ifac(jj)+1
321 ENDDO
322 ENDDO
323 ENDIF
324C
325 DO i=1,nsn
326 n=fxbnod(i)
327 a(1,n)=(vt(1,i)-v(1,n))*usdt
328 a(2,n)=(vt(2,i)-v(2,n))*usdt
329 a(3,n)=(vt(3,i)-v(3,n))*usdt
330 ar(1,n)=(vtr(1,i)-vr(1,n))*usdt
331 ar(2,n)=(vtr(2,i)-vr(2,n))*usdt
332 ar(3,n)=(vtr(3,i)-vr(3,n))*usdt
333 vx=v(1,n)+dt05*a(1,n)
334 vy=v(2,n)+dt05*a(2,n)
335 vz=v(3,n)+dt05*a(3,n)
336 vrx=vr(1,n)+dt05*ar(1,n)
337 vry=vr(2,n)+dt05*ar(2,n)
338 vrz=vr(3,n)+dt05*ar(3,n)
339 ecbidt=ecbidt+half*ms(n)*(vx*vx+vy*vy+vz*vz)/ifac(n)
340 ecbidr=ecbidr+half*in(n)*(vrx*vrx+vry*vry+vrz*vrz)/ifac(n)
341 ENDDO
342 DO i=nsn+1,nsnt
343 n=fxbnod(i)
344 a(1,n)=zero
345 a(2,n)=zero
346 a(3,n)=zero
347 ar(1,n)=zero
348 ar(2,n)=zero
349 ar(3,n)=zero
350 vx=v(1,n)
351 vy=v(2,n)
352 vz=v(3,n)
353 vrx=vr(1,n)
354 vry=vr(2,n)
355 vrz=vr(3,n)
356 ecbidt=ecbidt+half*ms(n)*(vx*vx+vy*vy+vz*vz)/ifac(n)
357 ecbidr=ecbidr+half*in(n)*(vrx*vrx+vry*vry+vrz*vrz)/ifac(n)
358 ENDDO
359 IF (pmain/=ispmd) fxbrpm(12)=zero
360 fxbrpm(12)=fxbrpm(12)-ecbidt-ecbidr
361C-----------------------------------------------
362C RESTITUTION SUR LE MAIN
363C-----------------------------------------------
364 IF (idmast/=0) THEN
365 a(1,idmast)=fxbacc(10)
366 a(2,idmast)=fxbacc(11)
367 a(3,idmast)=fxbacc(12)
368 ar(1,idmast)=(spin(1)-vr(1,idmast))*usdt
369 ar(2,idmast)=(spin(2)-vr(2,idmast))*usdt
370 ar(3,idmast)=(spin(3)-vr(3,idmast))*usdt
371 ENDIF
372C
373 RETURN
fxspin
subroutine fxspin(fxbrpm, fxbvit, s, r12, dt2)
Definition fxbodv.F:294