OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for27p_pen.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 i2for27p_pen (x, v, vr, a, ar, ms, in, stifn, stifr, weight, nsv, irtl, crst, skew, dx, dr, fini, fsav, fncont, nsn, i0, i2size, iadi2, fskyi2, stfn, stfr, visc, penflag, irotb, noint, nodnx_sms, dmint2, dt2t, neltst, ityptst, irect, indxp, iadx, h3d_data, msegtyp2, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2for27p_pen()

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

Definition at line 37 of file i2for27p_pen.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE h3d_mod
52 USE outmax_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57#include "comlock.inc"
58C-----------------------------------------------
59C G l o b a l P a r a m e t e r s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER NSN, I0,I2SIZE,PENFLAG,IROTB, NOINT,NELTST,ITYPTST
66 INTEGER IRECT(4,*),NSV(*),IRTL(*),WEIGHT(*),IADI2(4,*),
67 . NODNX_SMS(*),IADX(*),INDXP(*),MSEGTYP2(*)
68C REAL
69 my_real
70 . visc,dt2t
71 my_real
72 . x(3,*),vr(3,*),v(3,*),a(3,*),ar(3,*),ms(*),crst(2,*),
73 . skew(9,*),dx(3,*),dr(3,*),fini(6,*),fsav(*),fncont(3,*),
74 . stifn(*),stifr(*),stfn(*),stfr(*),fskyi2(i2size,*),
75 . dmint2(4,*),in(*),fncontp(3,*) ,ftcontp(3,*)
76 TYPE (H3D_DATABASE) :: H3D_DATA
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com01_c.inc"
81#include "com06_c.inc"
82#include "com08_c.inc"
83#include "scr11_c.inc"
84#include "scr14_c.inc"
85#include "sms_c.inc"
86#include "task_c.inc"
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER NIR,I,J,II,JJ,L,W,NN,KK,K,LLT,
91 . IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
92 . NSVG(MVSIZ),I0BASE
93C REAL
94 my_real
95 . s,t,sp,sm,tp,tm,econtt,econvt,e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,
96 . fnorm,flx,fly,flz,fs(3),xsm,ysm,zsm,xm,ym,zm,
97 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,x0,y0,z0,xs,ys,zs,stifm(mvsiz),
98 . vx1,vx2,vx3,vx4,vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4,dlx,dly,dlz,
99 . vx0,vy0,vz0,vsx,vsy,vsz,vmx,vmy,vmz,vx,vy,vz,dtinv,stf,
100 . fxv,fyv,fzv,drx,dry,drz,stbrk,dti,mharm,dkm,det,b1,b2,b3,c1,c2,c3,
101 . a1,a2,a3,mttx,mtty,mttz,derx,dery,derz,dxt,hl(4)
102 my_real
103 . h(4,mvsiz),fn(3),ft(3),fx(4),fy(4),fz(4),fmx(4),fmy(4),fmz(4),
104 . rx(4),ry(4),rz(4),rm(3),rs(3),v0(3),vs(3),vm(3),
105 . stif(mvsiz), vis(mvsiz), va(3),vb(3),vc(3),vd(3)
106 my_real
107 . vrm(3),vrs(3),
108 . vrx0,vrx1,vrx2,vrx3,vrx4,vry0,vry1,vry2,vry3,vry4,vrz0,vrz1,vrz2,vrz3,vrz4,
109 . vrsx,vrsy,vrsz,vrx,vry,vrz,mlx,mly,mlz,mx(4),my(4),mz(4),mrx,mry,mrz,ftx,fty,ftz,
110 . mgx,mgy,mgz,msx,msy,msz,mvx,mvy,mvz,str,visr(mvsiz),dki,inharm,vrmx,vrmy,vrmz,
111 . len2,fac_triang
112 my_real
113 . irot
114C=======================================================================
115 i7kglo = 1
116 econtt = zero
117 econvt = zero
118 i0base = i0
119C
120 nsvg(1:mvsiz) = 0
121 vrm(1:3)=zero
122 vrs(1:3)=zero
123C----------------
124 DO kk=1,nsn,mvsiz
125C
126 llt=min(nsn-kk+1,mvsiz)
127 DO k=1,llt
128C
129 ii = indxp(kk+k-1)
130 IF (ii == 0) cycle
131 i = nsv(ii)
132C
133 IF (i > 0) THEN
134 nsvg(k) = i
135 w = weight(i)
136 s = crst(1,ii)
137 t = crst(2,ii)
138 l = irtl(ii)
139C
140 ix1(k) = irect(1,l)
141 ix2(k) = irect(2,l)
142 ix3(k) = irect(3,l)
143 ix4(k) = irect(4,l)
144C
145 irot = zero
146 IF(iroddl > 0) THEN
147 IF ((msegtyp2(l)==1).AND.(in(i)>em20)) THEN
148C-- shell main segment --
149 irot = one
150 ENDIF
151 ENDIF
152
153 IF (ix3(k) == ix4(k)) THEN
154C-- Shape functions of triangles
155 nir = 3
156 h(1,k) = s
157 h(2,k) = t
158 h(3,k) = one-s-t
159 h(4,k) = zero
160 ELSE
161C-- Shape functions of quadrangles
162 nir = 4
163 sp = one + s
164 sm = one - s
165 tp = fourth*(one + t)
166 tm = fourth*(one - t)
167C
168 h(1,k)=tm*sm
169 h(2,k)=tm*sp
170 h(3,k)=tp*sp
171 h(4,k)=tp*sm
172 ENDIF
173C
174C------------------------------------------------
175C rep local facette main
176C------------------------------------------------
177 x1 = x(1,ix1(k))
178 y1 = x(2,ix1(k))
179 z1 = x(3,ix1(k))
180 x2 = x(1,ix2(k))
181 y2 = x(2,ix2(k))
182 z2 = x(3,ix2(k))
183 x3 = x(1,ix3(k))
184 y3 = x(2,ix3(k))
185 z3 = x(3,ix3(k))
186 x4 = x(1,ix4(k))
187 y4 = x(2,ix4(k))
188 z4 = x(3,ix4(k))
189 xs = x(1,i)
190 ys = x(2,i)
191 zs = x(3,i)
192 vsx = v(1,i)
193 vsy = v(2,i)
194 vsz = v(3,i)
195 vx1 = v(1,ix1(k))
196 vy1 = v(2,ix1(k))
197 vz1 = v(3,ix1(k))
198 vx2 = v(1,ix2(k))
199 vy2 = v(2,ix2(k))
200 vz2 = v(3,ix2(k))
201 vx3 = v(1,ix3(k))
202 vy3 = v(2,ix3(k))
203 vz3 = v(3,ix3(k))
204 vx4 = v(1,ix4(k))
205 vy4 = v(2,ix4(k))
206 vz4 = v(3,ix4(k))
207 IF (irot > zero) THEN
208 vrsx = vr(1,i)
209 vrsy = vr(2,i)
210 vrsz = vr(3,i)
211 vrx1 = vr(1,ix1(k))
212 vry1 = vr(2,ix1(k))
213 vrz1 = vr(3,ix1(k))
214 vrx2 = vr(1,ix2(k))
215 vry2 = vr(2,ix2(k))
216 vrz2 = vr(3,ix2(k))
217 vrx3 = vr(1,ix3(k))
218 vry3 = vr(2,ix3(k))
219 vrz3 = vr(3,ix3(k))
220 vrx4 = vr(1,ix4(k))
221 vry4 = vr(2,ix4(k))
222 vrz4 = vr(3,ix4(k))
223 ENDIF
224C---------------------
225 CALL i2rep(x1 ,x2 ,x3 ,x4 ,
226 . y1 ,y2 ,y3 ,y4 ,
227 . z1 ,z2 ,z3 ,z4 ,
228 . e1x ,e1y ,e1z ,
229 . e2x ,e2y ,e2z ,
230 . e3x ,e3y ,e3z ,nir )
231C------------------------------------------------
232 IF (nir == 4) THEN
233 fac_triang = one
234C
235 xm = x1*h(1,k) + x2*h(2,k) + x3*h(3,k) + x4*h(4,k)
236 ym = y1*h(1,k) + y2*h(2,k) + y3*h(3,k) + y4*h(4,k)
237 zm = z1*h(1,k) + z2*h(2,k) + z3*h(3,k) + z4*h(4,k)
238 x0 = (x1 + x2 + x3 + x4)/nir
239 y0 = (y1 + y2 + y3 + y4)/nir
240 z0 = (z1 + z2 + z3 + z4)/nir
241
242 xm = xm - x0
243 ym = ym - y0
244 zm = zm - z0
245 xs = xs - x0
246 ys = ys - y0
247 zs = zs - z0
248 xsm = xs - xm
249 ysm = ys - ym
250 zsm = zs - zm
251c
252 vx0 = (vx1 + vx2 + vx3 + vx4)/nir
253 vy0 = (vy1 + vy2 + vy3 + vy4)/nir
254 vz0 = (vz1 + vz2 + vz3 + vz4)/nir
255 vmx = vx1*h(1,k) + vx2*h(2,k) + vx3*h(3,k) + vx4*h(4,k) - vx0
256 vmy = vy1*h(1,k) + vy2*h(2,k) + vy3*h(3,k) + vy4*h(4,k) - vy0
257 vmz = vz1*h(1,k) + vz2*h(2,k) + vz3*h(3,k) + vz4*h(4,k) - vz0
258C
259 ELSE
260 fac_triang = zero
261C
262 x0 = (x1 + x2 + x3)/nir
263 y0 = (y1 + y2 + y3)/nir
264 z0 = (z1 + z2 + z3)/nir
265
266 xm = x1*h(1,k) + x2*h(2,k) + x3*h(3,k)
267 ym = y1*h(1,k) + y2*h(2,k) + y3*h(3,k)
268 zm = z1*h(1,k) + z2*h(2,k) + z3*h(3,k)
269
270 xm = xm - x0
271 ym = ym - y0
272 zm = zm - z0
273 xs = xs - x0
274 ys = ys - y0
275 zs = zs - z0
276 xsm = xs - xm
277 ysm = ys - ym
278 zsm = zs - zm
279
280 vx0 = (vx1 + vx2 + vx3)/nir
281 vy0 = (vy1 + vy2 + vy3)/nir
282 vz0 = (vz1 + vz2 + vz3)/nir
283 vmx = vx1*h(1,k) + vx2*h(2,k) + vx3*h(3,k) - vx0
284 vmy = vy1*h(1,k) + vy2*h(2,k) + vy3*h(3,k) - vy0
285 vmz = vz1*h(1,k) + vz2*h(2,k) + vz3*h(3,k) - vz0
286 ENDIF
287 x1 = x1 - x0
288 y1 = y1 - y0
289 z1 = z1 - z0
290 x2 = x2 - x0
291 y2 = y2 - y0
292 z2 = z2 - z0
293 x3 = x3 - x0
294 y3 = y3 - y0
295 z3 = z3 - z0
296 x4 = x4 - x0
297 y4 = y4 - y0
298 z4 = z4 - z0
299 vsx = vsx - vx0
300 vsy = vsy - vy0
301 vsz = vsz - vz0
302C
303c global -> local
304c
305 rs(1) = xs*e1x + ys*e1y + zs*e1z
306 rs(2) = xs*e2x + ys*e2y + zs*e2z
307 rs(3) = xs*e3x + ys*e3y + zs*e3z
308 rm(1) = xm*e1x + ym*e1y + zm*e1z
309 rm(2) = xm*e2x + ym*e2y + zm*e2z
310 rm(3) = xm*e3x + ym*e3y + zm*e3z
311c
312 rx(1) = e1x*x1 + e1y*y1 + e1z*z1
313 ry(1) = e2x*x1 + e2y*y1 + e2z*z1
314 rz(1) = e3x*x1 + e3y*y1 + e3z*z1
315 rx(2) = e1x*x2 + e1y*y2 + e1z*z2
316 ry(2) = e2x*x2 + e2y*y2 + e2z*z2
317 rz(2) = e3x*x2 + e3y*y2 + e3z*z2
318 rx(3) = e1x*x3 + e1y*y3 + e1z*z3
319 ry(3) = e2x*x3 + e2y*y3 + e2z*z3
320 rz(3) = e3x*x3 + e3y*y3 + e3z*z3
321 rx(4) = e1x*x4 + e1y*y4 + e1z*z4
322 ry(4) = e2x*x4 + e2y*y4 + e2z*z4
323 rz(4) = e3x*x4 + e3y*y4 + e3z*z4
324C
325 IF (nir==3) THEN
326 rx(4)=zero
327 ry(4)=zero
328 rz(4)=zero
329 END IF
330C
331 vs(1) = vsx*e1x + vsy*e1y + vsz*e1z
332 vs(2) = vsx*e2x + vsy*e2y + vsz*e2z
333 vs(3) = vsx*e3x + vsy*e3y + vsz*e3z
334 IF (irot > zero) THEN
335 vrs(1) = vrsx*e1x + vrsy*e1y + vrsz*e1z
336 vrs(2) = vrsx*e2x + vrsy*e2y + vrsz*e2z
337 vrs(3) = vrsx*e3x + vrsy*e3y + vrsz*e3z
338 vrmx = vrx1*h(1,k) + vrx2*h(2,k) + vrx3*h(3,k) + vrx4*h(4,k)
339 vrmy = vry1*h(1,k) + vry2*h(2,k) + vry3*h(3,k) + vry4*h(4,k)
340 vrmz = vrz1*h(1,k) + vrz2*h(2,k) + vrz3*h(3,k) + vrz4*h(4,k)
341 vrm(1) = vrmx*e1x + vrmy*e1y + vrmz*e1z
342 vrm(2) = vrmx*e2x + vrmy*e2y + vrmz*e2z
343 vrm(3) = vrmx*e3x + vrmy*e3y + vrmz*e3z
344 ENDIF
345
346 vm(1) = vmx*e1x + vmy*e1y + vmz*e1z
347 vm(2) = vmx*e2x + vmy*e2y + vmz*e2z
348 vm(3) = vmx*e3x + vmy*e3y + vmz*e3z
349
350 va(1) = vx1*e1x + vy1*e1y + vz1*e1z
351 va(2) = vx1*e2x + vy1*e2y + vz1*e2z
352 va(3) = vx1*e3x + vy1*e3y + vz1*e3z
353
354 vb(1) = vx2*e1x + vy2*e1y + vz2*e1z
355 vb(2) = vx2*e2x + vy2*e2y + vz2*e2z
356 vb(3) = vx2*e3x + vy2*e3y + vz2*e3z
357
358 vc(1) = vx3*e1x + vy3*e1y + vz3*e1z
359 vc(2) = vx3*e2x + vy3*e2y + vz3*e2z
360 vc(3) = vx3*e3x + vy3*e3y + vz3*e3z
361
362 vd(1) = vx4*e1x + vy4*e1y + vz4*e1z
363 vd(2) = vx4*e2x + vy4*e2y + vz4*e2z
364 vd(3) = vx4*e3x + vy4*e3y + vz4*e3z
365C
366C--------- Local displacement
367 IF (tt == zero) THEN
368 dx(1,ii) = zero
369 dx(2,ii) = zero
370 dx(3,ii) = zero
371 fini(1,ii) = zero
372 fini(2,ii) = zero
373 fini(3,ii) = zero
374 dr(1,ii) = zero
375 dr(2,ii) = zero
376 dr(3,ii) = zero
377 fini(4,ii) = zero
378 fini(5,ii) = zero
379 fini(6,ii) = zero
380 ENDIF
381C
382 vx = vs(1) - vm(1)
383 vy = vs(2) - vm(2)
384 vz = vs(3) - vm(3)
385
386C--------- Vi = Vi -VR ^ MS
387 CALL i2pen_rot27(
388 . skew(1,ii) ,tt ,dt1 ,stbrk,
389 . rs ,rm ,vx ,vy ,vz ,
390 . rx ,ry ,rz ,va ,vb ,
391 . vc ,vd ,vrm ,vrs ,det ,
392 . b1 ,b2 ,b3 ,c1 ,c2 ,
393 . c3 ,irot)
394C
395 vrx = vrs(1) - vrm(1)
396 vry = vrs(2) - vrm(2)
397 vrz = vrs(3) - vrm(3)
398
399C------------- vers increm en vitesses
400 dlx = vx*dt1
401 dly = vy*dt1
402 dlz = vz*dt1
403 drx = vrx*dt1
404 dry = vry*dt1
405 drz = vrz*dt1
406C------------- DX == deplacement relatif
407 dx(1,ii) = dx(1,ii) + dlx
408 dx(2,ii) = dx(2,ii) + dly
409 dx(3,ii) = dx(3,ii) + dlz
410 dr(1,ii) = dr(1,ii) + drx
411 dr(2,ii) = dr(2,ii) + dry
412 dr(3,ii) = dr(3,ii) + drz
413C
414C------------------------------------------------
415C Calcul de la force
416C------------------------------------------------
417C
418 flx = dx(1,ii) * stfn(ii)
419 fly = dx(2,ii) * stfn(ii)
420 flz = dx(3,ii) * stfn(ii)
421C
422 IF(ms(i)==zero.OR.ms(ix1(k))==zero.OR.
423 . ms(ix2(k))==zero.OR.
424 . ms(ix3(k))==zero.OR.
425 . ms(ix4(k))==zero)THEN
426 mharm = zero
427 ELSEIF(nir==4)THEN
428 mharm = one/ms(i) +
429 . one/ms(ix1(k)) + one/ms(ix2(k)) + one/ms(ix3(k)) + one/ms(ix4(k))
430 mharm = one/mharm
431 ELSE
432 mharm = one/ms(i) +
433 . one/ms(ix1(k)) + one/ms(ix2(k)) + one/ms(ix3(k))
434 mharm = one/mharm
435 END IF
436 dkm = two*stfn(ii)*mharm
437 vis(k) = visc*sqrt(dkm)
438C
439 fxv = vis(k) * vx
440 fyv = vis(k) * vy
441 fzv = vis(k) * vz
442c
443 dxt = dx(1,ii)**2 + dx(2,ii)**2 + dx(3,ii)**2
444 econtt = econtt + half*stfn(ii)*dxt*w
445
446 econvt = econvt + (fxv*vx + fyv*vy + fzv*vz)*dt1*w
447c
448 flx = flx + fxv
449 fly = fly + fyv
450 flz = flz + fzv
451C
452 DO j=1,4
453 fmx(j) = h(j,k)*flx
454 fmy(j) = h(j,k)*fly
455 fmz(j) = h(j,k)*flz
456 ENDDO
457C
458 ftx = e1x*flx + e2x*fly + e3x*flz
459 fty = e1y*flx + e2y*fly + e3y*flz
460 ftz = e1z*flx + e2z*fly + e3z*flz
461C
462 stf = stfn(ii)*(visc + sqrt(visc**2 + (one+stbrk)))**2
463 stifm(k)=zero
464C
465C------------------------------------------------
466C Calcul du Moment
467C------------------------------------------------
468C
469 IF (irot > zero) THEN
470C
471C-- Secnd node shell of spring
472C
473 IF(in(i)==zero.OR.in(ix1(k))==zero.OR.
474 . in(ix2(k))==zero.OR.
475 . in(ix3(k))==zero.OR.
476 . in(ix4(k))==zero)THEN
477 inharm = zero
478 ELSEIF(nir==4)THEN
479 inharm = one/in(i) +
480 . one/in(ix1(k)) + one/in(ix2(k)) + one/in(ix3(k)) + one/in(ix4(k))
481 inharm = one/inharm
482 ELSE
483 inharm = one/in(i) +
484 . one/in(ix1(k)) + one/in(ix2(k)) + one/in(ix3(k))
485 inharm = one/inharm
486 END IF
487C
488 dki = two*stfr(ii)*inharm
489 visr(k) = visc*sqrt(dki)
490C
491 mlx = dr(1,ii) * stfr(ii)
492 mly = dr(2,ii) * stfr(ii)
493 mlz = dr(3,ii) * stfr(ii)
494C
495 mvx = visr(k) * vrx
496 mvy = visr(k) * vry
497 mvz = visr(k) * vrz
498C
499 dxt = dr(1,ii)**2 + dr(2,ii)**2 + dr(3,ii)**2
500 econtt = econtt + half*stfr(ii)*dxt
501
502 econvt = econvt + (mvx*vrx
503 . + mvy*vry
504 . + mvz*vrz)*dt1
505C
506 mlx = mlx + mvx
507 mly = mly + mvy
508 mlz = mlz + mvz
509C
510 mgx = e1x*mlx + e2x*mly + e3x*mlz
511 mgy = e1y*mlx + e2y*mly + e3y*mlz
512 mgz = e1z*mlx + e2z*mly + e3z*mlz
513C
514 mrx = half*(ysm*ftz - zsm*fty)
515 mry = half*(zsm*ftx - xsm*ftz)
516 mrz = half*(xsm*fty - ysm*ftx)
517C
518 DO j=1,4
519 mx(j) = h(j,k)*(mgx+mrx)
520 my(j) = h(j,k)*(mgy+mry)
521 mz(j) = h(j,k)*(mgz+mrz)
522 ENDDO
523C
524 len2 = xsm**2+ysm**2+zsm**2
525 str = (stfr(ii)+stfn(ii)*len2)*(visc + sqrt(visc**2 + one))**2
526C
527 ELSE
528C
529C-- Secnd node of solids
530C
531 mx(1:4) = zero
532 my(1:4) = zero
533 mz(1:4) = zero
534 str = zero
535C
536c update main forces (moment balance)
537 CALL i2loceq( nir ,rs ,rx ,ry ,rz ,
538 . fmx ,fmy ,fmz ,h(1,k) ,stifm(k))
539C
540 ENDIF
541C
542 DO j=1,4
543 fx(j) = e1x*fmx(j) + e2x*fmy(j) + e3x*fmz(j)
544 fy(j) = e1y*fmx(j) + e2y*fmy(j) + e3y*fmz(j)
545 fz(j) = e1z*fmx(j) + e2z*fmy(j) + e3z*fmz(j)
546 ENDDO
547C
548 fs(1) = zero
549 fs(2) = zero
550 fs(3) = zero
551 DO j=1,nir
552 fs(1) = fs(1) + fx(j)
553 fs(2) = fs(2) + fy(j)
554 fs(3) = fs(3) + fz(j)
555 ENDDO
556C
557C----------------------------------------------------
558C Secnd forces/moments -> global coordinates
559C----------------------------------------------------
560C
561 a(1,i) = a(1,i) - fs(1)
562 a(2,i) = a(2,i) - fs(2)
563 a(3,i) = a(3,i) - fs(3)
564 stifn(i) = stifn(i) + stf
565C
566C for SMS ::
567 stif(k) = (one+stbrk)*stfn(ii)
568C
569 IF (iroddl == 1) THEN
570 IF (irot > zero) THEN
571 ar(1,i) = ar(1,i) - mgx + mrx
572 ar(2,i) = ar(2,i) - mgy + mry
573 ar(3,i) = ar(3,i) - mgz + mrz
574 stifr(i) = stifr(i) + str
575 ENDIF
576 ENDIF
577C
578C----------------------------------------------------
579C Main forces/moments
580C----------------------------------------------------
581C
582 IF (w == 1) THEN
583 i0 = i0base + iadx(ii)
584 jj = 1
585 nn = iadi2(jj,i0)
586c
587 fskyi2(1,nn) = fx(jj)
588 fskyi2(2,nn) = fy(jj)
589 fskyi2(3,nn) = fz(jj)
590 fskyi2(4,nn) = zero
591 fskyi2(5,nn) = abs(stf*h(jj,k))+stifm(k)*stf
592 IF (iroddl == 1) THEN
593 fskyi2(6,nn) = mx(jj)
594 fskyi2(7,nn) = my(jj)
595 fskyi2(8,nn) = mz(jj)
596 fskyi2(9,nn) = zero
597 fskyi2(10,nn)= abs(str*h(jj,k))
598 ENDIF
599c
600 jj = 2
601 nn = iadi2(jj,i0)
602 fskyi2(1,nn) = fx(jj)
603 fskyi2(2,nn) = fy(jj)
604 fskyi2(3,nn) = fz(jj)
605 fskyi2(4,nn) = zero
606 fskyi2(5,nn) = abs(stf*h(jj,k))+stifm(k)*stf
607 IF (iroddl == 1) THEN
608 fskyi2(6,nn) = mx(jj)
609 fskyi2(7,nn) = my(jj)
610 fskyi2(8,nn) = mz(jj)
611 fskyi2(9,nn) = zero
612 fskyi2(10,nn)= abs(str*h(jj,k))
613 ENDIF
614c
615 jj = 3
616 nn = iadi2(jj,i0)
617 fskyi2(1,nn) = fx(jj)
618 fskyi2(2,nn) = fy(jj)
619 fskyi2(3,nn) = fz(jj)
620 fskyi2(4,nn) = zero
621 fskyi2(5,nn) = abs(stf*h(jj,k))+stifm(k)*stf
622 IF (iroddl == 1) THEN
623 fskyi2(6,nn) = mx(jj)
624 fskyi2(7,nn) = my(jj)
625 fskyi2(8,nn) = mz(jj)
626 fskyi2(9,nn) = zero
627 fskyi2(10,nn)= abs(str*h(jj,k))
628 ENDIF
629c
630 jj = 4
631 nn = iadi2(jj,i0)
632 fskyi2(1,nn) = fx(jj)
633 fskyi2(2,nn) = fy(jj)
634 fskyi2(3,nn) = fz(jj)
635 fskyi2(4,nn) = zero
636 fskyi2(5,nn) = abs(stf*h(jj,k))+stifm(k)*stf*fac_triang
637 IF (iroddl == 1) THEN
638 fskyi2(6,nn) = mx(jj)
639 fskyi2(7,nn) = my(jj)
640 fskyi2(8,nn) = mz(jj)
641 fskyi2(9,nn) = zero
642 fskyi2(10,nn)= abs(str*h(jj,k))
643 ENDIF
644 ENDIF
645C
646C------------------------------------------------
647 fini(1,ii) = flx
648 fini(2,ii) = fly
649 fini(3,ii) = flz
650 IF (irot > zero) THEN
651 fini(4,ii) = mlx
652 fini(5,ii) = mly
653 fini(6,ii) = mlz
654 ENDIF
655C------------------------------------------------
656C composantes N/T de la forces nodale -> output
657C------------------------------------------------
658 hl(1:4) = h(1:4,k)
659 CALL i2forces(x ,fs ,fx ,fy ,fz ,
660 . irect(1,l),nir ,fsav ,fncont ,fncontp,
661 . ftcontp ,weight ,h3d_data,i ,hl)
662C
663 IF ((h3d_data%N_VECT_CONT2M > 0).AND.(irot > 0)) THEN ! Moment output in h3d
664 mcont2(1,i) = (-mgx + mrx)*w
665 mcont2(2,i) = (-mgy + mry)*w
666 mcont2(3,i) = (-mgz + mrz)*w
667 mcont2(1,ix1(k)) = mcont2(1,ix1(k)) + mx(1)*h(1,k)*w
668 mcont2(2,ix1(k)) = mcont2(2,ix1(k)) + my(1)*h(1,k)*w
669 mcont2(3,ix1(k)) = mcont2(3,ix1(k)) + mz(1)*h(1,k)*w
670 mcont2(1,ix2(k)) = mcont2(1,ix2(k)) + mx(2)*h(2,k)*w
671 mcont2(2,ix2(k)) = mcont2(2,ix2(k)) + my(2)*h(2,k)*w
672 mcont2(3,ix2(k)) = mcont2(3,ix2(k)) + mz(2)*h(2,k)*w
673 mcont2(1,ix3(k)) = mcont2(1,ix3(k)) + mx(3)*h(3,k)*w
674 mcont2(2,ix3(k)) = mcont2(2,ix3(k)) + my(3)*h(3,k)*w
675 mcont2(3,ix3(k)) = mcont2(3,ix3(k)) + mz(3)*h(3,k)*w
676 mcont2(1,ix4(k)) = mcont2(1,ix4(k)) + mx(4)*h(4,k)*w
677 mcont2(2,ix4(k)) = mcont2(2,ix4(k)) + my(4)*h(4,k)*w
678 mcont2(3,ix4(k)) = mcont2(3,ix4(k)) + mz(4)*h(4,k)*w
679 ENDIF
680C----------
681 ELSE ! desactivated secnd node
682 nsvg(k)= -i
683 l = irtl(ii)
684C
685 ix1(k) = irect(1,l)
686 ix2(k) = irect(2,l)
687 ix3(k) = irect(3,l)
688 ix4(k) = irect(4,l)
689 stif(k)= zero
690 vis(k) = zero
691 IF (weight(-i) == 1) THEN ! stokage ZERO pour noeuds delete par idel2
692 i0 = i0base + iadx(ii)
693 jj = 1
694 nn = iadi2(jj,i0)
695 fskyi2(1,nn) = zero
696 fskyi2(2,nn) = zero
697 fskyi2(3,nn) = zero
698 fskyi2(4,nn) = zero
699 fskyi2(5,nn) = zero
700 IF (iroddl == 1) THEN
701 fskyi2(6,nn) = zero
702 fskyi2(7,nn) = zero
703 fskyi2(8,nn) = zero
704 fskyi2(9,nn) = zero
705 fskyi2(10,nn)= zero
706 ENDIF
707 jj = 2
708 nn = iadi2(jj,i0)
709 fskyi2(1,nn) = zero
710 fskyi2(2,nn) = zero
711 fskyi2(3,nn) = zero
712 fskyi2(4,nn) = zero
713 fskyi2(5,nn) = zero
714 IF (iroddl == 1) THEN
715 fskyi2(6,nn) = zero
716 fskyi2(7,nn) = zero
717 fskyi2(8,nn) = zero
718 fskyi2(9,nn) = zero
719 fskyi2(10,nn)= zero
720 ENDIF
721 jj = 3
722 nn = iadi2(jj,i0)
723 fskyi2(1,nn) = zero
724 fskyi2(2,nn) = zero
725 fskyi2(3,nn) = zero
726 fskyi2(4,nn) = zero
727 fskyi2(5,nn) = zero
728 IF (iroddl == 1) THEN
729 fskyi2(6,nn) = zero
730 fskyi2(7,nn) = zero
731 fskyi2(8,nn) = zero
732 fskyi2(9,nn) = zero
733 fskyi2(10,nn)= zero
734 ENDIF
735 jj = 4
736 nn = iadi2(jj,i0)
737 fskyi2(1,nn) = zero
738 fskyi2(2,nn) = zero
739 fskyi2(3,nn) = zero
740 fskyi2(4,nn) = zero
741 fskyi2(5,nn) = zero
742 IF (iroddl == 1) THEN
743 fskyi2(6,nn) = zero
744 fskyi2(7,nn) = zero
745 fskyi2(8,nn) = zero
746 fskyi2(9,nn) = zero
747 fskyi2(10,nn)= zero
748 ENDIF
749 ENDIF
750 ENDIF
751 ENDDO
752c
753 IF(idtmins==2.OR.idtmins_int/=0)THEN
754 dti=dt2t
755 CALL i2sms27(llt ,ix1 ,ix2 ,ix3 ,ix4 ,
756 2 nsvg ,h ,stif ,noint ,
757 3 dmint2(1,kk),nodnx_sms ,vis ,
758 4 stifm ,dti)
759 IF(dti<dt2t)THEN
760 dt2t = dti
761 neltst = noint
762 ityptst = 10
763 ENDIF
764 END IF
765 ENDDO
766C----------
767#include "lockon.inc"
768 econt = econt + econtt ! Elastic Energy
769 econtd = econtd + econvt ! Damping Energy
770 fsav(26) = fsav(26) + econtt
771 fsav(28) = fsav(28) + econvt
772#include "lockoff.inc"
773C-----------
774 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i2forces
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
i2loceq
subroutine i2loceq(nir, rs, rx, ry, rz, fmx, fmy, fmz, h, stifm)
Definition i2loceq.F:40
i2pen_rot27
subroutine i2pen_rot27(skew, tt, dt1, stif, rs, rm, vx, vy, vz, rx, ry, rz, va, vb, vc, vd, vrm, vrs, det, b1, b2, b3, c1, c2, c3, in_secnd)
Definition i2pen_rot.F:270
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
i2sms27
subroutine i2sms27(jlt, ix1, ix2, ix3, ix4, nsvg, h, stif, noint, dmint2, nodnx_sms, vis, stifm, dti)
Definition i2sms27.F:34
min
#define min(a, b)
Definition macros.h:20
h3d_mod
Definition h3d_mod.F:308
outmax_mod
Definition outmax_mod.F:52