OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for10.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!|| i2for10 ../engine/source/interfaces/interf/i2for10.F
25!||--- called by ------------------------------------------------------
26!|| intti2f ../engine/source/interfaces/interf/intti2f.F
27!||====================================================================
28 SUBROUTINE i2for10(A ,MS ,STIFN ,WEIGHT ,IRECT ,
29 2 NSV ,MSR ,IRTL ,IRUPT ,CRST ,
30 3 FSM ,NSN ,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
39 INTEGER IRECT(4,*),MSR(*),NSV(*),IRTL(*),IRUPT(*),WEIGHT(*)
40C REAL
41 my_real
42 . a(3,*),ms(*),stifn(*),fsm(3,*),crst(2,*),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 NIR,I,J,II,JJ,L,W
51C REAL
52 my_real
53 . s,t,sp,sm,tp,tm,fxi,fyi,fzi,xmsi,stfn
54 my_real
55 . h(4),h2(4)
56C=======================================================================
57 nir=4
58C----------------
59 DO ii=1,nsn
60 i=nsv(ii)
61 l=irtl(ii)
62C
63 IF (i > 0) THEN
64 w = weight(i)
65C
66 s = crst(1,ii)
67 t = crst(2,ii)
68 sp=one + s
69 sm=one - s
70 tp=fourth*(one + t)
71 tm=fourth*(one - t)
72 h(1)=tm*sm
73 h(2)=tm*sp
74 h(3)=tp*sp
75 h(4)=tp*sm
76
77C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
78 s = csts_bis(1,ii)
79 t = csts_bis(2,ii)
80 sp=one + s
81 sm=one - s
82 tp=fourth*(one + t)
83 tm=fourth*(one - t)
84 h2(1)=tm*sm
85 h2(2)=tm*sp
86 h2(3)=tp*sp
87 h2(4)=tp*sm
88c
89 IF (irupt(ii) == 0) THEN
90C---------- pas de rupture
91c
92 xmsi= ms(i)*w
93 stfn= stifn(i)*w
94 fxi = a(1,i)*w
95 fyi = a(2,i)*w
96 fzi = a(3,i)*w
97 DO jj=1,nir
98 j=irect(jj,l)
99 a(1,j) = a(1,j) + h(jj) * fxi
100 a(2,j) = a(2,j) + h(jj) * fyi
101 a(3,j) = a(3,j) + h(jj) * fzi
102 ms(j) = ms(j) + h2(jj) * xmsi
103 stifn(j)= stifn(j)+h(jj) * stfn
104 ENDDO
105 IF(iroddl == 0)THEN
106 stifn(i)=em20
107 ms(i) =zero
108 a(1,i) =zero
109 a(2,i) =zero
110 a(3,i) =zero
111 ENDIF
112 ELSEIF (irupt(ii) == -1) THEN
113C---------- rupture partielle
114C
115 fxi = fsm(1,ii)
116 fyi = fsm(2,ii)
117 fzi = fsm(3,ii)
118C
119 a(1,i) = a(1,i) - fxi
120 a(2,i) = a(2,i) - fyi
121 a(3,i) = a(3,i) - fzi
122C
123 DO jj=1,nir
124 j=irect(jj,l)
125 a(1,j) = a(1,j) + h(jj) * fxi *w
126 a(2,j) = a(2,j) + h(jj) * fyi *w
127 a(3,j) = a(3,j) + h(jj) * fzi *w
128 ENDDO
129 ENDIF
130C----------
131 ENDIF
132 ENDDO
133C-----------
134 RETURN
135 END SUBROUTINE i2for10
136C
137C
138!||====================================================================
139!|| i2mom10 ../engine/source/interfaces/interf/i2for10.F
140!||--- called by ------------------------------------------------------
141!|| intti2f ../engine/source/interfaces/interf/intti2f.F
142!||====================================================================
143 SUBROUTINE i2mom10(NSN ,NMN ,AR ,IRECT ,CRST ,
144 2 MSR ,NSV ,IRTL ,IN ,MS ,
145 3 A ,X ,WEIGHT ,STIFR ,STIFN ,
146 4 IRUPT ,ILEV ,CSTS_BIS)
147C-----------------------------------------------
148C I m p l i c i t T y p e s
149C-----------------------------------------------
150#include "implicit_f.inc"
151C-----------------------------------------------
152C D u m m y A r g u m e n t s
153C-----------------------------------------------
154 INTEGER NSN, NMN, ILEV,
155 . IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*), IRUPT(*)
156C REAL
157 my_real
158 . A(3,*), AR(3,*),CRST(2,*), MS(*),
159 . x(3,*),in(*),stifr(*),stifn(*),csts_bis(2,*)
160C-----------------------------------------------
161C C o m m o n B l o c k s
162C-----------------------------------------------
163C-----------------------------------------------
164C L o c a l V a r i a b l e s
165C-----------------------------------------------
166 INTEGER I, J, II, L, JJ, W
167C REAL
168 my_real
169 . H(4),S,T,XMSI,FXI,FYI,FZI,MXI,MYI,MZI,INS,AA,
170 . X0,X1,X2,X3,X4,Y0,Y1,Y2,Y3,Y4,Z0,Z1,Z2,Z3,Z4,
171 . xc0,yc0,zc0,sp,sm,tp,tm,xc,yc,zc,
172 . stf,h2(4)
173C=======================================================================
174 DO ii=1,nsn
175 IF (irupt(ii) == 0) THEN
176 i = nsv(ii)
177 IF (i > 0) THEN
178 l = irtl(ii)
179C
180 s = crst(1,ii)
181 t = crst(2,ii)
182 sp= one + s
183 sm= one - s
184 tp= fourth*(one + t)
185 tm= fourth*(one - t)
186 h(1)=tm*sm
187 h(2)=tm*sp
188 h(3)=tp*sp
189 h(4)=tp*sm
190
191C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
192 s = csts_bis(1,ii)
193 t = csts_bis(2,ii)
194 sp= one + s
195 sm= one - s
196 tp= fourth*(one + t)
197 tm= fourth*(one - t)
198 h2(1)=tm*sm
199 h2(2)=tm*sp
200 h2(3)=tp*sp
201 h2(4)=tp*sm
202C
203 x0 = x(1,i)
204 y0 = x(2,i)
205 z0 = x(3,i)
206C
207 x1 = x(1,irect(1,l))
208 y1 = x(2,irect(1,l))
209 z1 = x(3,irect(1,l))
210 x2 = x(1,irect(2,l))
211 y2 = x(2,irect(2,l))
212 z2 = x(3,irect(2,l))
213 x3 = x(1,irect(3,l))
214 y3 = x(2,irect(3,l))
215 z3 = x(3,irect(3,l))
216 x4 = x(1,irect(4,l))
217 y4 = x(2,irect(4,l))
218 z4 = x(3,irect(4,l))
219C
220 xc = x1 * h(1) + x2 * h(2) + x3 * h(3) + x4 * h(4)
221 yc = y1 * h(1) + y2 * h(2) + y3 * h(3) + y4 * h(4)
222 zc = z1 * h(1) + z2 * h(2) + z3 * h(3) + z4 * h(4)
223C
224 xc0=x0-xc
225 yc0=y0-yc
226 zc0=z0-zc
227C
228 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
229 ins = in(i) + aa * ms(i)
230 stf = stifr(i) + aa * stifn(i)
231C
232 fxi=a(1,i)
233 fyi=a(2,i)
234 fzi=a(3,i)
235C
236 mxi = ar(1,i) + yc0 * fzi - zc0 * fyi
237 myi = ar(2,i) + zc0 * fxi - xc0 * fzi
238 mzi = ar(3,i) + xc0 * fyi - yc0 * fxi
239C
240 w = weight(i)
241 DO jj=1,4
242 j=irect(jj,l)
243 ar(1,j) =ar(1,j) + mxi*h(jj)*w
244 ar(2,j) =ar(2,j) + myi*h(jj)*w
245 ar(3,j) =ar(3,j) + mzi*h(jj)*w
246 in(j) =in(j) + ins*h2(jj)*w
247 stifr(j)=stifr(j)+ stf*h(jj)*w
248 ENDDO
249 stifr(i)=em20
250 stifn(i)=em20
251 in(i) =zero
252 ms(i) =zero
253 a(1,i) =zero
254 a(2,i) =zero
255 a(3,i) =zero
256C
257 ENDIF
258 ENDIF
259 ENDDO
260C---
261 RETURN
262 END
my_real
#define my_real
Definition cppsort.cpp:32
i2mom10
subroutine i2mom10(nsn, nmn, ar, irect, crst, msr, nsv, irtl, in, ms, a, x, weight, stifr, stifn, irupt, ilev, csts_bis)
Definition i2for10.F:147
i2for10
subroutine i2for10(a, ms, stifn, weight, irect, nsv, msr, irtl, irupt, crst, fsm, nsn, csts_bis)
Definition i2for10.F:31