OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for10p.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!|| i2for10p ../engine/source/interfaces/interf/i2for10p.F
25!||--- called by ------------------------------------------------------
26!|| intti2f ../engine/source/interfaces/interf/intti2f.F
27!||====================================================================
28 SUBROUTINE i2for10p(A ,MS ,STIFN ,WEIGHT,IADI2 ,
29 2 FSKYI2,NSV ,IRUPT ,CRST ,FSM ,
30 3 NIR ,NSN ,I0 ,I2SIZE, CSTS_BIS)
31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35C-----------------------------------------------
36C D u m m y A r g u m e n t s
37C-----------------------------------------------
38 INTEGER NSN,I0,NIR,I2SIZE
39 INTEGER NSV(*),IRUPT(*),WEIGHT(*),IADI2(NIR,*)
40C REAL
41 my_real
42 . ms(*),stifn(*),a(3,*),fsm(3,*),crst(2,*),fskyi2(i2size,*),csts_bis(2,*)
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com01_c.inc"
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I, II, NN
51C REAL
52 my_real
53 . ss,tt,xmsi,stfn,fxi,fyi,fzi,sp,sm,tp,tm,h1, h2, h3, h4,h21, h22, h23, h24
54C=======================================================================
55 DO ii=1,nsn
56 i=nsv(ii)
57 IF (i > 0) THEN
58C
59 ss=crst(1,ii)
60 tt=crst(2,ii)
61 sp=one + ss
62 sm=one - ss
63 tp=fourth*(one + tt)
64 tm=fourth*(one - tt)
65 h1=tm*sm
66 h2=tm*sp
67 h3=tp*sp
68 h4=tp*sm
69
70C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
71 ss=csts_bis(1,ii)
72 tt=csts_bis(2,ii)
73 sp=one + ss
74 sm=one - ss
75 tp=fourth*(one + tt)
76 tm=fourth*(one - tt)
77 h21=tm*sm
78 h22=tm*sp
79 h23=tp*sp
80 h24=tp*sm
81C
82 fxi=a(1,i)
83 fyi=a(2,i)
84 fzi=a(3,i)
85C
86 IF (irupt(ii) == 0) THEN
87C--------- pas de rupture -
88C
89 IF (weight(i) == 1) THEN
90 xmsi = ms(i)
91 stfn = stifn(i)
92C
93 i0 = i0 + 1
94 nn = iadi2(1,i0)
95 fskyi2(1,nn) = fxi*h1
96 fskyi2(2,nn) = fyi*h1
97 fskyi2(3,nn) = fzi*h1
98 fskyi2(4,nn) = xmsi*h21
99 fskyi2(5,nn) = stfn*h1
100C
101 nn = iadi2(2,i0)
102 fskyi2(1,nn) = fxi*h2
103 fskyi2(2,nn) = fyi*h2
104 fskyi2(3,nn) = fzi*h2
105 fskyi2(4,nn) = xmsi*h22
106 fskyi2(5,nn) = stfn*h2
107C
108 nn = iadi2(3,i0)
109 fskyi2(1,nn) = fxi*h3
110 fskyi2(2,nn) = fyi*h3
111 fskyi2(3,nn) = fzi*h3
112 fskyi2(4,nn) = xmsi*h23
113 fskyi2(5,nn) = stfn*h3
114C
115 nn = iadi2(4,i0)
116 fskyi2(1,nn) = fxi*h4
117 fskyi2(2,nn) = fyi*h4
118 fskyi2(3,nn) = fzi*h4
119 fskyi2(4,nn) = xmsi*h24
120 fskyi2(5,nn) = stfn*h4
121 ENDIF
122C
123 IF (iroddl == 0)THEN
124 stifn(i)=em20
125 ms(i) =zero
126 a(1,i)=zero
127 a(2,i)=zero
128 a(3,i)=zero
129 ENDIF
130 ELSEIF (irupt(ii) == -1) THEN
131C--------- rupture partielle -
132C
133 fxi = fsm(1,ii)
134 fyi = fsm(2,ii)
135 fzi = fsm(3,ii)
136C
137 a(1,i) = a(1,i) - fxi
138 a(2,i) = a(2,i) - fyi
139 a(3,i) = a(3,i) - fzi
140C
141 IF (weight(i) == 1) THEN
142 i0 = i0 + 1
143 nn = iadi2(1,i0)
144 fskyi2(1,nn) = fxi*h1
145 fskyi2(2,nn) = fyi*h1
146 fskyi2(3,nn) = fzi*h1
147 fskyi2(4,nn) = zero
148 fskyi2(5,nn) = zero
149C
150 nn = iadi2(2,i0)
151 fskyi2(1,nn) = fxi*h2
152 fskyi2(2,nn) = fyi*h2
153 fskyi2(3,nn) = fzi*h2
154 fskyi2(4,nn) = zero
155 fskyi2(5,nn) = zero
156C
157 nn = iadi2(3,i0)
158 fskyi2(1,nn) = fxi*h3
159 fskyi2(2,nn) = fyi*h3
160 fskyi2(3,nn) = fzi*h3
161 fskyi2(4,nn) = zero
162 fskyi2(5,nn) = zero
163C
164 nn = iadi2(4,i0)
165 fskyi2(1,nn) = fxi*h4
166 fskyi2(2,nn) = fyi*h4
167 fskyi2(3,nn) = fzi*h4
168 fskyi2(4,nn) = zero
169 fskyi2(5,nn) = zero
170 ENDIF
171 ELSEIF (irupt(ii) == 1 .AND. weight(i) == 1) THEN
172C--------- rupture totale -
173C
174 i0 = i0 + 1
175 nn = iadi2(1,i0)
176 fskyi2(1,nn) = zero
177 fskyi2(2,nn) = zero
178 fskyi2(3,nn) = zero
179 fskyi2(4,nn) = zero
180 fskyi2(5,nn) = zero
181C
182 nn = iadi2(2,i0)
183 fskyi2(1,nn) = zero
184 fskyi2(2,nn) = zero
185 fskyi2(3,nn) = zero
186 fskyi2(4,nn) = zero
187 fskyi2(5,nn) = zero
188C
189 nn = iadi2(3,i0)
190 fskyi2(1,nn) = zero
191 fskyi2(2,nn) = zero
192 fskyi2(3,nn) = zero
193 fskyi2(4,nn) = zero
194 fskyi2(5,nn) = zero
195C
196 nn = iadi2(4,i0)
197 fskyi2(1,nn) = zero
198 fskyi2(2,nn) = zero
199 fskyi2(3,nn) = zero
200 fskyi2(4,nn) = zero
201 fskyi2(5,nn) = zero
202 ENDIF
203C
204 ENDIF
205 ENDDO
206C-----------
207 RETURN
208 END SUBROUTINE i2for10p
209C
210!||====================================================================
211!|| i2mom10p ../engine/source/interfaces/interf/i2for10p.F
212!||--- called by ------------------------------------------------------
213!|| intti2f ../engine/source/interfaces/interf/intti2f.F
214!||====================================================================
215 SUBROUTINE i2mom10p(
216 1 X ,A ,AR ,MS ,IN ,
217 2 STIFN ,STIFR ,WEIGHT ,IRECT ,NSV ,
218 3 MSR ,IRTL ,IRUPT ,CRST ,IADI2 ,
219 4 FSKYI2 ,NSN ,NMN ,NIR ,I0 ,
220 5 I2SIZE ,IDEL2 ,CSTS_BIS)
221C-----------------------------------------------
222C I m p l i c i t T y p e s
223C-----------------------------------------------
224#include "implicit_f.inc"
225C-----------------------------------------------
226C D u m m y A r g u m e n t s
227C-----------------------------------------------
228 INTEGER NSN, NMN, NIR, I0, I2SIZE, IDEL2
229 INTEGER IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*),
230 . IADI2(NIR,*),IRUPT(*)
231C REAL
232 my_real
233 . A(3,*), AR(3,*),CRST(2,*), MS(*),
234 . X(3,*),IN(*),STIFN(*),STIFR(*), FSKYI2(I2SIZE,*), CSTS_BIS(2,*)
235C-----------------------------------------------
236C L o c a l V a r i a b l e s
237C-----------------------------------------------
238 INTEGER I, J, II, L, NN
239C REAL
240 my_real
241 . ss, tt, xmsi, fxi, fyi, fzi, mxi, myi, mzi,ins,
242 . x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,z0,z1,z2,z3,z4,aa,
243 . xc0,yc0,zc0,sp,sm,tp,tm,xc,yc,zc,h1, h2,h3,h4,
244 . stf,h21,h22,h23,h24
245C-----------------------------------------------
246#include "vectorize.inc"
247 DO ii=1,nmn
248 j=msr(ii)
249 in(j)=max(em20,in(j))
250 ENDDO
251C
252 DO ii=1,nsn
253 i=nsv(ii)
254 IF (i > 0) THEN
255C
256 IF (irupt(ii) == 0) THEN
257C--------- pas de rupture -
258C
259 IF (weight(i) == 1) THEN
260 l=irtl(ii)
261C
262 ss=crst(1,ii)
263 tt=crst(2,ii)
264 sp=one + ss
265 sm=one - ss
266 tp=fourth*(one + tt)
267 tm=fourth*(one - tt)
268 h1=tm*sm
269 h2=tm*sp
270 h3=tp*sp
271 h4=tp*sm
272
273C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
274 ss=csts_bis(1,ii)
275 tt=csts_bis(2,ii)
276 sp=one + ss
277 sm=one - ss
278 tp=fourth*(one + tt)
279 tm=fourth*(one - tt)
280 h21=tm*sm
281 h22=tm*sp
282 h23=tp*sp
283 h24=tp*sm
284C
285 x0 = x(1,i)
286 y0 = x(2,i)
287 z0 = x(3,i)
288C
289 x1 = x(1,irect(1,l))
290 y1 = x(2,irect(1,l))
291 z1 = x(3,irect(1,l))
292 x2 = x(1,irect(2,l))
293 y2 = x(2,irect(2,l))
294 z2 = x(3,irect(2,l))
295 x3 = x(1,irect(3,l))
296 y3 = x(2,irect(3,l))
297 z3 = x(3,irect(3,l))
298 x4 = x(1,irect(4,l))
299 y4 = x(2,irect(4,l))
300 z4 = x(3,irect(4,l))
301C
302 xc = x1 * h1 + x2 * h2 + x3 * h3 + x4 * h4
303 yc = y1 * h1 + y2 * h2 + y3 * h3 + y4 * h4
304 zc = z1 * h1 + z2 * h2 + z3 * h3 + z4 * h4
305C
306 xc0=x0-xc
307 yc0=y0-yc
308 zc0=z0-zc
309C
310 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
311 ins = in(i) + aa * ms(i)
312 stf = stifr(i) + aa * stifn(i)
313C
314 fxi=a(1,i)
315 fyi=a(2,i)
316 fzi=a(3,i)
317C
318 mxi = ar(1,i) + yc0 * fzi - zc0 * fyi
319 myi = ar(2,i) + zc0 * fxi - xc0 * fzi
320 mzi = ar(3,i) + xc0 * fyi - yc0 * fxi
321C
322 i0 = i0 + 1
323 nn = iadi2(1,i0)
324 fskyi2(6,nn) = mxi*h1
325 fskyi2(7,nn) = myi*h1
326 fskyi2(8,nn) = mzi*h1
327 fskyi2(9,nn) = ins*h21
328 fskyi2(10,nn)= stf*h1
329C
330 nn = iadi2(2,i0)
331 fskyi2(6,nn) = mxi*h2
332 fskyi2(7,nn) = myi*h2
333 fskyi2(8,nn) = mzi*h2
334 fskyi2(9,nn) = ins*h22
335 fskyi2(10,nn)= stf*h2
336C
337 nn = iadi2(3,i0)
338 fskyi2(6,nn) = mxi*h3
339 fskyi2(7,nn) = myi*h3
340 fskyi2(8,nn) = mzi*h3
341 fskyi2(9,nn) = ins*h23
342 fskyi2(10,nn)= stf*h3
343C
344 nn = iadi2(4,i0)
345 fskyi2(6,nn) = mxi*h4
346 fskyi2(7,nn) = myi*h4
347 fskyi2(8,nn) = mzi*h4
348 fskyi2(9,nn) = ins*h24
349 fskyi2(10,nn)= stf*h4
350 ENDIF
351C
352 stifn(i)=em20
353 stifr(i)=em20
354 in(i) =zero
355 ms(i) =zero
356 a(1,i)=zero
357 a(2,i)=zero
358 a(3,i)=zero
359C
360 ELSEIF (weight(i) == 1) THEN
361C--------- rupture partielle ou totale -
362C
363 i0 = i0 + 1
364 nn = iadi2(1,i0)
365 fskyi2(6,nn) = zero
366 fskyi2(7,nn) = zero
367 fskyi2(8,nn) = zero
368 fskyi2(9,nn) = zero
369 fskyi2(10,nn)= zero
370C
371 nn = iadi2(2,i0)
372 fskyi2(6,nn) = zero
373 fskyi2(7,nn) = zero
374 fskyi2(8,nn) = zero
375 fskyi2(9,nn) = zero
376 fskyi2(10,nn)= zero
377C
378 nn = iadi2(3,i0)
379 fskyi2(6,nn) = zero
380 fskyi2(7,nn) = zero
381 fskyi2(8,nn) = zero
382 fskyi2(9,nn) = zero
383 fskyi2(10,nn)= zero
384C
385 nn = iadi2(4,i0)
386 fskyi2(6,nn) = zero
387 fskyi2(7,nn) = zero
388 fskyi2(8,nn) = zero
389 fskyi2(9,nn) = zero
390 fskyi2(10,nn)= zero
391 ENDIF
392C
393 ENDIF
394 ENDDO
395C-----------
396 RETURN
397 END SUBROUTINE i2mom10p
my_real
#define my_real
Definition cppsort.cpp:32
i2mom10p
subroutine i2mom10p(x, a, ar, ms, in, stifn, stifr, weight, irect, nsv, msr, irtl, irupt, crst, iadi2, fskyi2, nsn, nmn, nir, i0, i2size, idel2, csts_bis)
Definition i2for10p.F:221
i2for10p
subroutine i2for10p(a, ms, stifn, weight, iadi2, fskyi2, nsv, irupt, crst, fsm, nir, nsn, i0, i2size, csts_bis)
Definition i2for10p.F:31
max
#define max(a, b)
Definition macros.h:21