OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i14dmp.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i14dmp (x, v, ksurf, igrsurf, bufsf, nsc, ksc, nsp, ksp, ksi, impact, cimp, nimp, visc, ndamp1, ndamp2, gapmin, npc, pld, ms, wf, wst, stf)

Function/Subroutine Documentation

◆ i14dmp()

subroutine i14dmp ( x,
v,
integer ksurf,
type (surf_), dimension(nsurf) igrsurf,
bufsf,
integer nsc,
ksc,
integer nsp,
ksp,
integer, dimension(*) ksi,
integer, dimension(*) impact,
cimp,
nimp,
visc,
integer ndamp1,
integer ndamp2,
gapmin,
integer, dimension(*) npc,
pld,
ms,
wf,
wst,
stf )

Definition at line 32 of file i14dmp.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE groupdef_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "mvsiz_p.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com04_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER NSC, NSP, KSURF,KSI(*),
57 . IMPACT(*), NDAMP1, NDAMP2, NPC(*)
58C REAL
59 my_real
60 . x(3,*) ,v(3,*) , bufsf(*), ksc(*), ksp(*),
61 . cimp(3,*) ,nimp(3,*) , visc , gapmin, pld(*),
62 . ms(*) ,wf(*) , wst(*), stf
63 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER ADRBUF, I, IL, IN
68 INTEGER NDEB, NREST
69 INTEGER DGR
70 INTEGER IPT,NPT,II,JJ
71 my_real
72 . a, b, c, an, bn, cn, rot(9),
73 . x1, x2, x3, n1, n2, n3, n,
74 . xpvn1, ypvn1, zpvn1, sgnxn, sgnyn, sgnzn,
75 . xm, ym, zm, xi, yi, zi,
76 . v1, v2, v3, vxm, vym, vzm, vrx, vry, vrz,
77 . vxp, vyp, vzp,vxi, vyi, vzi,
78 . dt1inv, ff
79 my_real
80 . xpv(3,mvsiz),nv(3,mvsiz),fnpv(mvsiz),vis(mvsiz),
81 . visc1(mvsiz),visc2(mvsiz),vn(mvsiz)
82C-----------------------------------------------
83 adrbuf=igrsurf(ksurf)%IAD_BUFR
84C-----------------------------------------------
85 a =bufsf(adrbuf+1)
86 b =bufsf(adrbuf+2)
87 c =bufsf(adrbuf+3)
88 dgr=bufsf(adrbuf+36)
89 an=a**dgr
90 bn=b**dgr
91 cn=c**dgr
92 an=one/an
93 bn=one/bn
94 cn=one/cn
95 DO i=1,9
96 rot(i)=bufsf(adrbuf+7+i-1)
97 END DO
98C-----------------------------------------------
99C Noeud main dans le repere de l'ellipsoide :
100C pour calcul de l'amortissement.
101C la position (el les vitesses) du noeud main sont transmises
102C par l'objet qui utilise la surface (Rigid Body)
103C - dans le Starter au Temps TT=0.
104C-----------------------------------------------
105 x1=bufsf(adrbuf+16)-bufsf(adrbuf+4)
106 x2=bufsf(adrbuf+17)-bufsf(adrbuf+5)
107 x3=bufsf(adrbuf+18)-bufsf(adrbuf+6)
108 xm=rot(1)*x1+rot(2)*x2+rot(3)*x3
109 ym=rot(4)*x1+rot(5)*x2+rot(6)*x3
110 zm=rot(7)*x1+rot(8)*x2+rot(9)*x3
111C-----------------------------------------------
112C Vitesse du noeud main en local.
113C-----------------------------------------------
114 v1=bufsf(adrbuf+19)
115 v2=bufsf(adrbuf+20)
116 v3=bufsf(adrbuf+21)
117 vxm=rot(1)*v1+rot(2)*v2+rot(3)*v3
118 vym=rot(4)*v1+rot(5)*v2+rot(6)*v3
119 vzm=rot(7)*v1+rot(8)*v2+rot(9)*v3
120C-----------------------------------------------
121C Vitesse de rotation du noeud main en local.
122C-----------------------------------------------
123 v1=bufsf(adrbuf+22)
124 v2=bufsf(adrbuf+23)
125 v3=bufsf(adrbuf+24)
126 vrx=rot(1)*v1+rot(2)*v2+rot(3)*v3
127 vry=rot(4)*v1+rot(5)*v2+rot(6)*v3
128 vrz=rot(7)*v1+rot(8)*v2+rot(9)*v3
129C-------------------------------
130C POINTS JUSTE IMPACTES.
131C-------------------------------
132 ndeb =0
133 nrest=nsc
134 100 CONTINUE
135C-------------------------------
136 DO i=1,min(mvsiz,nrest)
137 il=ksc(i+ndeb)
138 in=ksi(il)
139 fnpv(i) =wf(in)
140 nv(1,i) =nimp(1,il)
141 nv(2,i) =nimp(2,il)
142 nv(3,i) =nimp(3,il)
143 ENDDO
144C------------------------------------------------
145C Coefficient d'amortissement :
146C F(VITESSE NORMALE) * G(FORCE NORMALE LOCALE)
147C-----------------------------------------------
148 IF (ndamp1==0 .AND. ndamp2==0) THEN
149C---------------------------------
150 DO i=1,min(mvsiz,nrest)
151 il=ksc(i+ndeb)
152 in=ksi(il)
153 vis(i) = visc*2.*sqrt(stf*ms(in))
154 ENDDO
155 ELSEIF (ndamp1==0) THEN
156C---------------------------------
157 CALL ninterp(ndamp2,npc,pld,min(mvsiz,nrest),fnpv,visc2)
158 DO i=1,min(mvsiz,nrest)
159 vis(i)=visc*visc2(i)
160 ENDDO
161 ELSEIF (ndamp2==0) THEN
162C---------------------------------
163 DO i=1,min(mvsiz,nrest)
164 il=ksc(i+ndeb)
165 in=ksi(il)
166 v1 =v(1,in)
167 v2 =v(2,in)
168 v3 =v(3,in)
169 vn(i) =v(1,in)*nv(1,i)+v(2,in)*nv(2,i)+v(3,in)*nv(3,i)
170 ENDDO
171 CALL ninterp(ndamp1,npc,pld,min(mvsiz,nrest),vn,visc1)
172 DO i=1,min(mvsiz,nrest)
173 vis(i)=visc*visc1(i)
174 ENDDO
175 ELSE
176C---------------------------------
177 DO i=1,min(mvsiz,nrest)
178 il=ksc(i+ndeb)
179 in=ksi(il)
180 v1 =v(1,in)
181 v2 =v(2,in)
182 v3 =v(3,in)
183 vn(i) =v(1,in)*nv(1,i)+v(2,in)*nv(2,i)+v(3,in)*nv(3,i)
184 ENDDO
185 CALL ninterp(ndamp1,npc,pld,min(mvsiz,nrest),vn ,visc1)
186 CALL ninterp(ndamp2,npc,pld,min(mvsiz,nrest),fnpv,visc2)
187 DO i=1,min(mvsiz,nrest)
188 vis(i)=visc*visc1(i)*visc2(i)
189 ENDDO
190 ENDIF
191C------------------------------------------------
192C Amortissement :
193C-----------------------------------------------
194#include "vectorize.inc"
195 DO i=1,min(mvsiz,nrest)
196 il=ksc(i+ndeb)
197 in=ksi(il)
198C-------------------------------
199 IF (impact(il)>0) THEN
200 xi=cimp(1,il)+gapmin*nimp(1,il)
201 yi=cimp(2,il)+gapmin*nimp(2,il)
202 zi=cimp(3,il)+gapmin*nimp(3,il)
203C-------------------------------
204 v1 =v(1,in)
205 v2 =v(2,in)
206 v3 =v(3,in)
207 vxp=rot(1)*v1+rot(2)*v2+rot(3)*v3
208 vyp=rot(4)*v1+rot(5)*v2+rot(6)*v3
209 vzp=rot(7)*v1+rot(8)*v2+rot(9)*v3
210C
211 vxi=vxm+(ym-yi)*vrz-(zm-zi)*vry
212 vyi=vym-(xm-xi)*vrz+(zm-zi)*vrx
213 vzi=vzm+(xm-xi)*vry-(ym-yi)*vrx
214C-------------------------------
215 ff =-vis(i)*(nv(1,i)*(vxp-vxi)+nv(2,i)*(vyp-vyi)
216 . +nv(3,i)*(vzp-vzi))
217C-------------------------------
218 wf(in) = fnpv(i)+ff
219 wst(in) = vis(i)
220 ELSE
221 wst(in)=zero
222 END IF
223 ENDDO
224C---------------------------------
225 IF (nrest-mvsiz>0) THEN
226 nrest=nrest-mvsiz
227 ndeb =ndeb +mvsiz
228 GOTO 100
229 ENDIF
230C-------------------------------
231C POINTS PRECEDEMMENT IMPACTES.
232C-------------------------------
233 ndeb =0
234 nrest=nsp
235 200 CONTINUE
236C-------------------------------
237 DO i=1,min(mvsiz,nrest)
238 il=ksp(i+ndeb)
239 in=ksi(il)
240 fnpv(i) =wf(in)
241 nv(1,i) =nimp(1,il)
242 nv(2,i) =nimp(2,il)
243 nv(3,i) =nimp(3,il)
244 ENDDO
245C------------------------------------------------
246C Coefficient d'amortissement :
247C F(VITESSE NORMALE) * G(FORCE NORMALE LOCALE)
248C-----------------------------------------------
249 IF (ndamp1==0 .AND. ndamp2==0) THEN
250C---------------------------------
251 DO i=1,min(mvsiz,nrest)
252 il=ksp(i+ndeb)
253 in=ksi(il)
254 vis(i) = visc*two*sqrt(stf*ms(in))
255 ENDDO
256 ELSEIF (ndamp1==0) THEN
257C---------------------------------
258 CALL ninterp(ndamp2,npc,pld,min(mvsiz,nrest),fnpv,visc2)
259 DO i=1,min(mvsiz,nrest)
260 vis(i)=visc*visc2(i)
261 ENDDO
262 ELSEIF (ndamp2==0) THEN
263C---------------------------------
264 DO i=1,min(mvsiz,nrest)
265 il=ksp(i+ndeb)
266 in=ksi(il)
267 v1 =v(1,in)
268 v2 =v(2,in)
269 v3 =v(3,in)
270 vn(i) =v(1,in)*nv(1,i)+v(2,in)*nv(2,i)+v(3,in)*nv(3,i)
271 ENDDO
272 CALL ninterp(ndamp1,npc,pld,min(mvsiz,nrest),vn,visc1)
273 DO i=1,min(mvsiz,nrest)
274 vis(i)=visc*visc1(i)
275 ENDDO
276 ELSE
277C---------------------------------
278 DO i=1,min(mvsiz,nrest)
279 il=ksp(i+ndeb)
280 in=ksi(il)
281 v1 =v(1,in)
282 v2 =v(2,in)
283 v3 =v(3,in)
284 vn(i) =v(1,in)*nv(1,i)+v(2,in)*nv(2,i)+v(3,in)*nv(3,i)
285 ENDDO
286 CALL ninterp(ndamp1,npc,pld,min(mvsiz,nrest),vn ,visc1)
287 CALL ninterp(ndamp2,npc,pld,min(mvsiz,nrest),fnpv,visc2)
288 DO i=1,min(mvsiz,nrest)
289 vis(i)=visc*visc1(i)*visc2(i)
290 ENDDO
291 ENDIF
292C------------------------------------------------
293C Amortissement :
294C-----------------------------------------------
295#include "vectorize.inc"
296 DO i=1,min(mvsiz,nrest)
297 il=ksp(i+ndeb)
298 in=ksi(il)
299C-------------------------------
300 xi=cimp(1,il)+gapmin*nimp(1,il)
301 yi=cimp(2,il)+gapmin*nimp(2,il)
302 zi=cimp(3,il)+gapmin*nimp(3,il)
303C-------------------------------
304 v1 =v(1,in)
305 v2 =v(2,in)
306 v3 =v(3,in)
307 vxp=rot(1)*v1+rot(2)*v2+rot(3)*v3
308 vyp=rot(4)*v1+rot(5)*v2+rot(6)*v3
309 vzp=rot(7)*v1+rot(8)*v2+rot(9)*v3
310C
311 vxi=vxm+(ym-yi)*vrz-(zm-zi)*vry
312 vyi=vym-(xm-xi)*vrz+(zm-zi)*vrx
313 vzi=vzm+(xm-xi)*vry-(ym-yi)*vrx
314C-------------------------------
315 ff =-vis(i)*(nv(1,i)*(vxp-vxi)+nv(2,i)*(vyp-vyi)
316 . +nv(3,i)*(vzp-vzi))
317C-------------------------------
318 wf(in) = fnpv(i)+ff
319 wst(in) = vis(i)
320 ENDDO
321C---------------------------------
322 IF (nrest-mvsiz>0) THEN
323 nrest=nrest-mvsiz
324 ndeb =ndeb +mvsiz
325 GOTO 200
326 ENDIF
327C------------------------------------------------------------
328 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
groupdef_mod
Definition groupdef_mod.F:662
ninterp
subroutine ninterp(ifunc, npc, pld, npoint, xv, yv)
Definition ninterp.F:32