OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for27p_pen.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!|| i2for27p_pen ../engine/source/interfaces/interf/i2for27p_pen.F
25!||--- called by ------------------------------------------------------
26!|| i2for27p ../engine/source/interfaces/interf/i2for27p.F
27!||--- calls -----------------------------------------------------
28!|| i2forces ../engine/source/interfaces/interf/i2forces.F
29!|| i2loceq ../common_source/interf/i2loceq.F
30!|| i2pen_rot27 ../common_source/interf/i2pen_rot.F
31!|| i2rep ../common_source/interf/i2rep.F
32!|| i2sms27 ../engine/source/interfaces/interf/i2sms27.F
33!||--- uses -----------------------------------------------------
34!|| h3d_mod ../engine/share/modules/h3d_mod.F
35!|| outmax_mod ../common_source/modules/outmax_mod.F
36!||====================================================================
37 SUBROUTINE i2for27p_pen(
38 . X ,V ,VR ,A ,AR ,
39 . MS ,IN ,STIFN ,STIFR ,WEIGHT ,
40 . NSV ,IRTL ,CRST ,SKEW ,DX ,
41 . DR ,FINI ,FSAV ,FNCONT ,NSN ,
42 . I0 ,I2SIZE ,IADI2 ,FSKYI2 ,STFN ,
43 . STFR ,VISC ,PENFLAG ,IROTB ,NOINT ,
44 . NODNX_SMS,DMINT2 ,DT2T ,NELTST ,ITYPTST ,
45 . IRECT ,INDXP ,IADX ,
46 . H3D_DATA,MSEGTYP2,
47 . FNCONTP ,FTCONTP)
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
775 END SUBROUTINE i2for27p_pen
i2for27p_pen
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)
Definition i2for27p_pen.F:48
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