OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for26p.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr11_c.inc"
#include "scr14_c.inc"
#include "sms_c.inc"
#include "task_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2for26p (x, v, vr, a, ar, ms, stifn, stifr, weight, irect, nsv, irtl, dr, dl, fini, fsav, fncont, nsn, i0, i2size, iadi2, fskyi2, stfn, stfr, visc, noint, nodnx_sms, dmint2, in, dt2t, neltst, ityptst, h3d_data, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2for26p()

subroutine i2for26p ( x,
v,
vr,
a,
ar,
ms,
stifn,
stifr,
integer, dimension(*) weight,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
dr,
dl,
fini,
fsav,
fncont,
integer nsn,
integer i0,
integer i2size,
integer, dimension(4,*) iadi2,
fskyi2,
stfn,
stfr,
visc,
integer noint,
integer, dimension(*) nodnx_sms,
dmint2,
in,
dt2t,
integer neltst,
integer ityptst,
type (h3d_database) h3d_data,
fncontp,
ftcontp )

Definition at line 35 of file i2for26p.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"
50#include "comlock.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NSN, NOINT, I2SIZE,I0, NELTST,ITYPTST
59 INTEGER IRECT(4,*),NSV(*),IRTL(*),WEIGHT(*),NODNX_SMS(*),
60 . IADI2(4,*)
61C REAL
62 my_real
63 . visc,dt2t
64 my_real
65 . x(3,*),vr(3,*),v(3,*),a(3,*),ar(3,*),ms(*),in(*),fini(6,4,*),
66 . dl(3,4,*),dr(3,4,*),stifn(*),stifr(*),stfn(*),stfr(*),
67 . fsav(*),fncont(3,*),fskyi2(i2size,*),dmint2(4,*),fncontp(3,*),
68 . ftcontp(3,*)
69 TYPE (H3D_DATABASE) :: H3D_DATA
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com01_c.inc"
74#include "com06_c.inc"
75#include "com08_c.inc"
76#include "scr11_c.inc"
77#include "scr14_c.inc"
78#include "sms_c.inc"
79#include "task_c.inc"
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER NIR,I,J,IR,II,JJ,L,W,KK,K,LLT,NM,
84 . IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),NSVG(MVSIZ)
85C REAL
86 my_real
87 . econtt,econvt,e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,xsm,ysm,zsm,dti,
88 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,mlx,mly,mlz,
89 . drx,dry,drz,vrx,vry,vrz,dlx,dly,dlz,len2,dkm,din,stifms, dxt,
90 . dvx,dvy,dvz,vxx,vyy,vzz,vlx,vly,vlz,wx,wy,wz,dwx,dwy,dwz,ms_harm,in_harm
91 my_real
92 . stif(mvsiz),vis(4,mvsiz),visr(4,mvsiz),stf(4,mvsiz),str(4,mvsiz),
93 . fx(4),fy(4),fz(4),mx(4),my(4),mz(4),mrx(4),mry(4),mrz(4),
94 . flocx(4),flocy(4),flocz(4),flocxv(4),flocyv(4),floczv(4),
95 . mlocx(4),mlocy(4),mlocz(4),mlocxv(4),mlocyv(4),mloczv(4),
96 . fnorm,fn(3),ft(3),stbrk,va(3),vb(3),vc(3),vd(3),rx(4),ry(4),rz(4),
97 . vx1,vy1,vz1,vx2,vy2,vz2,vx3,vy3,vz3,vx4,vy4,vz4,rs(3),
98 . x0,y0,z0,xs,ys,zs,dwdu,h(4),stifm(mvsiz),stmax,wlx,wly,wlz
99C=======================================================================
100 i7kglo = 1
101 econtt = zero
102 econvt = zero
103C
104C----------------
105 DO kk=1,nsn,mvsiz
106C
107 llt = min(nsn-kk+1,mvsiz)
108c
109 DO k=1,llt
110 ii = kk + k - 1
111 i = nsv(ii)
112C
113 IF (i > 0) THEN
114 nsvg(k) = i
115 w = weight(i)
116 l = irtl(ii)
117C
118 ix1(k) = irect(1,l)
119 ix2(k) = irect(2,l)
120 ix3(k) = irect(3,l)
121 ix4(k) = irect(4,l)
122 IF (ix3(k) == ix4(k)) THEN
123 nir = 3
124 stf(4,k) = zero
125 h(1) = one
126 h(2) = one
127 h(3) = one
128 h(4) = zero
129 ELSE
130 nir= 4
131 h(1) = one
132 h(2) = one
133 h(3) = one
134 h(4) = one
135C
136 ENDIF
137C------------------------------------------------
138C rep local facette main
139C------------------------------------------------
140 x1 = x(1,ix1(k))
141 y1 = x(2,ix1(k))
142 z1 = x(3,ix1(k))
143 x2 = x(1,ix2(k))
144 y2 = x(2,ix2(k))
145 z2 = x(3,ix2(k))
146 x3 = x(1,ix3(k))
147 y3 = x(2,ix3(k))
148 z3 = x(3,ix3(k))
149 x4 = x(1,ix4(k))
150 y4 = x(2,ix4(k))
151 z4 = x(3,ix4(k))
152C
153 vx1 = v(1,ix1(k))
154 vy1 = v(2,ix1(k))
155 vz1 = v(3,ix1(k))
156 vx2 = v(1,ix2(k))
157 vy2 = v(2,ix2(k))
158 vz2 = v(3,ix2(k))
159 vx3 = v(1,ix3(k))
160 vy3 = v(2,ix3(k))
161 vz3 = v(3,ix3(k))
162 vx4 = v(1,ix4(k))
163 vy4 = v(2,ix4(k))
164 vz4 = v(3,ix4(k))
165C
166C---------------------
167 CALL i2rep(x1 ,x2 ,x3 ,x4 ,
168 . y1 ,y2 ,y3 ,y4 ,
169 . z1 ,z2 ,z3 ,z4 ,
170 . e1x ,e1y ,e1z ,
171 . e2x ,e2y ,e2z ,
172 . e3x ,e3y ,e3z ,nir )
173C
174 IF (nir == 4) THEN
175 x0 = (x1 + x2 + x3 + x4)/nir
176 y0 = (y1 + y2 + y3 + y4)/nir
177 z0 = (z1 + z2 + z3 + z4)/nir
178 ELSE
179 x0 = (x1 + x2 + x3)/nir
180 y0 = (y1 + y2 + y3)/nir
181 z0 = (z1 + z2 + z3)/nir
182 ENDIF
183C
184 x1 = x1 - x0
185 y1 = y1 - y0
186 z1 = z1 - z0
187 x2 = x2 - x0
188 y2 = y2 - y0
189 z2 = z2 - z0
190 x3 = x3 - x0
191 y3 = y3 - y0
192 z3 = z3 - z0
193 x4 = x4 - x0
194 y4 = y4 - y0
195 z4 = z4 - z0
196 xs = x(1,i) - x0
197 ys = x(2,i) - y0
198 zs = x(3,i) - z0
199C
200c global -> local
201c
202 rs(1) = xs*e1x + ys*e1y + zs*e1z
203 rs(2) = xs*e2x + ys*e2y + zs*e2z
204 rs(3) = xs*e3x + ys*e3y + zs*e3z
205c
206 rx(1) = e1x*x1 + e1y*y1 + e1z*z1
207 ry(1) = e2x*x1 + e2y*y1 + e2z*z1
208 rz(1) = e3x*x1 + e3y*y1 + e3z*z1
209 rx(2) = e1x*x2 + e1y*y2 + e1z*z2
210 ry(2) = e2x*x2 + e2y*y2 + e2z*z2
211 rz(2) = e3x*x2 + e3y*y2 + e3z*z2
212 rx(3) = e1x*x3 + e1y*y3 + e1z*z3
213 ry(3) = e2x*x3 + e2y*y3 + e2z*z3
214 rz(3) = e3x*x3 + e3y*y3 + e3z*z3
215 rx(4) = e1x*x4 + e1y*y4 + e1z*z4
216 ry(4) = e2x*x4 + e2y*y4 + e2z*z4
217 rz(4) = e3x*x4 + e3y*y4 + e3z*z4
218C
219 IF (nir==3) THEN
220 rx(4)=zero
221 ry(4)=zero
222 rz(4)=zero
223 END IF
224C
225 IF (nir==3) THEN
226 vd(1) = zero
227 vd(2) = zero
228 vd(3) = zero
229 ENDIF
230C
231 IF (iroddl == 0 .OR. in(i) == zero) THEN
232C--------- Connection solide : calcul vitesse entrainement facette main Vi = Vi -VR ^ MS
233 va(1) = vx1*e1x + vy1*e1y + vz1*e1z
234 va(2) = vx1*e2x + vy1*e2y + vz1*e2z
235 va(3) = vx1*e3x + vy1*e3y + vz1*e3z
236 vb(1) = vx2*e1x + vy2*e1y + vz2*e1z
237 vb(2) = vx2*e2x + vy2*e2y + vz2*e2z
238 vb(3) = vx2*e3x + vy2*e3y + vz2*e3z
239 vc(1) = vx3*e1x + vy3*e1y + vz3*e1z
240 vc(2) = vx3*e2x + vy3*e2y + vz3*e2z
241 vc(3) = vx3*e3x + vy3*e3y + vz3*e3z
242 vd(1) = vx4*e1x + vy4*e1y + vz4*e1z
243 vd(2) = vx4*e2x + vy4*e2y + vz4*e2z
244 vd(3) = vx4*e3x + vy4*e3y + vz4*e3z
245C
246 CALL i2pen_rot26(tt ,dt1 ,dwdu,
247 . wlx ,wly ,wlz ,
248 . rx ,ry ,rz ,va ,vb ,
249 . vc ,vd)
250C
251 ENDIF
252C
253c----------------------------------------------------------
254 DO ir = 1,nir
255 nm = irect(ir,l)
256
257c velocities in global coords
258
259 IF (iroddl == 1 .and. in(i) > zero) THEN
260 wx = (vr(1,i) + vr(1,nm)) * half
261 wy = (vr(2,i) + vr(2,nm)) * half
262 wz = (vr(3,i) + vr(3,nm)) * half
263 wlx = wx*e1x + wy*e1y + wz*e1z
264 wly = wx*e2x + wy*e2y + wz*e2z
265 wlz = wx*e3x + wy*e3y + wz*e3z
266 dwx = vr(1,i) - vr(1,nm)
267 dwy = vr(2,i) - vr(2,nm)
268 dwz = vr(3,i) - vr(3,nm)
269 stbrk = zero
270 ELSE
271 dwx = zero
272 dwy = zero
273 dwz = zero
274 stbrk = sqrt(xsm*xsm+ysm*ysm+zsm*zsm)*dwdu
275 ENDIF
276C
277 dvx = v(1,i) - v(1,nm)
278 dvy = v(2,i) - v(2,nm)
279 dvz = v(3,i) - v(3,nm)
280C
281 xsm = rs(1) - rx(ir)
282 ysm = rs(2) - ry(ir)
283 zsm = rs(3) - rz(ir)
284 len2 = xsm*xsm + ysm*ysm + zsm*zsm
285
286 vxx = dvx
287 vyy = dvy
288 vzz = dvz
289
290c displacements & rotations in local coord
291
292 vlx = vxx*e1x + vyy*e1y + vzz*e1z + ysm*wlz - zsm*wly
293 vly = vxx*e2x + vyy*e2y + vzz*e2z + zsm*wlx - xsm*wlz
294 vlz = vxx*e3x + vyy*e3y + vzz*e3z + xsm*wly - ysm*wlx
295c
296 vrx = dwx*e1x + dwy*e1y + dwz*e1z
297 vry = dwx*e2x + dwy*e2y + dwz*e2z
298 vrz = dwx*e3x + dwy*e3y + dwz*e3z
299c
300 dlx = vlx * dt1
301 dly = vly * dt1
302 dlz = vlz * dt1
303c
304 drx = vrx * dt1
305 dry = vry * dt1
306 drz = vrz * dt1
307c
308 dl(1,ir,ii) = dl(1,ir,ii) + dlx
309 dl(2,ir,ii) = dl(2,ir,ii) + dly
310 dl(3,ir,ii) = dl(3,ir,ii) + dlz
311c
312 dr(1,ir,ii) = dr(1,ir,ii) + drx
313 dr(2,ir,ii) = dr(2,ir,ii) + dry
314 dr(3,ir,ii) = dr(3,ir,ii) + drz
315C----------------------------------------------------
316c Stiffness
317C----------------------------------------------------
318 IF (visc /= zero) THEN
319 ms_harm = (ms(i)*ms(nm))/(ms(i)+ms(nm))
320 dkm = two*stfn(ii)*ms_harm
321 vis(ir,k) = visc*sqrt(dkm)
322 stf(ir,k) = (vis(ir,k) + sqrt(vis(ir,k)**2 + (one+stbrk)*dkm))**2/(two*ms_harm)
323 ELSE
324 stf(ir,k) = (one+stbrk)*stfn(ii)
325 ENDIF
326 IF (iroddl == 1 .and. in(i) > zero) THEN
327 in_harm = (in(i)*in(nm))/(in(i)+in(nm))
328 stfr(ii) = stfn(ii)*len2
329 dkm = two*stfr(ii)*in_harm
330 visr(ir,k)= visc*sqrt(dkm)
331 str(ir,k) = (visr(ir,k) + sqrt(visr(ir,k)**2 + dkm))**2/(two*in_harm)
332 ELSE
333 visr(ir,k) = zero
334 stfr(ii) = zero
335 str(ir,k) = zero
336 ENDIF
337C----------------------------------------------------
338c forces & moments in local coord
339C----------------------------------------------------
340 flocx(ir) = stfn(ii) * dl(1,ir,ii)
341 flocy(ir) = stfn(ii) * dl(2,ir,ii)
342 flocz(ir) = stfn(ii) * dl(3,ir,ii)
343c
344 flocxv(ir) = vis(ir,k) * vlx
345 flocyv(ir) = vis(ir,k) * vly
346 floczv(ir) = vis(ir,k) * vlz
347c---
348 dxt = dl(1,ir,ii)**2 + dl(2,ir,ii)**2+ dl(3,ir,ii)**2
349 econtt = econtt + half*stfn(ii)*dxt
350
351 econvt = econvt + (flocxv(ir)*vlx
352 . + flocyv(ir)*vly
353 . + floczv(ir)*vlz)*dt1
354c---
355 flocx(ir) = flocx(ir) + flocxv(ir)
356 flocy(ir) = flocy(ir) + flocyv(ir)
357 flocz(ir) = flocz(ir) + floczv(ir)
358c
359 mlocx(ir) = stfr(ii) * dr(1,ir,ii)
360 mlocy(ir) = stfr(ii) * dr(2,ir,ii)
361 mlocz(ir) = stfr(ii) * dr(3,ir,ii)
362c
363 mlocxv(ir) = visr(ir,k) * vrx
364 mlocyv(ir) = visr(ir,k) * vry
365 mloczv(ir) = visr(ir,k) * vrz
366c
367 IF (iroddl == 1 .and. in(i) > zero) THEN
368 dxt = dr(1,ir,ii)**2 + dr(2,ir,ii)**2 + dr(3,ir,ii)**2
369 econtt = econtt + half*stfr(ii)*dxt
370
371 econvt = econvt + (mlocxv(ir)*vrx
372 . + mlocyv(ir)*vry
373 . + mloczv(ir)*vrz)*dt1
374 ENDIF
375c
376 mlocx(ir) = mlocx(ir) + mlocxv(ir)
377 mlocy(ir) = mlocy(ir) + mlocyv(ir)
378 mlocz(ir) = mlocz(ir) + mloczv(ir)
379c
380 ENDDO ! IR = 1,NIR
381C
382 stmax = max(stf(1,k),stf(2,k),stf(3,k),stf(4,k))
383 IF (iroddl == 1 .and. in(i) > zero) THEN
384 stifm(k) = zero
385 ELSE
386C----------------------------------------------------
387c update main forces (moment balance)
388C
389 CALL i2loceq( nir ,rs ,rx ,ry ,rz ,
390 . flocx ,flocy ,flocz ,h ,stifm(k))
391 ENDIF
392C
393 DO ir = 1,nir
394 nm = irect(ir,l)
395C
396 xsm = x(1,i) - x(1,nm)
397 ysm = x(2,i) - x(2,nm)
398 zsm = x(3,i) - x(3,nm)
399c
400C----------------------------------------------------
401C forces/moments -> global coordinates
402C----------------------------------------------------
403 fx(ir) = e1x*flocx(ir) + e2x*flocy(ir) + e3x*flocz(ir)
404 fy(ir) = e1y*flocx(ir) + e2y*flocy(ir) + e3y*flocz(ir)
405 fz(ir) = e1z*flocx(ir) + e2z*flocy(ir) + e3z*flocz(ir)
406
407 mx(ir) = e1x*mlocx(ir) + e2x*mlocy(ir) + e3x*mlocz(ir)
408 my(ir) = e1y*mlocx(ir) + e2y*mlocy(ir) + e3y*mlocz(ir)
409 mz(ir) = e1z*mlocx(ir) + e2z*mlocy(ir) + e3z*mlocz(ir)
410
411 mrx(ir) = half*(ysm*fz(ir) - zsm*fy(ir))
412 mry(ir) = half*(zsm*fx(ir) - xsm*fz(ir))
413 mrz(ir) = half*(xsm*fy(ir) - ysm*fx(ir))
414c
415c secnd node
416
417 a(1,i) = a(1,i) - fx(ir)
418 a(2,i) = a(2,i) - fy(ir)
419 a(3,i) = a(3,i) - fz(ir)
420 stifn(i) = stifn(i) + stf(ir,k)
421c
422 IF (iroddl == 1 .and. in(i) > zero) THEN
423 ar(1,i) = ar(1,i) - mx(ir) + mrx(ir)
424 ar(2,i) = ar(2,i) - my(ir) + mry(ir)
425 ar(3,i) = ar(3,i) - mz(ir) + mrz(ir)
426 stifr(i) = stifr(i) + str(ir,k)
427 ENDIF
428c--------------------------------------------
429c MLX = (MRX(IR)*E1X + MRY(IR)*E1Y + MRZ(IR)*E1Z)*TWO
430c MLY = (MRX(IR)*E2X + MRY(IR)*E2Y + MRZ(IR)*E2Z)*TWO
431c MLZ = (MRX(IR)*E3X + MRY(IR)*E3Y + MRZ(IR)*E3Z)*TWO
432c--------------------------------------------
433
434 fini(1,ir,ii) = flocx(ir)
435 fini(2,ir,ii) = flocy(ir)
436 fini(3,ir,ii) = flocz(ir)
437 IF (iroddl == 1 .and. in(i) > zero) THEN
438 fini(4,ir,ii) = mlocx(ir)
439 fini(5,ir,ii) = mlocy(ir)
440 fini(6,ir,ii) = mlocz(ir)
441 ENDIF
442C
443C------------------------------------------------
444C composantes N/T de la forces nodale -> output
445C------------------------------------------------
446 fnorm = e3x*flocx(ir) + e3y*flocy(ir) + e3z*flocz(ir)
447 fn(1) = e3x*fnorm
448 fn(2) = e3y*fnorm
449 fn(3) = e3z*fnorm
450C
451 ft(1) = flocx(ir) - fn(1)
452 ft(2) = flocy(ir) - fn(2)
453 ft(3) = flocz(ir) - fn(3)
454C
455 fsav(1) = fsav(1) + fn(1)*dt1*w
456 fsav(2) = fsav(2) + fn(2)*dt1*w
457 fsav(3) = fsav(3) + fn(3)*dt1*w
458 fsav(4) = fsav(4) + ft(1)*dt1*w
459 fsav(5) = fsav(5) + ft(2)*dt1*w
460 fsav(6) = fsav(6) + ft(3)*dt1*w
461C
462 IF (anim_v(13)+h3d_data%N_VECT_CONT2 > 0) THEN
463 fncont(1,i) = fncont(1,i) - fx(ir) * w
464 fncont(2,i) = fncont(2,i) - fy(ir) * w
465 fncont(3,i) = fncont(3,i) - fz(ir) * w
466 fncont(1,irect(ir,l)) = fncont(1,irect(ir,l)) + fx(ir)*w
467 fncont(2,irect(ir,l)) = fncont(2,irect(ir,l)) + fy(ir)*w
468 fncont(3,irect(ir,l)) = fncont(3,irect(ir,l)) + fz(ir)*w
469 ENDIF
470
471 IF(anim_v(27)+h3d_data%N_VECT_PCONT2>0) THEN ! Normal/Tangential forces output
472 fncontp(1,i) = fncontp(1,i) - fn(1) * w
473 fncontp(2,i) = fncontp(2,i) - fn(2) * w
474 fncontp(3,i) = fncontp(3,i) - fn(3) * w
475
476 fncontp(1,irect(ir,l)) = fncontp(1,irect(ir,l)) + fn(1)*w
477 fncontp(2,irect(ir,l)) = fncontp(2,irect(ir,l)) + fn(2)*w
478 fncontp(3,irect(ir,l)) = fncontp(3,irect(ir,l)) + fn(3)*w
479
480 ftcontp(1,i) = ftcontp(1,i) - ft(1) * w
481 ftcontp(2,i) = ftcontp(2,i) - ft(2) * w
482 ftcontp(3,i) = ftcontp(3,i) - ft(3) * w
483
484 ftcontp(1,irect(ir,l)) = ftcontp(1,irect(ir,l)) + ft(1)*w
485 ftcontp(2,irect(ir,l)) = ftcontp(2,irect(ir,l)) + ft(2)*w
486 ftcontp(3,irect(ir,l)) = ftcontp(3,irect(ir,l)) + ft(3)*w
487 ENDIF
488C
489c
490 ENDDO ! IR = 1,NIR
491c--------------------------------------------
492c main node
493c--------------------------------------------
494 IF (w == 1) THEN
495 i0 = i0 + 1
496c
497 jj = 1
498 nm = iadi2(jj,i0)
499 fskyi2(1,nm) = fx(jj)
500 fskyi2(2,nm) = fy(jj)
501 fskyi2(3,nm) = fz(jj)
502 fskyi2(4,nm) = zero
503 fskyi2(5,nm) = stf(jj,k)+stifm(k)*stmax
504 IF (iroddl == 1 .and. in(i) > zero) THEN
505 fskyi2(6,nm) = mrx(jj) + mx(jj)
506 fskyi2(7,nm) = mry(jj) + my(jj)
507 fskyi2(8,nm) = mrz(jj) + mz(jj)
508 fskyi2(10,nm)= str(jj,k)
509 ENDIF
510c
511 jj = 2
512 nm = iadi2(jj,i0)
513 fskyi2(1,nm) = fx(jj)
514 fskyi2(2,nm) = fy(jj)
515 fskyi2(3,nm) = fz(jj)
516 fskyi2(4,nm) = zero
517 fskyi2(5,nm) = stf(jj,k)+stifm(k)*stmax
518 IF (iroddl == 1 .and. in(i) > zero) THEN
519 fskyi2(6,nm) = mrx(jj) + mx(jj)
520 fskyi2(7,nm) = mry(jj) + my(jj)
521 fskyi2(8,nm) = mrz(jj) + mz(jj)
522 fskyi2(10,nm)= str(jj,k)
523 ENDIF
524c
525 jj = 3
526 nm = iadi2(jj,i0)
527 fskyi2(1,nm) = fx(jj)
528 fskyi2(2,nm) = fy(jj)
529 fskyi2(3,nm) = fz(jj)
530 fskyi2(4,nm) = zero
531 fskyi2(5,nm) = stf(jj,k)+stifm(k)*stmax
532 IF (iroddl == 1 .and. in(i) > zero) THEN
533 fskyi2(6,nm) = mrx(jj) + mx(jj)
534 fskyi2(7,nm) = mry(jj) + my(jj)
535 fskyi2(8,nm) = mrz(jj) + mz(jj)
536 fskyi2(10,nm)= str(jj,k)
537 ENDIF
538c
539 jj = 4
540 nm = iadi2(jj,i0)
541 IF (nir == 4) THEN
542 fskyi2(1,nm) = fx(jj)
543 fskyi2(2,nm) = fy(jj)
544 fskyi2(3,nm) = fz(jj)
545 fskyi2(4,nm) = zero
546 fskyi2(5,nm) = stf(jj,k)+stifm(k)*stmax
547 IF (iroddl == 1 .and. in(i) > zero) THEN
548 fskyi2(6,nm) = mrx(jj) + mx(jj)
549 fskyi2(7,nm) = mry(jj) + my(jj)
550 fskyi2(8,nm) = mrz(jj) + mz(jj)
551 fskyi2(10,nm)= str(jj,k)
552 ENDIF
553 ELSE
554 fskyi2(1,nm) = zero
555 fskyi2(2,nm) = zero
556 fskyi2(3,nm) = zero
557 fskyi2(4,nm) = zero
558 fskyi2(5,nm) = zero
559 IF (iroddl == 1 .and. in(i) > zero) THEN
560 fskyi2(6,nm) = zero
561 fskyi2(7,nm) = zero
562 fskyi2(8,nm) = zero
563 fskyi2(9,nm) = zero
564 fskyi2(10,nm)= zero
565 ENDIF
566 ENDIF
567c
568 ENDIF
569
570C------------------------------------------------
571 ELSE ! desactivated secnd node
572 nsvg(k)= -i
573 l = irtl(ii)
574C
575 ix1(k) = irect(1,l)
576 ix2(k) = irect(2,l)
577 ix3(k) = irect(3,l)
578 ix4(k) = irect(4,l)
579 stif(k)= zero
580 vis(ir,k) = zero
581 IF (weight(-i) == 1) THEN ! stokage ZERO pour noeuds delete par idel2
582 i0 = i0 + 1
583 jj = 1
584 nm = iadi2(jj,i0)
585 fskyi2(1,nm) = zero
586 fskyi2(2,nm) = zero
587 fskyi2(3,nm) = zero
588 fskyi2(4,nm) = zero
589 fskyi2(5,nm) = zero
590 IF (iroddl == 1 .and. in(i) > zero) THEN
591 fskyi2(6,nm) = zero
592 fskyi2(7,nm) = zero
593 fskyi2(8,nm) = zero
594 fskyi2(9,nm) = zero
595 fskyi2(10,nm)= zero
596 ENDIF
597 jj = 2
598 nm = iadi2(jj,i0)
599 fskyi2(1,nm) = zero
600 fskyi2(2,nm) = zero
601 fskyi2(3,nm) = zero
602 fskyi2(4,nm) = zero
603 fskyi2(5,nm) = zero
604 IF (iroddl == 1 .and. in(i) > zero) THEN
605 fskyi2(6,nm) = zero
606 fskyi2(7,nm) = zero
607 fskyi2(8,nm) = zero
608 fskyi2(9,nm) = zero
609 fskyi2(10,nm)= zero
610 ENDIF
611 jj = 3
612 nm = iadi2(jj,i0)
613 fskyi2(1,nm) = zero
614 fskyi2(2,nm) = zero
615 fskyi2(3,nm) = zero
616 fskyi2(4,nm) = zero
617 fskyi2(5,nm) = zero
618 IF (iroddl == 1 .and. in(i) > zero) THEN
619 fskyi2(6,nm) = zero
620 fskyi2(7,nm) = zero
621 fskyi2(8,nm) = zero
622 fskyi2(9,nm) = zero
623 fskyi2(10,nm)= zero
624 ENDIF
625 jj = 4
626 nm = iadi2(jj,i0)
627 fskyi2(1,nm) = zero
628 fskyi2(2,nm) = zero
629 fskyi2(3,nm) = zero
630 fskyi2(4,nm) = zero
631 fskyi2(5,nm) = zero
632 IF (iroddl == 1 .and. in(i) > zero) THEN
633 fskyi2(6,nm) = zero
634 fskyi2(7,nm) = zero
635 fskyi2(8,nm) = zero
636 fskyi2(9,nm) = zero
637 fskyi2(10,nm)= zero
638 ENDIF
639 ENDIF
640 ENDIF ! I > 0
641C---
642 ENDDO ! K=1,LLT
643C------------------------------------------------
644 IF (idtmins==2 .or. idtmins_int/=0) THEN
645 dti = dt2t
646 CALL i2sms26(llt ,ix1 ,ix2 ,ix3 ,ix4 ,
647 . nsvg ,stf ,noint,dmint2(1,kk),
648 . nodnx_sms,vis,dti )
649 IF (dti < dt2t) THEN
650 dt2t = dti
651 neltst = noint
652 ityptst = 10
653 ENDIF
654 END IF
655c
656 ENDDO ! KK=1,NSN,MVSIZ
657C----------
658#include "lockon.inc"
659 econt = econt + econtt ! Elastic energy
660 econtd = econtd + econvt ! Damping Elastic energy
661 fsav(26) = fsav(26) + econtt
662 fsav(28) = fsav(28) + econvt
663#include "lockoff.inc"
664C-----------
665 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i2loceq
subroutine i2loceq(nir, rs, rx, ry, rz, fmx, fmy, fmz, h, stifm)
Definition i2loceq.F:40
i2pen_rot26
subroutine i2pen_rot26(tt, dt1, dwdu, wlx, wly, wlz, rx, ry, rz, va, vb, vc, vd)
Definition i2pen_rot.F:149
i2rep
subroutine i2rep(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir)
Definition i2rep.F:48
i2sms26
subroutine i2sms26(jlt, ix1, ix2, ix3, ix4, nsvg, stif, noint, dmint2, nodnx_sms, vis, dti)
Definition i2sms26.F:34
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308