OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2mom27_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!|| i2mom27_cin ../engine/source/interfaces/interf/i2mom27_cin.F
25!||--- called by ------------------------------------------------------
26!|| i2for27 ../engine/source/interfaces/interf/i2for27.F
27!||--- uses -----------------------------------------------------
28!|| h3d_mod ../engine/share/modules/h3d_mod.F
29!|| outmax_mod ../common_source/modules/outmax_mod.F
30!||====================================================================
31 SUBROUTINE i2mom27_cin(NSN ,NMN ,AR ,IRECT ,CRST ,
32 2 MSR ,NSV ,IRTL ,IN ,MS ,
33 3 A ,X ,WEIGHT ,STIFR ,STIFN ,
34 4 IDEL2 ,SMASS ,SINER ,NMAS ,ADI ,
35 5 INDXC ,MINER ,H3D_DATA,MSEGTYP2 ,CSTS_BIS)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE h3d_mod
40 USE outmax_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER NSN, NMN, IDEL2,
49 . IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*),INDXC(NSN),MSEGTYP2(*)
50C REAL
51 my_real
52 . a(3,*), ar(3,*),crst(2,*), ms(*),
53 . x(3,*),in(*),stifr(*),stifn(*), smass(*), siner(*),
54 . nmas(*),adi(*),miner(*),csts_bis(2,*)
55 TYPE (H3D_DATABASE) :: H3D_DATA
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "scr14_c.inc"
60#include "scr16_c.inc"
61#include "impl1_c.inc"
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I, J, K, I3, J3, I2, J2, I1, J1, II, L, JJ, W,NIR
66C REAL
67 my_real
68 . H(4), XMSJ, SS, ST, XMSI, FXI, FYI, FZI, MXI, MYI, MZI,INS,
69 . x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,z0,z1,z2,z3,z4,aa,
70 . xc0,yc0,zc0,sp,sm,tp,tm,xc,yc,zc,
71 . stf,ai,h2(4)
72C=======================================================================
73C MINER(II) initialise a MS(J) dans resol_init
74 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
75 DO ii=1,nmn
76 j=msr(ii)
77 adi(j) = adi(j)*nmas(ii)
78 ENDDO
79 ENDIF
80 IF(impl_s>0) THEN
81 DO ii=1,nsn
82 k = indxc(ii)
83 IF (k == 0) cycle
84 i = nsv(k)
85 IF(i>0)THEN
86 l=irtl(ii)
87C
88 IF (irect(3,l) == irect(4,l)) THEN
89C-- Shape functions of triangles
90 nir = 3
91 h(1) = crst(1,ii)
92 h(2) = crst(2,ii)
93 h(3) = one-crst(1,ii)-crst(2,ii)
94 h(4) = zero
95 h2(1) = csts_bis(1,ii)
96 h2(2) = csts_bis(2,ii)
97 h2(3) = one-csts_bis(1,ii)-csts_bis(2,ii)
98 h2(4) = zero
99 ELSE
100C-- Shape functions of quadrangles
101 nir = 4
102 ss=crst(1,ii)
103 st=crst(2,ii)
104 sp=one + ss
105 sm=one - ss
106 tp=fourth*(one + st)
107 tm=fourth*(one - st)
108 h(1)=tm*sm
109 h(2)=tm*sp
110 h(3)=tp*sp
111 h(4)=tp*sm
112
113C Additional form functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
114 ss=csts_bis(1,ii)
115 st=csts_bis(2,ii)
116 sp=one + ss
117 sm=one - ss
118 tp=fourth*(one + st)
119 tm=fourth*(one - st)
120 h2(1)=tm*sm
121 h2(2)=tm*sp
122 h2(3)=tp*sp
123 h2(4)=tp*sm
124 ENDIF
125C
126 xc=zero
127 yc=zero
128 zc=zero
129 DO jj=1,nir
130 j=irect(jj,l)
131 xc=xc+x(1,j)*h(jj)
132 yc=yc+x(2,j)*h(jj)
133 zc=zc+x(3,j)*h(jj)
134 ENDDO
135C
136 x0 = x(1,i)
137 y0 = x(2,i)
138 z0 = x(3,i)
139C
140 xc0=x0-xc
141 yc0=y0-yc
142 zc0=z0-zc
143C
144 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
145 ins = in(i) + aa * ms(i)
146 stf = stifr(i) + aa * stifn(i)
147C
148 fxi=a(1,i)
149 fyi=a(2,i)
150 fzi=a(3,i)
151C
152 mxi = ar(1,i) + yc0 * fzi - zc0 * fyi
153 myi = ar(2,i) + zc0 * fxi - xc0 * fzi
154 mzi = ar(3,i) + xc0 * fyi - yc0 * fxi
155C
156 w = weight(i)
157 ai=aa * ms(i) * w
158 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
159 DO jj=1,nir
160 j=irect(jj,l)
161 adi(j)=adi(j)+ai*h(jj)
162 END DO
163 END IF
164C
165 IF (h3d_data%N_VECT_CONT2M > 0) THEN
166 mcont2(1,i) = -ar(1,i)*w
167 mcont2(2,i) = -ar(2,i)*w
168 mcont2(3,i) = -ar(3,i)*w
169 DO jj=1,nir
170 j=irect(jj,l)
171 mcont2(1,j) = mcont2(1,j) + mxi*h(jj)*w
172 mcont2(2,j) = mcont2(2,j) + myi*h(jj)*w
173 mcont2(3,j) = mcont2(3,j) + mzi*h(jj)*w
174 ENDDO
175 ENDIF
176C
177 DO jj=1,nir
178 j=irect(jj,l)
179 IF (msegtyp2(l)==1) THEN
180 ar(1,j)=ar(1,j)+mxi*h(jj)*w
181 ar(2,j)=ar(2,j)+myi*h(jj)*w
182 ar(3,j)=ar(3,j)+mzi*h(jj)*w
183 in(j)=in(j)+ins*h2(jj)*w
184 stifr(j)=stifr(j)+abs(stf*h(jj)*w)
185 END IF
186 ENDDO
187 stifr(i)=em20
188 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
189 in(i)=zero
190 stifn(i)=em20
191 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
192 ms(i)=zero
193 a(1,i)=zero
194 a(2,i)=zero
195 a(3,i)=zero
196 ENDIF
197C
198 ENDDO
199c
200 ELSE
201c
202 DO ii=1,nsn
203 k = indxc(ii)
204 IF (k == 0) cycle
205 i = nsv(k)
206 IF(i>0)THEN
207 l=irtl(ii)
208C
209 ss=crst(1,ii)
210 st=crst(2,ii)
211 sp=one + ss
212 sm=one - ss
213 tp=fourth*(one + st)
214 tm=fourth*(one - st)
215C
216 IF (irect(3,l) == irect(4,l)) THEN
217C-- Shape functions of triangles
218 nir = 3
219 h(1) = crst(1,ii)
220 h(2) = crst(2,ii)
221 h(3) = one-crst(1,ii)-crst(2,ii)
222 h(4) = zero
223 h2(1) = csts_bis(1,ii)
224 h2(2) = csts_bis(2,ii)
225 h2(3) = one-csts_bis(1,ii)-csts_bis(2,ii)
226 h2(4) = zero
227 ELSE
228C-- Shape functions of quadrangles
229 nir = 4
230 ss=crst(1,ii)
231 st=crst(2,ii)
232 sp=one + ss
233 sm=one - ss
234 tp=fourth*(one + st)
235 tm=fourth*(one - st)
236 h(1)=tm*sm
237 h(2)=tm*sp
238 h(3)=tp*sp
239 h(4)=tp*sm
240
241C Additional form functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
242 ss=csts_bis(1,ii)
243 st=csts_bis(2,ii)
244 sp=one + ss
245 sm=one - ss
246 tp=fourth*(one + st)
247 tm=fourth*(one - st)
248 h2(1)=tm*sm
249 h2(2)=tm*sp
250 h2(3)=tp*sp
251 h2(4)=tp*sm
252 ENDIF
253C
254 x0 = x(1,i)
255 y0 = x(2,i)
256 z0 = x(3,i)
257C
258 x1 = x(1,irect(1,l))
259 y1 = x(2,irect(1,l))
260 z1 = x(3,irect(1,l))
261 x2 = x(1,irect(2,l))
262 y2 = x(2,irect(2,l))
263 z2 = x(3,irect(2,l))
264 x3 = x(1,irect(3,l))
265 y3 = x(2,irect(3,l))
266 z3 = x(3,irect(3,l))
267 x4 = x(1,irect(4,l))
268 y4 = x(2,irect(4,l))
269 z4 = x(3,irect(4,l))
270C
271 xc = x1 * h(1) + x2 * h(2) + x3 * h(3) + x4 * h(4)
272 yc = y1 * h(1) + y2 * h(2) + y3 * h(3) + y4 * h(4)
273 zc = z1 * h(1) + z2 * h(2) + z3 * h(3) + z4 * h(4)
274C
275 xc0=x0-xc
276 yc0=y0-yc
277 zc0=z0-zc
278C
279 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
280 ins = in(i) + aa * ms(i)
281 stf = stifr(i) + aa * stifn(i)
282C
283 fxi=a(1,i)
284 fyi=a(2,i)
285 fzi=a(3,i)
286C
287 mxi = ar(1,i) + yc0 * fzi - zc0 * fyi
288 myi = ar(2,i) + zc0 * fxi - xc0 * fzi
289 mzi = ar(3,i) + xc0 * fyi - yc0 * fxi
290C
291 w = weight(i)
292 ai=aa * ms(i) * w
293 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
294 DO jj=1,4
295 j=irect(jj,l)
296 adi(j)=adi(j)+ai*h(jj)
297 END DO
298 END IF
299C
300 IF (h3d_data%N_VECT_CONT2M > 0) THEN
301 mcont2(1,i) = -ar(1,i)*w
302 mcont2(2,i) = -ar(2,i)*w
303 mcont2(3,i) = -ar(3,i)*w
304 DO jj=1,nir
305 j=irect(jj,l)
306 mcont2(1,j) = mcont2(1,j) + mxi*h(jj)*w
307 mcont2(2,j) = mcont2(2,j) + myi*h(jj)*w
308 mcont2(3,j) = mcont2(3,j) + mzi*h(jj)*w
309 ENDDO
310 ENDIF
311C
312 DO jj=1,4
313 j=irect(jj,l)
314 IF (msegtyp2(l)==1) THEN
315 ar(1,j)=ar(1,j)+mxi*h(jj)*w
316 ar(2,j)=ar(2,j)+myi*h(jj)*w
317 ar(3,j)=ar(3,j)+mzi*h(jj)*w
318 in(j)=in(j)+ins*h2(jj)*w
319 stifr(j)=stifr(j)+abs(stf*h(jj)*w)
320 END IF
321 ENDDO
322 stifr(i)=em20
323 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
324 in(i)=zero
325 stifn(i)=em20
326 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
327 ms(i)=zero
328 a(1,i)=zero
329 a(2,i)=zero
330 a(3,i)=zero
331 ENDIF
332C
333 ENDDO
334 ENDIF
335C
336C
337 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
338#include "vectorize.inc"
339 DO ii=1,nmn
340 j=msr(ii)
341 adi(j) = adi(j)/max(em20,nmas(ii))
342 ENDDO
343 ENDIF
344C
345 RETURN
346 END
i2mom27_cin
subroutine i2mom27_cin(nsn, nmn, ar, irect, crst, msr, nsv, irtl, in, ms, a, x, weight, stifr, stifn, idel2, smass, siner, nmas, adi, indxc, miner, h3d_data, msegtyp2, csts_bis)
Definition i2mom27_cin.F:36
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
outmax_mod
Definition outmax_mod.F:52