OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgbodv.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rgbodv (v, vr, x, rby, nod, nby, skew, iskew, fs, itab, weight, a, ar, ms, in, isens, id, ifail, fny, expn, fty, expt, crit, nodreac, fthreac, freac)

Function/Subroutine Documentation

◆ rgbodv()

subroutine rgbodv ( v,
vr,
x,
rby,
integer, dimension(*) nod,
integer, dimension(*) nby,
skew,
integer, dimension(*) iskew,
fs,
integer, dimension(*) itab,
integer, dimension(*) weight,
a,
ar,
ms,
in,
integer isens,
integer id,
integer, intent(in) ifail,
intent(in) fny,
intent(in) expn,
intent(in) fty,
intent(in) expt,
intent(inout) crit,
integer, dimension(*) nodreac,
dimension(6,*), intent(inout) fthreac,
freac )

Definition at line 35 of file rgbodv.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45 USE velrot_explicit_mod, ONLY : velrot_explicit
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50#include "comlock.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NOD(*), NBY(*), ISKEW(*),ITAB(*), WEIGHT(*),ID, NODREAC(*)
55 INTEGER, INTENT(IN) :: IFAIL
56C REAL
57 my_real
58 . v(3,*), vr(3,*), x(3,*), rby(*), skew(lskew,*), fs(*),
59 . a(3,*),ar(3,*),in(*),ms(*),freac(6,*)
60 my_real, INTENT(IN) ::
61 . fny,fty,expn,expt
62 my_real, INTENT(INOUT) ::
63 . crit, fthreac(6,*)
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com01_c.inc"
68#include "com08_c.inc"
69#include "param_c.inc"
70#include "parit_c.inc"
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER M, NSN, ICODR, ISK, I, N,ISENS, J, L,NSN_G
75C REAL
76 my_real
77 . xdum(3), vg(3), vi(3),
78 . v1x2, v2x1, v2x3, v3x2, v3x1, v1x3,usdt,dt05,
79 . vx1, vx2, vx3, mas,am1,am2,am3,vxx1,vxx2,vxx3,vy1
80 my_real
81 . ux, uy, uz, nn, fn, ft,lsm(3),vs(3),as(3)
82 my_real, DIMENSION(:,:), ALLOCATABLE ::
83 . r, rr
84C-----------------------------------------------
85 m =nby(1)
86C optimisation spmd
87 IF (m<0) RETURN
88 nsn =nby(2)
89 nsn_g = nby(19)
90C en spmd il ne faut sommer qu'une fois la vitesse du centre d'inertie
91 fs(7)=fs(7)+vr(1,m)*dt2*weight(m)
92 fs(8)=fs(8)+vr(2,m)*dt2*weight(m)
93 fs(9)=fs(9)+vr(3,m)*dt2*weight(m)
94C
95 IF(dt2*dt2*(vr(1,m)**2+vr(2,m)**2+vr(3,m)**2)>1.0.AND.nsn_g>2)THEN
96 CALL ancmsg(msgid=110,anmode=aninfo,
97 . i1=id)
98 CALL arret(2)
99 RETURN
100 ENDIF
101C
102 IF(n2d==0) THEN
103 vg(1)=vr(1,m)+ar(1,m)*dt12
104 vg(2)=vr(2,m)+ar(2,m)*dt12
105 vg(3)=vr(3,m)+ar(3,m)*dt12
106C
107 usdt = one/dt12
108C
109 am1 = a(1,m)
110 am2 = a(2,m)
111 am3 = a(3,m)
112 IF (nsn_g<=2) THEN
113 DO i=1,nsn
114 n = nod(i)
115 ar(1:3,n)= (vg(1:3)-vr(1:3,n)) * usdt
116 a(1:3,n)= a(1:3,m)+(v(1:3,m)-v(1:3,n))*usdt
117C
118 lsm(1:3) = x(1:3,n)-x(1:3,m)
119 CALL velrot_explicit(vg, lsm,vs,dt12)
120C
121 vx1=vs(1)
122 vx2=vs(2)
123 vx3=vs(3)
124
125 a(1,n)= a(1,n) +
126 . (vx1+half*dt2*(vg(2)*vx3-vg(3)*vx2))*usdt
127 a(2,n)= a(2,n) +
128 . (vx2+half*dt2*(vg(3)*vx1-vg(1)*vx3))*usdt
129 a(3,n)= a(3,n) +
130 . (vx3+half*dt2*(vg(1)*vx2-vg(2)*vx1))*usdt
131 ENDDO
132 ELSE
133 DO i=1,nsn
134 n = nod(i)
135 ar(1,n)= (vg(1)-vr(1,n)) * usdt
136 ar(2,n)= (vg(2)-vr(2,n)) * usdt
137 ar(3,n)= (vg(3)-vr(3,n)) * usdt
138C
139 v1x2=vg(1)*(x(2,n)-x(2,m))
140 v2x1=vg(2)*(x(1,n)-x(1,m))
141 v2x3=vg(2)*(x(3,n)-x(3,m))
142 v3x2=vg(3)*(x(2,n)-x(2,m))
143 v3x1=vg(3)*(x(1,n)-x(1,m))
144 v1x3=vg(1)*(x(3,n)-x(3,m))
145C
146 vx1=v2x3-v3x2
147 vx2=v3x1-v1x3
148 vx3=v1x2-v2x1
149
150 a(1,n)= am1 +
151 . (v(1,m)+vx1+half*dt2*(vg(2)*vx3-vg(3)*vx2)-v(1,n))*usdt
152 a(2,n)= am2 +
153 . (v(2,m)+vx2+half*dt2*(vg(3)*vx1-vg(1)*vx3)-v(2,n))*usdt
154 a(3,n)= am3 +
155 . (v(3,m)+vx3+half*dt2*(vg(1)*vx2-vg(2)*vx1)-v(3,n))*usdt
156 ENDDO
157 END IF ! (NSN<=2) THEN
158 ELSEIF(n2d ==1) THEN
159 vg(1)=zero
160 vg(2)=zero
161 vg(3)=vr(3,m)+ar(3,m)*dt12
162C
163 usdt = one/dt12
164C
165 am1 = zero
166 am2 = a(2,m)
167 am3 = a(3,m)
168 DO i=1,nsn
169 n = nod(i)
170 ar(1,n)= zero
171 ar(2,n)= zero
172 ar(3,n)= (vg(3)-vr(3,n)) * usdt
173C
174 vx1= vg(3)*(x(1,n)-x(1,m))
175 vy1=-vg(3)*(x(2,n)-x(2,m))
176
177 a(1,n)= am1 + (v(1,m)+vy1-half*dt2*vg(3)*vx1-v(1,n))*usdt
178 a(2,n)= am2 + (v(2,m)+vx1+half*dt2*vg(3)*vy1-v(2,n))*usdt
179 a(3,n)= am3 + (v(3,m)-v(3,n))*usdt
180 ENDDO
181 ELSEIF(n2d ==2) THEN
182 vg(1)=vr(1,m)+ar(1,m)*dt12
183 vg(2)=zero
184 vg(3)=zero
185C
186 usdt = one/dt12
187C
188 am1 = zero
189 am2 = a(2,m)
190 am3 = a(3,m)
191 DO i=1,nsn
192 n = nod(i)
193 ar(1,n)= (vg(1)-vr(1,n)) * usdt
194 ar(2,n)= zero
195 ar(3,n)= zero
196C
197 vx1=zero
198 vx2=-vg(1)*(x(3,n)-x(3,m))
199 vx3=vg(1)*(x(2,n)-x(2,m))
200 vxx1=zero
201 vxx2=-vg(1)*vg(1)*(x(2,n)-x(2,m))
202 vxx3=-vg(1)*vg(1)*(x(3,n)-x(3,m))
203 a(1,n)= zero
204 a(2,n)= am2 +
205 . (v(2,m)+vx2+half*dt2*vxx2-v(2,n))*usdt
206 a(3,n)= am3 +
207 . (v(3,m)+vx3+half*dt2*vxx3-v(3,n))*usdt
208 ENDDO
209 ENDIF
210C-----------------------------------------------
211 IF (ireac == 0 .AND. ifail /= 1) RETURN
212C-----------------------------------------------
213C Reaction forces and/or failure
214C Note : At this stage, Freac contains Fint+Fext+Fcont (Freac has not been finalized yet)
215C-----------------------------------------------
216 ALLOCATE(r(3,nsn))
217 ALLOCATE(rr(3,nsn))
218C
219 DO i=1,nsn
220 n = nod(i)
221C
222C Reaction force is also valid with zero mass or inertia
223 r(1,i) = ms(n)*a(1,n) - freac(1,n)
224 r(2,i) = ms(n)*a(2,n) - freac(2,n)
225 r(3,i) = ms(n)*a(3,n) - freac(3,n)
226C
227 rr(1,i) = in(n)*ar(1,n) - freac(4,n)
228 rr(2,i) = in(n)*ar(2,n) - freac(5,n)
229 rr(3,i) = in(n)*ar(3,n) - freac(6,n)
230C
231 ENDDO
232C
233 IF(ireac/=0)THEN
234 DO i=1,nsn
235 n = nod(i)
236 l=nodreac(n)
237 IF(l/=0)THEN
238 fthreac(1,l)=fthreac(1,l)+r(1,i)*dt12*weight(n) ! no other kin condition can apply to a secondary node
239 fthreac(2,l)=fthreac(2,l)+r(2,i)*dt12*weight(n)
240 fthreac(3,l)=fthreac(3,l)+r(3,i)*dt12*weight(n)
241 fthreac(4,l)=fthreac(4,l)+rr(1,i)*dt12*weight(n) ! no other kin condition can apply to a secondary node
242 fthreac(5,l)=fthreac(5,l)+rr(2,i)*dt12*weight(n)
243 fthreac(6,l)=fthreac(6,l)+rr(3,i)*dt12*weight(n)
244 END IF
245 END DO
246 END IF
247C
248 IF(ifail==1)THEN
249 DO i=1,nsn
250 n = nod(i)
251 ux = x(1,n)-x(1,m)
252 uy = x(2,n)-x(2,m)
253 uz = x(3,n)-x(3,m)
254 nn = one/max(em20,sqrt(ux*ux+uy*uy+uz*uz))
255 ux = ux*nn
256 uy = uy*nn
257 uz = uz*nn
258C
259 fn = r(1,i)*ux+r(2,i)*uy+r(3,i)*uz
260 r(1,i) = r(1,i)-fn*ux
261 r(2,i) = r(2,i)-fn*uy
262 r(3,i) = r(3,i)-fn*uz
263C
264 fn = abs(min(fn,zero)) ! Tension <=> Reaction force FN < 0
265 ft = sqrt(r(1,i)*r(1,i)+r(2,i)*r(2,i)+r(3,i)*r(3,i))
266C
267 crit = max(crit,exp(expn*log(max(em20,fn/fny)))+exp(expt*log(max(em20,ft/fty)))) ! Max over secondary nodes and over time
268 ENDDO
269 END IF
270C
271 DEALLOCATE(r,rr)
272C-----------------------------------------------
273 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87