OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4mass3.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/.
23C
24!||====================================================================
25!|| s4mass3 ../starter/source/elements/solid/solide4/s4mass3.F
26!||--- called by ------------------------------------------------------
27!|| inirig_mat ../starter/source/elements/initia/inirig_mat.F
28!|| inivoid ../starter/source/elements/initia/inivoid.F
29!|| multifluid_init3t ../starter/source/multifluid/multifluid_init3t.F
30!|| s4init3 ../starter/source/elements/solid/solide4/s4init3.F
31!||--- calls -----------------------------------------------------
32!|| s4fraca ../starter/source/elements/solid/solide4/s4mass3.F
33!||--- uses -----------------------------------------------------
34!||====================================================================
35 SUBROUTINE s4mass3(
36 1 RHO ,MS ,PARTSAV,X ,V,
37 2 IPART,MSS,MSNF ,MSSF,WMA,
38 3 RHOCP,MCP,MCPS ,TEMP0 ,TEMP,
39 4 MSSA ,IX1 ,IX2 ,IX3 ,IX4,
40 5 FILL, VOLU ,IMAS_DS ,NINTEMP)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE ale_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "vect01_c.inc"
59#include "sms_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER, INTENT(IN) :: IMAS_DS
64 INTEGER, INTENT(IN) :: NINTEMP
65 INTEGER IPART(*), IX1(*), IX2(*), IX3(*), IX4(*)
66 my_real
67 . RHO(*), MS(*),X(3,*),V(3,*),PARTSAV(20,*),MSNF(*), MSS(8,*),
68 . mssf(8,*),wma(*), rhocp(*),mcps(8,*),temp(*),temp0(*),mcp(*),
69 . mssa(*), fill(*), volu(*)
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I,IP,I1,I2,I3,I4,j
74 my_real
75 . XX,YY,ZZ,XY,YZ,ZX, MASS(MVSIZ),RCP,PTG(4,MVSIZ)
76C
77C-----------------------------------------------------------------------
78 IF(isms==0)
79 . CALL s4fraca(x,ix1 ,ix2,ix3 ,ix4 ,ptg ,imas_ds )
80 DO i=lft,llt
81 mass(i)=fill(i)*rho(i)*volu(i)*fourth
82C
83 i1 = ix1(i)
84 i2 = ix2(i)
85 i3 = ix3(i)
86 i4 = ix4(i)
87C
88 IF(isms==0)THEN
89 mss(1,i)=mass(i)*ptg(1,i)
90 mss(3,i)=mass(i)*ptg(2,i)
91 mss(6,i)=mass(i)*ptg(3,i)
92 mss(5,i)=mass(i)*ptg(4,i)
93 ELSE
94 mss(1,i)=mass(i)
95 mss(3,i)=mass(i)
96 mss(6,i)=mass(i)
97 mss(5,i)=mass(i)
98 END IF
99C
100 mss(2,i)=zero
101 mss(4,i)=zero
102 mss(7,i)=zero
103 mss(8,i)=zero
104C
105 ip=ipart(i)
106 partsav(1,ip)=partsav(1,ip) + four*mass(i)
107 partsav(2,ip)=partsav(2,ip)
108 . + mass(i)*(x(1,i1)+x(1,i2)+x(1,i3)+x(1,i4))
109 partsav(3,ip)=partsav(3,ip)
110 . + mass(i)*(x(2,i1)+x(2,i2)+x(2,i3)+x(2,i4))
111 partsav(4,ip)=partsav(4,ip)
112 . + mass(i)*(x(3,i1)+x(3,i2)+x(3,i3)+x(3,i4))
113 xx = (x(1,i1)*x(1,i1)+x(1,i2)*x(1,i2)
114 . +x(1,i3)*x(1,i3)+x(1,i4)*x(1,i4))
115 xy = (x(1,i1)*x(2,i1)+x(1,i2)*x(2,i2)
116 . +x(1,i3)*x(2,i3)+x(1,i4)*x(2,i4))
117 yy = (x(2,i1)*x(2,i1)+x(2,i2)*x(2,i2)
118 . +x(2,i3)*x(2,i3)+x(2,i4)*x(2,i4))
119 yz = (x(2,i1)*x(3,i1)+x(2,i2)*x(3,i2)
120 . +x(2,i3)*x(3,i3)+x(2,i4)*x(3,i4))
121 zz = (x(3,i1)*x(3,i1)+x(3,i2)*x(3,i2)
122 . +x(3,i3)*x(3,i3)+x(3,i4)*x(3,i4))
123 zx = (x(3,i1)*x(1,i1)+x(3,i2)*x(1,i2)
124 . +x(3,i3)*x(1,i3)+x(3,i4)*x(1,i4))
125 partsav(5,ip) =partsav(5,ip) + mass(i) * (yy+zz)
126 partsav(6,ip) =partsav(6,ip) + mass(i) * (zz+xx)
127 partsav(7,ip) =partsav(7,ip) + mass(i) * (xx+yy)
128 partsav(8,ip) =partsav(8,ip) - mass(i) * xy
129 partsav(9,ip) =partsav(9,ip) - mass(i) * yz
130 partsav(10,ip)=partsav(10,ip) - mass(i) * zx
131C
132 partsav(11,ip)=partsav(11,ip)
133 . + mass(i)*(v(1,i1)+v(1,i2)+v(1,i3)+v(1,i4))
134 partsav(12,ip)=partsav(12,ip)
135 . + mass(i)*(v(2,i1)+v(2,i2)+v(2,i3)+v(2,i4))
136 partsav(13,ip)=partsav(13,ip)
137 . + mass(i)*(v(3,i1)+v(3,i2)+v(3,i3)+v(3,i4))
138 partsav(14,ip)=partsav(14,ip) + half * mass(i) *
139 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1)
140 . +v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2)
141 . +v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3)
142 . +v(1,i4)*v(1,i4)+v(2,i4)*v(2,i4)+v(3,i4)*v(3,i4))
143 ENDDO
144C
145 IF(irest_mselt /= 0)THEN
146 DO i=lft,llt
147 mssa(nft+i)=mass(i)
148 ENDDO
149 ENDIF
150C
151 IF(jale+jeul > 0)THEN
152 DO i=lft,llt
153 i1 = ix1(i)
154 i2 = ix2(i)
155 i3 = ix3(i)
156 i4 = ix4(i)
157 mssf(1,i)=mass(i)
158 mssf(3,i)=mass(i)
159 mssf(6,i)=mass(i)
160 mssf(5,i)=mass(i)
161 mssf(2,i)=zero
162 mssf(4,i)=zero
163 mssf(7,i)=zero
164 mssf(8,i)=zero
165 ENDDO
166 ENDIF
167C
168 IF(jthe < 0 ) THEN
169 DO i=lft,llt
170 rcp=fill(i)*rhocp(i)*volu(i)*fourth
171 mcps(1,i) = rcp
172 mcps(3,i) = rcp
173 mcps(5,i) = rcp
174 mcps(6,i) = rcp
175 mcps(2,i) = zero
176 mcps(4,i) = zero
177 mcps(7,i) = zero
178 mcps(8,i) = zero
179 ENDDO
180 ENDIF
181C
182 IF(jale > 0 .AND. ale%GRID%NWALE == 4)THEN
183 DO i=lft,llt
184 i1 = ix1(i)
185 i2 = ix2(i)
186 i3 = ix3(i)
187 i4 = ix4(i)
188 wma(i1)=wma(i1)+three_half
189 wma(i2)=wma(i2)+three_half
190 wma(i3)=wma(i3)+three_half
191 wma(i4)=wma(i4)+three_half
192 ENDDO
193 ENDIF
194C
195 IF(jthe < 0 ) THEN
196 IF(nintemp > 0 ) THEN
197 DO i=lft,llt
198 i1 = ix1(i)
199 i2 = ix2(i)
200 i3 = ix3(i)
201 i4 = ix4(i)
202 IF(temp(i1)== zero) temp(i1) = temp0(i)
203 IF(temp(i2)== zero) temp(i2) = temp0(i)
204 IF(temp(i3)== zero) temp(i3) = temp0(i)
205 IF(temp(i4)== zero) temp(i4) = temp0(i)
206 ENDDO
207 ELSE
208 DO i=lft,llt
209 i1 = ix1(i)
210 i2 = ix2(i)
211 i3 = ix3(i)
212 i4 = ix4(i)
213 temp(i1) = temp0(i)
214 temp(i2) = temp0(i)
215 temp(i3) = temp0(i)
216 temp(i4) = temp0(i)
217 ENDDO
218 ENDIF
219 ENDIF
220C-----------
221 RETURN
222 END
223!||====================================================================
224!|| s4frac ../starter/source/elements/solid/solide4/s4mass3.F
225!||--- calls -----------------------------------------------------
226!|| dis_n1n2 ../starter/source/elements/solid/solide4/s4mass3.F
227!||====================================================================
228 SUBROUTINE s4frac(X,IX1 ,IX2,IX3 ,IX4 ,PTG )
229C----------------------------------------------
230C MASS PARTITION IN FUNCTION OF NODAL ANGLES
231C-----------------------------------------------
232C I m p l i c i t T y p e s
233C-----------------------------------------------
234#include "implicit_f.inc"
235C-----------------------------------------------
236C G l o b a l P a r a m e t e r s
237C-----------------------------------------------
238#include "mvsiz_p.inc"
239C-----------------------------------------------
240C C o m m o n B l o c k s
241C-----------------------------------------------
242#include "vect01_c.inc"
243C-----------------------------------------------
244C D u m m y A r g u m e n t s
245C-----------------------------------------------
246 INTEGER IX1(*), IX2(*), IX3(*),IX4(*)
247 my_real
248 . X(3,*),PTG(4,*)
249C-----------------------------------------------
250C L o c a l V a r i a b l e s
251C-----------------------------------------------
252 INTEGER I,J,K,N,IP,I1,I2,I3,I4
253 my_real
254 . XX,YY,ZZ,XY,YZ,ZX,P1,P2,P3,P4,S
255 my_real
256 . A2(MVSIZ), B2(MVSIZ), C2(MVSIZ),D2(MVSIZ),E2(MVSIZ),F2(MVSIZ),
257 . aa(mvsiz), bb(mvsiz), cc(mvsiz),dd(mvsiz),ee(mvsiz),ff(mvsiz)
258C=======================================================================
259C----------------------------------------------
260C MASSES ELEMENTAIRES
261C----------------------------------------------
262C
263 CALL dis_n1n2(x,ix1,ix2,aa,a2 )
264 CALL dis_n1n2(x,ix2,ix3,bb,b2 )
265 CALL dis_n1n2(x,ix3,ix1,cc,c2 )
266 CALL dis_n1n2(x,ix2,ix4,dd,d2 )
267 CALL dis_n1n2(x,ix3,ix4,ee,e2 )
268 CALL dis_n1n2(x,ix1,ix4,ff,f2 )
269 DO i=lft,llt
270 p1 = acos((a2(i) + c2(i) - b2(i))/(two * aa(i) * cc(i)))
271 p2 = acos((a2(i) + f2(i) - d2(i))/(two * aa(i) * ff(i)))
272 p3 = acos((c2(i) + f2(i) - e2(i))/(two * cc(i) * ff(i)))
273 p1 = acos((a2(i) + c2(i) - b2(i))/(two * aa(i) * cc(i)))+
274 + acos((a2(i) + f2(i) - d2(i))/(two * aa(i) * ff(i)))+
275 + acos((c2(i) + f2(i) - e2(i))/(two * cc(i) * ff(i)))
276C
277 p2 = acos((a2(i) + b2(i) - c2(i))/(two * aa(i) * bb(i)))+
278 + acos((a2(i) + d2(i) - f2(i))/(two * aa(i) * dd(i)))+
279 + acos((d2(i) + b2(i) - e2(i))/(two * dd(i) * bb(i)))
280C
281 p3 = acos((b2(i) + c2(i) - a2(i))/(two * bb(i) * cc(i)))+
282 + acos((b2(i) + e2(i) - d2(i))/(two * bb(i) * ee(i)))+
283 + acos((e2(i) + c2(i) - f2(i))/(two * ee(i) * cc(i)))
284C
285 p4 = acos((f2(i) + d2(i) - a2(i))/(two * ff(i) * dd(i)))+
286 + acos((d2(i) + e2(i) - b2(i))/(two * dd(i) * ee(i)))+
287 + acos((e2(i) + f2(i) - c2(i))/(two * ee(i) * ff(i)))
288 ptg(1,i)=p1/pi
289 ptg(2,i)=p2/pi
290 ptg(3,i)=p3/pi
291 ptg(4,i)=p4/pi
292 s=ptg(1,i)+ptg(2,i)+ptg(3,i)+ptg(4,i)
293c PTG(1,I)=ONE
294c PTG(2,I)=ONE
295c PTG(3,I)=ONE
296c PTG(4,I)=ONE
297 END DO
298C
299C-----------
300 RETURN
301 END
302!||====================================================================
303!|| dis_n1n2 ../starter/source/elements/solid/solide4/s4mass3.F
304!||--- called by ------------------------------------------------------
305!|| s4frac ../starter/source/elements/solid/solide4/s4mass3.F
306!||====================================================================
307 SUBROUTINE dis_n1n2(X,N1 ,N2 ,S ,S2 )
308C----------------------------------------------
309C S=L(N1,N2)
310C-----------------------------------------------
311C I m p l i c i t T y p e s
312C-----------------------------------------------
313#include "implicit_f.inc"
314C-----------------------------------------------
315C C o m m o n B l o c k s
316C-----------------------------------------------
317#include "vect01_c.inc"
318C-----------------------------------------------
319C D u m m y A r g u m e n t s
320C-----------------------------------------------
321 INTEGER N1(*),N2(*)
322 my_real
323 . X(3,*),S(*),S2(*)
324C-----------------------------------------------
325C L o c a l V a r i a b l e s
326C-----------------------------------------------
327 INTEGER I,J,K
328 my_real
329 . XX,YY,ZZ,XY,YZ,ZX
330C=======================================================================
331 DO I=lft,llt
332 xx = x(1,n2(i))-x(1,n1(i))
333 yy = x(2,n2(i))-x(2,n1(i))
334 zz = x(3,n2(i))-x(3,n1(i))
335 s2(i) = xx*xx+yy*yy+zz*zz
336 s(i) = sqrt(s2(i))
337 END DO
338C-----------
339 RETURN
340 END
341!||====================================================================
342!|| s4fraca ../starter/source/elements/solid/solide4/s4mass3.F
343!||--- called by ------------------------------------------------------
344!|| s4mass3 ../starter/source/elements/solid/solide4/s4mass3.F
345!||--- calls -----------------------------------------------------
346!|| area_tria ../starter/source/elements/solid/solide4/s4mass3.F
347!||====================================================================
348 SUBROUTINE s4fraca(X,IX1 ,IX2,IX3 ,IX4 ,PTG ,IMAS_DS )
349C----------------------------------------------
350C MASS PARTITION IN FUNCTION OF NODAL ANGLES by AREA
351C-----------------------------------------------
352C I m p l i c i t T y p e s
353C-----------------------------------------------
354#include "implicit_f.inc"
355C-----------------------------------------------
356C G l o b a l P a r a m e t e r s
357C-----------------------------------------------
358#include "mvsiz_p.inc"
359C-----------------------------------------------
360C C o m m o n B l o c k s
361C-----------------------------------------------
362#include "vect01_c.inc"
363C-----------------------------------------------
364C D u m m y A r g u m e n t s
365C-----------------------------------------------
366 INTEGER, INTENT(IN) :: IMAS_DS
367 INTEGER IX1(*), IX2(*), IX3(*),IX4(*)
368 my_real
369 . X(3,*),PTG(4,*)
370C-----------------------------------------------
371C L o c a l V a r i a b l e s
372C-----------------------------------------------
373 INTEGER I,J,K,N,IP,I1,I2,I3,I4
374 my_real
375 . XX,YY,ZZ,XY,YZ,ZX,P1,P2,P3,P4,S
376 my_real
377 . A1(MVSIZ), A2(MVSIZ), A3(MVSIZ),A4(MVSIZ)
378C=======================================================================
379 IF (imas_ds==0) THEN
380 DO i=lft,llt
381 DO j=1,4
382 ptg(j,i)=one
383 END DO
384 END DO
385 RETURN
386 END IF
387C ------------Ai -> A (i)-----------
388 CALL area_tria(x,ix2,ix3,ix4, a1 )
389 CALL area_tria(x,ix1,ix3,ix4, a2 )
390 CALL area_tria(x,ix1,ix2,ix4, a3 )
391 CALL area_tria(x,ix1,ix2,ix3, a4 )
392 DO i=lft,llt
393 s = four/(a1(i) +a2(i) +a3(i) +a4(i))
394 ptg(1,i)=a1(i)*s
395 ptg(2,i)=a2(i)*s
396 ptg(3,i)=a3(i)*s
397 ptg(4,i)=a4(i)*s
398 END DO
399C
400C-----------
401 RETURN
402 END
403!||====================================================================
404!|| area_tria ../starter/source/elements/solid/solide4/s4mass3.F
405!||--- called by ------------------------------------------------------
406!|| s4fraca ../starter/source/elements/solid/solide4/s4mass3.F
407!|| s4fraca10 ../starter/source/elements/solid/solide10/s10mass3.F
408!||====================================================================
409 SUBROUTINE area_tria(X,N1 ,N2 ,N3, A2 )
410C----------------------------------------------
411C-----------------------------------------------
412C I m p l i c i t T y p e s
413C-----------------------------------------------
414#include "implicit_f.inc"
415C-----------------------------------------------
416C G l o b a l P a r a m e t e r s
417C-----------------------------------------------
418#include "mvsiz_p.inc"
419C-----------------------------------------------
420C C o m m o n B l o c k s
421C-----------------------------------------------
422#include "vect01_c.inc"
423C-----------------------------------------------
424C D u m m y A r g u m e n t s
425C-----------------------------------------------
426 INTEGER N1(*),N2(*),N3(*)
427 my_real
428 . X(3,*),A2(*)
429C-----------------------------------------------
430C L o c a l V a r i a b l e s
431C-----------------------------------------------
432 INTEGER I,J,K
433 my_real
434 . X1(MVSIZ),X2(MVSIZ),X3(MVSIZ),
435 . Y1(MVSIZ),Y2(MVSIZ),Y3(MVSIZ),
436 . Z1(MVSIZ),Z2(MVSIZ),Z3(MVSIZ),
437 . x13, y13, z13, x12, y12, z12,
438 . e3x, e3y, e3z, surf
439C=======================================================================
440 DO i=lft,llt
441 x1(i)=x(1,n1(i))
442 y1(i)=x(2,n1(i))
443 z1(i)=x(3,n1(i))
444 x2(i)=x(1,n2(i))
445 y2(i)=x(2,n2(i))
446 z2(i)=x(3,n2(i))
447 x3(i)=x(1,n3(i))
448 y3(i)=x(2,n3(i))
449 z3(i)=x(3,n3(i))
450 ENDDO
451 DO i=lft,llt
452 x13=x3(i)-x1(i)
453 y13=y3(i)-y1(i)
454 z13=z3(i)-z1(i)
455 x12=x2(i)-x1(i)
456 y12=y2(i)-y1(i)
457 z12=z2(i)-z1(i)
458 e3x=y12*z13-z12*y13
459 e3y=z12*x13-x12*z13
460 e3z=x12*y13-y12*x13
461 a2(i)=sqrt(fourth*(e3x*e3x+e3y*e3y+e3z*e3z))
462 ENDDO
463C-----------
464 RETURN
465 END
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
s4fraca
subroutine s4fraca(x, ix1, ix2, ix3, ix4, ptg, imas_ds)
Definition s4mass3.F:349
s4frac
subroutine s4frac(x, ix1, ix2, ix3, ix4, ptg)
Definition s4mass3.F:229
s4mass3
subroutine s4mass3(rho, ms, partsav, x, v, ipart, mss, msnf, mssf, wma, rhocp, mcp, mcps, temp0, temp, mssa, ix1, ix2, ix3, ix4, fill, volu, imas_ds, nintemp)
Definition s4mass3.F:41
dis_n1n2
subroutine dis_n1n2(x, n1, n2, s, s2)
Definition s4mass3.F:308
area_tria
subroutine area_tria(x, n1, n2, n3, a2)
Definition s4mass3.F:410