OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for27p_cin.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_cin ../engine/source/interfaces/interf/i2for27p_cin.F
25!||--- called by ------------------------------------------------------
26!|| i2for27p ../engine/source/interfaces/interf/i2for27p.F
27!||--- calls -----------------------------------------------------
28!|| i2cin_rot27 ../common_source/interf/i2cin_rot27.F
29!|| i2forces ../engine/source/interfaces/interf/i2forces.F
30!|| i2loceq_27 ../common_source/interf/i2loceq.F
31!|| i2rep ../common_source/interf/i2rep.F
32!||--- uses -----------------------------------------------------
33!|| h3d_mod ../engine/share/modules/h3d_mod.F
34!||====================================================================
35 SUBROUTINE i2for27p_cin(
36 1 NSN ,NMN ,A ,CRST ,NSV ,
37 2 MS ,WEIGHT ,STIFN ,MMASS ,FSKYI2 ,
38 3 IADI2 ,I0 ,NIR ,I2SIZE ,IDEL2 ,
39 4 SMASS ,IRECT ,X ,V ,FSAV ,
40 5 FNCONT ,IRTL ,INDXC ,IADX ,H3D_DATA,
41 6 IN ,SINER ,DPARA ,MSEGTYP2,AR ,
42 7 STIFR ,CSTS_BIS,T2FAC_SMS,FNCONTP,FTCONTP)
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
397 END
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
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)
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
subroutine i2loceq_27(nir, rs, rx, ry, rz, fmx, fmy, fmz, h, stifm, mxs, mys, mzs, stifmr, betax, betay)
Definition i2loceq.F:224
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