OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbodvp.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!|| fxbodvp1 ../engine/source/constraints/fxbody/fxbodvp.F
25!||--- called by ------------------------------------------------------
26!|| fxbyvit ../engine/source/constraints/fxbody/fxbyvit.F
27!||--- calls -----------------------------------------------------
28!|| fxbsys ../engine/source/constraints/fxbody/fxbsys.F
29!|| fxlink ../engine/source/constraints/fxbody/fxbodv.F
30!|| splink ../engine/source/constraints/fxbody/fxbodv.F
31!||====================================================================
32 SUBROUTINE fxbodvp1(FXBRPM, FXBGLM, FXBLM , MVN , MCD ,
33 . SE , SV , FXBVIT, FXBACC, NME ,
34 . NMOD , ISH , DMT , FSAV , FXBFC,
35 . FXBEDP, IBLO )
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
156 END
157!||====================================================================
158!|| fxbodvp2 ../engine/source/constraints/fxbody/fxbodvp.F
159!||--- called by ------------------------------------------------------
160!|| fxbyvit ../engine/source/constraints/fxbody/fxbyvit.F
161!||--- calls -----------------------------------------------------
162!|| fxspin ../engine/source/constraints/fxbody/fxbodv.F
163!||====================================================================
164 SUBROUTINE fxbodvp2(FXBRPM, FXBNOD , FXBMOD , FXBVIT , FXBACC,
165 . NME , NMOD , V , VR , A ,
166 . AR , MS , IN , NSN , IDMAST,
167 . ISH , LMOD , NSNT , IFILE , NSNI ,
168 . IRCM , PMAIN, IAD_ELEM, FR_ELEM)
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
374 END
splink
subroutine splink(mt, st, dt1, fxbrpm, fxbvit, dmt)
Definition fxbodv.F:176
fxspin
subroutine fxspin(fxbrpm, fxbvit, s, r12, dt2)
Definition fxbodv.F:294
fxlink
subroutine fxlink(cr, sr, dt1, dt2, fxbrpm, fxbvit, nme)
Definition fxbodv.F:30
fxbodvp2
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)
Definition fxbodvp.F:169
fxbodvp1
subroutine fxbodvp1(fxbrpm, fxbglm, fxblm, mvn, mcd, se, sv, fxbvit, fxbacc, nme, nmod, ish, dmt, fsav, fxbfc, fxbedp, iblo)
Definition fxbodvp.F:36
fxbsys
subroutine fxbsys(mt, st, n)
Definition fxbsys.F:31