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

Go to the source code of this file.

Functions/Subroutines

subroutine i2for27p_cin (nsn, nmn, a, crst, nsv, ms, weight, stifn, mmass, fskyi2, iadi2, i0, nir, i2size, idel2, smass, irect, x, v, fsav, fncont, irtl, indxc, iadx, h3d_data, in, siner, dpara, msegtyp2, ar, stifr, csts_bis, t2fac_sms, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2for27p_cin()

subroutine i2for27p_cin ( integer nsn,
integer nmn,
a,
crst,
integer, dimension(*) nsv,
ms,
integer, dimension(*) weight,
stifn,
mmass,
fskyi2,
integer, dimension(nir,*) iadi2,
integer i0,
integer nir,
integer i2size,
integer idel2,
smass,
integer, dimension(4,*) irect,
x,
v,
fsav,
fncont,
integer, dimension(*) irtl,
integer, dimension(nsn) indxc,
integer, dimension(nsn) iadx,
type (h3d_database) h3d_data,
in,
siner,
dpara,
integer, dimension(*) msegtyp2,
ar,
stifr,
csts_bis,
t2fac_sms,
fncontp,
ftcontp )

Definition at line 35 of file i2for27p_cin.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE h3d_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NSN, NMN, I0, NIR, I2SIZE, IDEL2,
55 . IRECT(4,*),IADI2(NIR,*), NSV(*), WEIGHT(*), IRTL(*),
56 . INDXC(NSN),IADX(NSN),MSEGTYP2(*)
57C REAL
58 my_real
59 . x(3,*),v(3,*),a(3,*), crst(2,*), ms(*), stifn(*), mmass(*),
60 . fskyi2(i2size,*), smass(*),fsav(*),fncont(3,*),in(*),siner(*),
61 . dpara(7,*),ar(3,*),stifr(*),csts_bis(2,*),t2fac_sms(*),
62 . fncontp(3,*) ,ftcontp(3,*)
63 TYPE (H3D_DATABASE) :: H3D_DATA
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com01_c.inc"
68#include "sms_c.inc"
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I, I1, I2, I3, II, NN, L, J,K, JJ, I0BASE,
73 . IX1,IX2,IX3,IX4,NIRL
74C REAL
75 my_real
76 . ss, st, xmsi,fs(3),sp,sm,tp,tm,
77 . h(4),e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,
78 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,x0,y0,z0,xs(3),xm(3),
79 . stifm,fmx(4),fmy(4),fmz(4),fx(4),fy(4),fz(4),
80 . rx(4),ry(4),rz(4),rs(3),flx,fly,flz,fac_triang,dwdu,stbrk,
81 . mxs,mys,mzs,stifmr,rm(3),betax,betay,h2(4)
82C=======================================================================
83 i0base = i0
84#include "vectorize.inc"
85 DO ii=1,nsn
86 k = indxc(ii)
87 IF (k == 0) cycle
88 i = nsv(k)
89C
90 IF (i > 0) THEN
91 l=irtl(ii)
92 i3=3*i
93 i2=i3-1
94 i1=i2-1
95C
96 ix1 = irect(1,l)
97 ix2 = irect(2,l)
98 ix3 = irect(3,l)
99 ix4 = irect(4,l)
100C
101 IF (ix3 == ix4) THEN
102C-- Shape functions of triangles
103 nirl = 3
104 h(1) = crst(1,ii)
105 h(2) = crst(2,ii)
106 h(3) = one-crst(1,ii)-crst(2,ii)
107 h(4) = zero
108 h2(1) = csts_bis(1,ii)
109 h2(2) = csts_bis(2,ii)
110 h2(3) = one-csts_bis(1,ii)-csts_bis(2,ii)
111 h2(4) = zero
112 ELSE
113C-- Shape functions of quadrangles
114 nirl = 4
115 ss=crst(1,ii)
116 st=crst(2,ii)
117 sp=one + ss
118 sm=one - ss
119 tp=fourth*(one + st)
120 tm=fourth*(one - st)
121 h(1)=tm*sm
122 h(2)=tm*sp
123 h(3)=tp*sp
124 h(4)=tp*sm
125
126C Additional form functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
127 ss=csts_bis(1,ii)
128 st=csts_bis(2,ii)
129 sp=one + ss
130 sm=one - ss
131 tp=fourth*(one + st)
132 tm=fourth*(one - st)
133 h2(1)=tm*sm
134 h2(2)=tm*sp
135 h2(3)=tp*sp
136 h2(4)=tp*sm
137 ENDIF
138C
139C--------------------------------------------------C
140C
141 IF (msegtyp2(l)==0) THEN
142C
143C--------------------------------------------------------------C
144C--- solid main segment -- moment equilibrium----------------C
145C--------------------------------------------------------------C
146C
147C---- rep local facette main
148C
149 x1 = x(1,ix1)
150 y1 = x(2,ix1)
151 z1 = x(3,ix1)
152 x2 = x(1,ix2)
153 y2 = x(2,ix2)
154 z2 = x(3,ix2)
155 x3 = x(1,ix3)
156 y3 = x(2,ix3)
157 z3 = x(3,ix3)
158 x4 = x(1,ix4)
159 y4 = x(2,ix4)
160 z4 = x(3,ix4)
161 xs(1) = x(1,i)
162 xs(2) = x(2,i)
163 xs(3) = x(3,i)
164C
165 CALL i2rep(x1 ,x2 ,x3 ,x4 ,
166 . y1 ,y2 ,y3 ,y4 ,
167 . z1 ,z2 ,z3 ,z4 ,
168 . e1x ,e1y ,e1z ,
169 . e2x ,e2y ,e2z ,
170 . e3x ,e3y ,e3z ,nirl)
171C
172 IF (nirl == 4) THEN
173 fac_triang = one
174 x0 = fourth*(x1 + x2 + x3 + x4)
175 y0 = fourth*(y1 + y2 + y3 + y4)
176 z0 = fourth*(z1 + z2 + z3 + z4)
177 ELSE
178 fac_triang = zero
179 x0 = third*(x1 + x2 + x3)
180 y0 = third*(y1 + y2 + y3)
181 z0 = third*(z1 + z2 + z3)
182 ENDIF
183C
184 xs(1) = xs(1) - x0
185 xs(2) = xs(2) - y0
186 xs(3) = xs(3) - z0
187C
188 x1 = x1 - x0
189 y1 = y1 - y0
190 z1 = z1 - z0
191 x2 = x2 - x0
192 y2 = y2 - y0
193 z2 = z2 - z0
194 x3 = x3 - x0
195 y3 = y3 - y0
196 z3 = z3 - z0
197 x4 = x4 - x0
198 y4 = y4 - y0
199 z4 = z4 - z0
200 IF (nirl==3) THEN
201 x4 = zero
202 y4 = zero
203 z4 = zero
204 END IF
205C
206 xm(1) = x1*h(1) + x2*h(2) + x3*h(3) + x4*h(4)
207 xm(2) = y1*h(1) + y2*h(2) + y3*h(3) + y4*h(4)
208 xm(3) = z1*h(1) + z2*h(2) + z3*h(3) + z4*h(4)
209C
210C---- computation of local coordinates
211C
212 rs(1) = xs(1)*e1x + xs(2)*e1y + xs(3)*e1z
213 rs(2) = xs(1)*e2x + xs(2)*e2y + xs(3)*e2z
214 rs(3) = xs(1)*e3x + xs(2)*e3y + xs(3)*e3z
215C
216 rm(1) = xm(1)*e1x + xm(2)*e1y + xm(3)*e1z
217 rm(2) = xm(1)*e2x + xm(2)*e2y + xm(3)*e2z
218 rm(3) = xm(1)*e3x + xm(2)*e3y + xm(3)*e3z
219C
220 rx(1) = e1x*x1 + e1y*y1 + e1z*z1
221 ry(1) = e2x*x1 + e2y*y1 + e2z*z1
222 rz(1) = e3x*x1 + e3y*y1 + e3z*z1
223 rx(2) = e1x*x2 + e1y*y2 + e1z*z2
224 ry(2) = e2x*x2 + e2y*y2 + e2z*z2
225 rz(2) = e3x*x2 + e3y*y2 + e3z*z2
226 rx(3) = e1x*x3 + e1y*y3 + e1z*z3
227 ry(3) = e2x*x3 + e2y*y3 + e2z*z3
228 rz(3) = e3x*x3 + e3y*y3 + e3z*z3
229 rx(4) = e1x*x4 + e1y*y4 + e1z*z4
230 ry(4) = e2x*x4 + e2y*y4 + e2z*z4
231 rz(4) = e3x*x4 + e3y*y4 + e3z*z4
232C
233C---- computation of kinematic parameters and stbrk - local coordinates
234 CALL i2cin_rot27(stbrk,rs,rm,rx(1),ry(1),rz(1),rx(2),ry(2),rz(2),rx(3),ry(3),rz(3),
235 . rx(4),ry(4),rz(4),dpara(1,ii),dwdu,e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,
236 . nirl,betax,betay)
237C
238 IF (weight(i) == 1) THEN
239C
240C---- computation of force in local skew
241C
242 flx = a(1,i)*e1x + a(2,i)*e1y + a(3,i)*e1z
243 fly = a(1,i)*e2x + a(2,i)*e2y + a(3,i)*e2z
244 flz = a(1,i)*e3x + a(2,i)*e3y + a(3,i)*e3z
245C
246 DO j=1,4
247 fmx(j) = h(j)*flx
248 fmy(j) = h(j)*fly
249 fmz(j) = h(j)*flz
250 ENDDO
251C
252C---- update main forces (moment balance) - local coordinates RX
253 IF (iroddl==1) THEN
254 mxs = ar(1,i)*e1x + ar(2,i)*e1y + ar(3,i)*e1z
255 mys = ar(1,i)*e2x + ar(2,i)*e2y + ar(3,i)*e2z
256 mzs = ar(1,i)*e3x + ar(2,i)*e3y + ar(3,i)*e3z
257
258C-- moment balance + moment transfer
259 CALL i2loceq_27(nirl ,rs ,rx ,ry ,rz ,
260 . fmx ,fmy ,fmz ,h ,stifm ,
261 . mxs ,mys ,mzs ,stifmr ,betax ,
262 . betay)
263 ELSE
264 mxs = zero
265 mys = zero
266 mzs = zero
267
268C-- moment balance
269 CALL i2loceq_27(nirl ,rs ,rx ,ry ,rz ,
270 . fmx ,fmy ,fmz ,h ,stifm ,
271 . mxs ,mys ,mzs ,stifmr ,betax ,
272 . betay)
273 stifmr = zero
274 ENDIF
275C
276C---- computation of force in global skew
277C
278 DO j=1,4
279 fx(j) = e1x*fmx(j) + e2x*fmy(j) + e3x*fmz(j)
280 fy(j) = e1y*fmx(j) + e2y*fmy(j) + e3y*fmz(j)
281 fz(j) = e1z*fmx(j) + e2z*fmy(j) + e3z*fmz(j)
282 ENDDO
283 fs(1:3)=a(1:3,i)
284C
285 ENDIF
286C
287 ELSEIF (weight(i) == 1) THEN
288C----------------------------------------------------C
289C--- shell / shell or shell / solide connection ----C
290C----------------------------------------------------C
291C
292 fac_triang=one
293 stifm=zero
294 stifmr = zero
295 stbrk=zero
296 dwdu=zero
297 fs(1)=a(1,i)
298 fs(2)=a(2,i)
299 fs(3)=a(3,i)
300C
301 DO j=1,4
302 fx(j) = fs(1)*h(j)
303 fy(j) = fs(2)*h(j)
304 fz(j) = fs(3)*h(j)
305 ENDDO
306C
307 ENDIF
308C
309C--------------------------------------------------C
310C
311 IF (weight(i) == 1) THEN
312C
313 xmsi=ms(i)
314C
315 i0 = i0base + iadx(k)
316 nn = iadi2(1,i0)
317 fskyi2(1,nn) = fx(1)
318 fskyi2(2,nn) = fy(1)
319 fskyi2(3,nn) = fz(1)
320 fskyi2(4,nn) = xmsi*h2(1)
321 fskyi2(5,nn) = stifn(i)*(one+stbrk)*(abs(h(1))+stifm)+stifr(i)*stifmr*dwdu
322C
323 nn = iadi2(2,i0)
324 fskyi2(1,nn) = fx(2)
325 fskyi2(2,nn) = fy(2)
326 fskyi2(3,nn) = fz(2)
327 fskyi2(4,nn) = xmsi*h2(2)
328 fskyi2(5,nn) = stifn(i)*(one+stbrk)*(abs(h(2))+stifm)+stifr(i)*stifmr*dwdu
329C
330 nn = iadi2(3,i0)
331 fskyi2(1,nn) = fx(3)
332 fskyi2(2,nn) = fy(3)
333 fskyi2(3,nn) = fz(3)
334 fskyi2(4,nn) = xmsi*h2(3)
335 fskyi2(5,nn) = stifn(i)*(one+stbrk)*(abs(h(3))+stifm)+stifr(i)*stifmr*dwdu
336C
337 nn = iadi2(4,i0)
338 fskyi2(1,nn) = fx(4)
339 fskyi2(2,nn) = fy(4)
340 fskyi2(3,nn) = fz(4)
341 fskyi2(4,nn) = xmsi*h2(4)
342 fskyi2(5,nn) = stifn(i)*(one+stbrk)*(abs(h(4))+stifm*fac_triang)+stifr(i)*stifmr*dwdu*fac_triang
343C
344 IF(idtmins==2.OR.idtmins_int/=0) THEN
345C---- For AMS scaling factor on stiffness is stored - only used for solid main surface
346 t2fac_sms(i) = (one+stbrk)*(one+stifm)
347 ENDIF
348C
349 ENDIF
350C
351C--- output of tied contact forces
352 CALL i2forces(x ,fs ,fx ,fy ,fz ,
353 . irect(1,l),nir ,fsav ,fncont ,fncontp,
354 . ftcontp ,weight ,h3d_data,i ,h)
355C
356 IF (iroddl == 0) THEN
357 stifn(i)=em20
358 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
359 ms(i)=zero
360 a(1,i)=zero
361 a(2,i)=zero
362 a(3,i)=zero
363 ENDIF
364C
365C stokage ZERO pour noeuds delete par idel2
366 ELSEIF (weight(-i) == 1) THEN
367 i0 = i0base + iadx(k)
368 nn = iadi2(1,i0)
369 fskyi2(1,nn) = zero
370 fskyi2(2,nn) = zero
371 fskyi2(3,nn) = zero
372 fskyi2(4,nn) = zero
373 fskyi2(5,nn) = zero
374 nn = iadi2(2,i0)
375 fskyi2(1,nn) = zero
376 fskyi2(2,nn) = zero
377 fskyi2(3,nn) = zero
378 fskyi2(4,nn) = zero
379 fskyi2(5,nn) = zero
380 nn = iadi2(3,i0)
381 fskyi2(1,nn) = zero
382 fskyi2(2,nn) = zero
383 fskyi2(3,nn) = zero
384 fskyi2(4,nn) = zero
385 fskyi2(5,nn) = zero
386 nn = iadi2(4,i0)
387 fskyi2(1,nn) = zero
388 fskyi2(2,nn) = zero
389 fskyi2(3,nn) = zero
390 fskyi2(4,nn) = zero
391 fskyi2(5,nn) = zero
392 ENDIF
393C----
394 ENDDO
395c-----------
396 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i2cin_rot27
subroutine i2cin_rot27(stbrk, rs, rm, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, dpara, dwdu, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir, betax, betay)
Definition i2cin_rot27.F:33
i2forces
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
i2loceq_27
subroutine i2loceq_27(nir, rs, rx, ry, rz, fmx, fmy, fmz, h, stifm, mxs, mys, mzs, stifmr, betax, betay)
Definition i2loceq.F:224
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
h3d_mod
Definition h3d_mod.F:308