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

Go to the source code of this file.

Functions/Subroutines

subroutine i2curvfp (ms, in, x, v, vr, a, ar, stifn, stifr, weight, nsv, msr, irtl, irect, crst, nsn, nmn, idel2, i0, i2size, iadi2, mmass, smass, siner, fskyi2, fsav, fncont, h3d_data, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2curvfp()

subroutine i2curvfp ( ms,
in,
x,
v,
vr,
a,
ar,
stifn,
stifr,
integer, dimension(*) weight,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer, dimension(*) irtl,
integer, dimension(4,*) irect,
crst,
integer nsn,
integer nmn,
integer idel2,
integer i0,
integer i2size,
integer, dimension(4,*) iadi2,
mmass,
smass,
siner,
fskyi2,
fsav,
fncont,
type (h3d_database) h3d_data,
fncontp,
ftcontp )

Definition at line 35 of file i2curvfp.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE h3d_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NSN, NMN, I0,I2SIZE,IDEL2
54 INTEGER IRECT(4,*),NSV(*),MSR(*),IRTL(*),WEIGHT(*),IADI2(4,*)
55C REAL
57 . ms(*),in(*),mmass(*),smass(*),siner(*),x(3,*),v(3,*),vr(3,*),
58 . a(3,*),ar(3,*),stifn(*),stifr(*),fsav(*),crst(2,*),
59 . fskyi2(i2size,*),fncont(3,*),fncontp(3,*),ftcontp(3,*)
60 TYPE (H3D_DATABASE) :: H3D_DATA
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I1,I2,I3,I4,II,IS,IM,JJ,L,NN,NIR
65 INTEGER INOD(4)
67 . xms,ins,stfn,stfr,fs(3),moms(3),ls1,ls2,lt1,lt2,
68 . ls,lt,len,s,t,xc,yc,zc,dm1,dm2,din1,din2,din3,
69 . sumhrs,sumhrt,sumhprs,sumhprt
71 . fsloc(6),fmloc(4,6),rot(9),roti(9),dm(4),din(4),dstfn(4),
72 . dstfr(4),h(4),hh(4),hrs(4),hrt(4),hps(4),hpt(4),hprs(4),
73 . hprt(4),hxs(4),hxt(4),fx(4),fy(4),fz(4)
74C======================================================================|
75 nir = 4
76C----------------------
77#include "vectorize.inc"
78 DO ii=1,nmn
79 im=msr(ii)
80 mmass(ii)=ms(im)
81 in(im)=max(em20,in(im))
82 ENDDO
83C----------------------
84 DO ii=1,nsn
85 is = nsv(ii)
86 IF (is > 0) THEN
87 IF (weight(is) == 1) THEN
88 l = irtl(ii)
89 DO jj=1,nir
90 inod(jj) = irect(jj,l)
91 ENDDO
92C---
93 CALL i2curv_rep(inod , x ,v ,ls1 ,ls2 ,
94 . lt1 ,lt2 ,rot(1) ,rot(4) ,rot(7) ,
95 . rot(2) ,rot(5) ,rot(8) ,rot(3) ,rot(6) ,
96 . rot(9) )
97 CALL inv3(rot,roti)
98C---
99 s=crst(1,ii)
100 t=crst(2,ii)
101 CALL i2_fform(
102 . nir,s,t,h,hh,hrs,hrt,hps,hpt,hprs,hprt,
103 . hxs,hxt,ls1,ls2,lt1,lt2,ls,lt)
104C
105 sumhrs = abs(hrs(1) +hrs(2) +hrs(3) +hrs(4))
106 sumhrt = abs(hrt(1) +hrt(2) +hrt(3) +hrt(4))
107 sumhprs = abs(hprs(1)+hprs(2)+hprs(3)+hprs(4))
108 sumhprt = abs(hprt(1)+hprt(2)+hprt(3)+hprt(4))
109 i1 = inod(1)
110 i2 = inod(2)
111 i3 = inod(3)
112 i4 = inod(4)
113 xc = x(1,i1)*h(1)+x(1,i2)*h(2)+x(1,i3)*h(3)+x(1,i4)*h(4)
114 yc = x(2,i2)*h(1)+x(2,i2)*h(2)+x(2,i3)*h(3)+x(2,i4)*h(4)
115 zc = x(3,i3)*h(1)+x(3,i2)*h(2)+x(3,i3)*h(3)+x(3,i4)*h(4)
116C
117 fs(1) = a(1,is)
118 fs(2) = a(2,is)
119 fs(3) = a(3,is)
120 moms(1) = ar(1,is)
121 moms(2) = ar(2,is)
122 moms(3) = ar(3,is)
123 xms = ms(is)
124 ins = in(is)
125 stfn=stifn(is)
126 stfr=stifr(is)
127C
128C--- secnd forces -> rep local
129C
130 fsloc(1) = rot(1)*fs(1) + rot(4)*fs(2) + rot(7)*fs(3)
131 fsloc(2) = rot(2)*fs(1) + rot(5)*fs(2) + rot(8)*fs(3)
132 fsloc(3) = rot(3)*fs(1) + rot(6)*fs(2) + rot(9)*fs(3)
133 fsloc(4) = rot(1)*moms(1) + rot(4)*moms(2) + rot(7)*moms(3)
134 fsloc(5) = rot(2)*moms(1) + rot(5)*moms(2) + rot(8)*moms(3)
135 fsloc(6) = rot(3)*moms(1) + rot(6)*moms(2) + rot(9)*moms(3)
136C
137C------- transfer secnd forces to main
138 DO jj=1,nir
139 fmloc(jj,1) = h(jj)*fsloc(1)
140 fmloc(jj,2) = h(jj)*fsloc(2)
141 fmloc(jj,3) = hh(jj)*fsloc(3)
142 . + hps(jj)*fsloc(4) + hpt(jj)*fsloc(5)
143 fmloc(jj,4) = hrs(jj)*fsloc(3)
144 . + hprs(jj)*fsloc(4)+ hxt(jj)*fsloc(5)
145 fmloc(jj,5) = hrt(jj)*fsloc(3)
146 . + hxs(jj)*fsloc(4) + hprt(jj)*fsloc(5)
147 fmloc(jj,6) = h(jj)*fsloc(6)
148 ENDDO
149C------- transfer secnd mass + inertia + stiffness to main
150 DO jj=1,nir
151 im = inod(jj)
152 len = sqrt((x(1,im)-xc)**2+(x(2,im)-yc)**2+(x(3,im)-zc)**2)
153C
154 dm1 = h(jj) *xms
155 dm2 = hh(jj)*xms
156 . + hh(jj)*(sumhrs +sumhrt)*xms/len
157 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*ins/len
158 IF (dm1 > dm2) THEN
159 dm(jj) = dm1
160 dstfn(jj) = h(jj)*stfn
161 ELSE
162 dm(jj) = dm2
163 dstfn(jj) = hh(jj)*stfn
164 . + hh(jj)*(sumhrs +sumhrt)*stfn/len
165 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*stfr/len
166 ENDIF
167C
168 din1 = abs(hrs(jj))*(sumhrs+sumhrt)*xms
169 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*ins
170 . + abs(hrs(jj))*xms*len
171 din2 = abs(hrt(jj))*(sumhrs+sumhrt)*xms
172 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*ins
173 . + abs(hrt(jj))*xms*len
174 din3 = h(jj)*ins
175 IF (din1 >= din2 .AND. din1 >= din3) THEN
176 din(jj) = din1
177 dstfr(jj) = abs(hrs(jj))*(sumhrs+sumhrt)*stfn
178 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*stfr
179 . + abs(hrs(jj))*stfn*len
180 ELSEIF (din2 >= din1 .AND. din2 >= din3) THEN
181 din(jj) = din2
182 dstfr(jj) = abs(hrt(jj))*(sumhrs+sumhrt)*stfn
183 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*stfr
184 . + abs(hrt(jj))*stfn*len
185 ELSEIF (din3 >= din1 .AND. din3 >= din2) THEN
186 din(jj) = din3
187 dstfr(jj) = h(jj)*stfr
188 ENDIF
189 ENDDO
190C
191C--- update main forces in global frame
192C
193 DO jj=1,4
194 fx(jj) = roti(1)*fmloc(jj,1)+roti(4)*fmloc(jj,2)+roti(7)*fmloc(jj,3)
195 fy(jj) = roti(2)*fmloc(jj,1)+roti(5)*fmloc(jj,2)+roti(8)*fmloc(jj,3)
196 fz(jj) = roti(3)*fmloc(jj,1)+roti(6)*fmloc(jj,2)+roti(9)*fmloc(jj,3)
197 ENDDO
198C
199 i0 = i0 + 1
200 jj = 1
201 nn = iadi2(jj,i0)
202
203 fskyi2(1,nn) = fx(jj)
204 fskyi2(2,nn) = fy(jj)
205 fskyi2(3,nn) = fz(jj)
206 fskyi2(4,nn) = dm(jj)
207 fskyi2(5,nn) = dstfn(jj)
208 fskyi2(6,nn) =
209 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
210 fskyi2(7,nn) =
211 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
212 fskyi2(8,nn) =
213 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
214 fskyi2(9,nn) = din(jj)
215 fskyi2(10,nn)= dstfr(jj)
216C
217 jj = 2
218 nn = iadi2(jj,i0)
219 fskyi2(1,nn) = fx(jj)
220 fskyi2(2,nn) = fy(jj)
221 fskyi2(3,nn) = fz(jj)
222 fskyi2(4,nn) = dm(jj)
223 fskyi2(5,nn) = dstfn(jj)
224 fskyi2(6,nn) =
225 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
226 fskyi2(7,nn) =
227 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
228 fskyi2(8,nn) =
229 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
230 fskyi2(9,nn) = din(jj)
231 fskyi2(10,nn)= dstfr(jj)
232C
233 jj = 3
234 nn = iadi2(jj,i0)
235 fskyi2(1,nn) = fx(jj)
236 fskyi2(2,nn) = fy(jj)
237 fskyi2(3,nn) = fz(jj)
238 fskyi2(4,nn) = dm(jj)
239 fskyi2(5,nn) = dstfn(jj)
240 fskyi2(6,nn) =
241 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
242 fskyi2(7,nn) =
243 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
244 fskyi2(8,nn) =
245 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
246 fskyi2(9,nn) = din(jj)
247 fskyi2(10,nn)= dstfr(jj)
248C
249 jj = 4
250 nn = iadi2(jj,i0)
251 fskyi2(1,nn) = fx(jj)
252 fskyi2(2,nn) = fy(jj)
253 fskyi2(3,nn) = fz(jj)
254 fskyi2(4,nn) = dm(jj)
255 fskyi2(5,nn) = dstfn(jj)
256 fskyi2(6,nn) =
257 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
258 fskyi2(7,nn) =
259 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
260 fskyi2(8,nn) =
261 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
262 fskyi2(9,nn) = din(jj)
263 fskyi2(10,nn)= dstfr(jj)
264C
265C--- output of tied contact forces
266 CALL i2forces(x ,fs ,fx ,fy ,fz ,
267 . inod(1) ,nir ,fsav ,fncont ,fncontp,
268 . ftcontp ,weight ,h3d_data,is ,h)
269C---
270 IF (idel2/=0.AND.ms(is)/=zero) smass(ii)=ms(is)
271 IF (idel2/=0.AND.ms(is)/=zero) siner(ii)=in(is)
272 stifr(is)=em20
273 stifn(is)=em20
274 in(is) =zero
275 ms(is) =zero
276 a(1,is) =zero
277 a(2,is) =zero
278 a(3,is) =zero
279 ar(1,is) =zero
280 ar(2,is) =zero
281 ar(3,is) =zero
282C---
283 ENDIF
284 ELSEIF(weight(-is) == 1) THEN
285C stokage ZERO pour noeuds delete par idel2
286 i0 = i0 + 1
287 nn = iadi2(1,i0)
288 fskyi2(1,nn) = zero
289 fskyi2(2,nn) = zero
290 fskyi2(3,nn) = zero
291 fskyi2(4,nn) = zero
292 fskyi2(5,nn) = zero
293 fskyi2(6,nn) = zero
294 fskyi2(7,nn) = zero
295 fskyi2(8,nn) = zero
296 fskyi2(9,nn) = zero
297 fskyi2(10,nn)= zero
298 nn = iadi2(2,i0)
299 fskyi2(1,nn) = zero
300 fskyi2(2,nn) = zero
301 fskyi2(3,nn) = zero
302 fskyi2(4,nn) = zero
303 fskyi2(5,nn) = zero
304 fskyi2(6,nn) = zero
305 fskyi2(7,nn) = zero
306 fskyi2(8,nn) = zero
307 fskyi2(9,nn) = zero
308 fskyi2(10,nn)= zero
309 nn = iadi2(3,i0)
310 fskyi2(1,nn) = zero
311 fskyi2(2,nn) = zero
312 fskyi2(3,nn) = zero
313 fskyi2(4,nn) = zero
314 fskyi2(5,nn) = zero
315 fskyi2(6,nn) = zero
316 fskyi2(7,nn) = zero
317 fskyi2(8,nn) = zero
318 fskyi2(9,nn) = zero
319 fskyi2(10,nn)= zero
320 nn = iadi2(4,i0)
321 fskyi2(1,nn) = zero
322 fskyi2(2,nn) = zero
323 fskyi2(3,nn) = zero
324 fskyi2(4,nn) = zero
325 fskyi2(5,nn) = zero
326 fskyi2(6,nn) = zero
327 fskyi2(7,nn) = zero
328 fskyi2(8,nn) = zero
329 fskyi2(9,nn) = zero
330 fskyi2(10,nn)= zero
331 ENDIF
332 ENDDO
333C-----------
334 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine i2_fform(nir, s, t, h, hh, hrs, hrt, hps, hpt, hprs, hprt, hxs, hxt, ls1, ls2, lt1, lt2, ls, lt)
Definition i2_fform.F:33
subroutine i2curv_rep(inod, x, v, ls1, ls2, lt1, lt2, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition i2curv_rep.F:35
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
subroutine inv3(a, b)
Definition inv3.F:29
#define max(a, b)
Definition macros.h:21