OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for26p.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i2for26p ../engine/source/interfaces/interf/i2for26p.F
25!||--- called by ------------------------------------------------------
26!|| intti2f ../engine/source/interfaces/interf/intti2f.F
27!||--- calls -----------------------------------------------------
28!|| i2loceq ../common_source/interf/i2loceq.F
29!|| i2pen_rot26 ../common_source/interf/i2pen_rot.F
30!|| i2rep ../common_source/interf/i2rep.F
31!|| i2sms26 ../engine/source/interfaces/interf/i2sms26.F
32!||--- uses -----------------------------------------------------
33!|| h3d_mod ../engine/share/modules/h3d_mod.F
34!||====================================================================
35 SUBROUTINE i2for26p(X ,V ,VR ,A ,AR ,
36 . MS ,STIFN ,STIFR ,WEIGHT ,IRECT ,
37 . NSV ,IRTL ,DR ,DL ,FINI ,
38 . FSAV ,FNCONT ,NSN ,I0 ,I2SIZE ,
39 . IADI2 ,FSKYI2 ,STFN ,STFR ,VISC ,
40 . NOINT ,NODNX_SMS,DMINT2 ,IN ,DT2T ,
41 . NELTST ,ITYPTST ,H3D_DATA,FNCONTP ,FTCONTP )
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
666 END SUBROUTINE i2for26p
i2for26p
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)
Definition i2for26p.F:42
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