OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s6mass3.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!|| s6mass3 ../starter/source/elements/thickshell/solide6c/s6mass3.F
25!||--- called by ------------------------------------------------------
26!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
27!||--- calls -----------------------------------------------------
28!|| s6fraca ../starter/source/elements/thickshell/solide6c/s6fraca3.F
29!||====================================================================
30 SUBROUTINE s6mass3(RHO,MS,PARTSAV,X,V,IPART,MSS,
31 . RHOCP,MCP ,MCPS,MSSA,FILL, VOLU,
32 . NC1, NC2, NC3, NC4, NC5, NC6,IMAS_DS)
33C
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C G l o b a l P a r a m e t e r s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER, INTENT(IN) :: IMAS_DS
46 INTEGER IPART(*),
47 . nc1(*), nc2(*), nc3(*), nc4(*), nc5(*), nc6(*)
48 my_real
49 . rho(*), ms(*),x(3,*),v(3,*),partsav(20,*),
50 . rhocp(*), mcp(*), mcps(8,*), mssa(*), fill(*), volu(*)
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com01_c.inc"
55#include "vect01_c.inc"
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, IP,I1,I2,I3,I4,I5,I6, J
60 my_real
61 . xx,yy,zz,xy,yz,zx,mass(mvsiz),mss(8,*), massp,ptg(mvsiz,3)
62C-----------------------------------------------------------------------
63 CALL s6fraca(x,nc1, nc2, nc3, nc4, nc5, nc6 ,ptg ,llt ,imas_ds)
64 DO i=lft,llt
65 mass(i)=fill(i)*rho(i)*volu(i)*one_over_6
66 i1 = nc1(i)
67 i2 = nc2(i)
68 i3 = nc3(i)
69 i4 = nc4(i)
70 i5 = nc5(i)
71 i6 = nc6(i)
72 mss(1,i)=mass(i)*ptg(i,1)
73 mss(2,i)=mass(i)*ptg(i,2)
74 mss(3,i)=mass(i)*ptg(i,3)
75 mss(4,i)=zero
76 mss(5,i)=mass(i)*ptg(i,1)
77 mss(6,i)=mass(i)*ptg(i,2)
78 mss(7,i)=mass(i)*ptg(i,3)
79 mss(8,i)=zero
80C
81 ip=ipart(i)
82 partsav(1,ip)=partsav(1,ip) + six*mass(i)
83 partsav(2,ip)=partsav(2,ip) + mass(i)*
84 . (x(1,i1)+x(1,i2)+x(1,i3)+x(1,i4)
85 . +x(1,i5)+x(1,i6))
86 partsav(3,ip)=partsav(3,ip) + mass(i)*
87 . (x(2,i1)+x(2,i2)+x(2,i3)+x(2,i4)
88 . +x(2,i5)+x(2,i6))
89 partsav(4,ip)=partsav(4,ip) + mass(i)*
90 . (x(3,i1)+x(3,i2)+x(3,i3)+x(3,i4)
91 . +x(3,i5)+x(3,i6))
92 xx = (x(1,i1)*x(1,i1)+x(1,i2)*x(1,i2)
93 . +x(1,i3)*x(1,i3)+x(1,i4)*x(1,i4)
94 . +x(1,i5)*x(1,i5)+x(1,i6)*x(1,i6)
95 . )
96 xy = (x(1,i1)*x(2,i1)+x(1,i2)*x(2,i2)
97 . +x(1,i3)*x(2,i3)+x(1,i4)*x(2,i4)
98 . +x(1,i5)*x(2,i5)+x(1,i6)*x(2,i6)
99 . )
100 yy = (x(2,i1)*x(2,i1)+x(2,i2)*x(2,i2)
101 . +x(2,i3)*x(2,i3)+x(2,i4)*x(2,i4)
102 . +x(2,i5)*x(2,i5)+x(2,i6)*x(2,i6)
103 . )
104 yz = (x(2,i1)*x(3,i1)+x(2,i2)*x(3,i2)
105 . +x(2,i3)*x(3,i3)+x(2,i4)*x(3,i4)
106 . +x(2,i5)*x(3,i5)+x(2,i6)*x(3,i6)
107 . )
108 zz = (x(3,i1)*x(3,i1)+x(3,i2)*x(3,i2)
109 . +x(3,i3)*x(3,i3)+x(3,i4)*x(3,i4)
110 . +x(3,i5)*x(3,i5)+x(3,i6)*x(3,i6)
111 . )
112 zx = (x(3,i1)*x(1,i1)+x(3,i2)*x(1,i2)
113 . +x(3,i3)*x(1,i3)+x(3,i4)*x(1,i4)
114 . +x(3,i5)*x(1,i5)+x(3,i6)*x(1,i6)
115 . )
116 partsav(5,ip) =partsav(5,ip) + mass(i) * (yy+zz)
117 partsav(6,ip) =partsav(6,ip) + mass(i) * (zz+xx)
118 partsav(7,ip) =partsav(7,ip) + mass(i) * (xx+yy)
119 partsav(8,ip) =partsav(8,ip) - mass(i) * xy
120 partsav(9,ip) =partsav(9,ip) - mass(i) * yz
121 partsav(10,ip)=partsav(10,ip) - mass(i) * zx
122C
123 partsav(11,ip)=partsav(11,ip) + mass(i)*
124 . (v(1,i1)+v(1,i2)+v(1,i3)+v(1,i4)
125 . +v(1,i5)+v(1,i6))
126 partsav(12,ip)=partsav(12,ip) + mass(i)*
127 . (v(2,i1)+v(2,i2)+v(2,i3)+v(2,i4)
128 . +v(2,i5)+v(2,i6))
129 partsav(13,ip)=partsav(13,ip) + mass(i)*
130 . (v(3,i1)+v(3,i2)+v(3,i3)+v(3,i4)
131 . +v(3,i5)+v(3,i6))
132 partsav(14,ip)=partsav(14,ip) + half * mass(i) *
133 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1)
134 . +v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2)
135 . +v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3)
136 . +v(1,i4)*v(1,i4)+v(2,i4)*v(2,i4)+v(3,i4)*v(3,i4)
137 . +v(1,i5)*v(1,i5)+v(2,i5)*v(2,i5)+v(3,i5)*v(3,i5)
138 . +v(1,i6)*v(1,i6)+v(2,i6)*v(2,i6)+v(3,i6)*v(3,i6)
139 . )
140 ENDDO
141C
142 IF(irest_mselt /= 0)THEN
143 DO i=lft,llt
144 mssa(i)=mass(i)
145 ENDDO
146 ENDIF
147C
148C --- for FEM solid heat transfer
149C
150 IF(jthe < 0 ) THEN
151 DO i=lft,llt
152 massp=fill(i)*rhocp(i)*volu(i)*one_over_6
153 i1 = nc1(i)
154 i2 = nc2(i)
155 i3 = nc3(i)
156 i4 = nc4(i)
157 i5 = nc5(i)
158 i6 = nc6(i)
159 mcps(1,i)=massp*ptg(i,1)
160 mcps(2,i)=massp*ptg(i,2)
161 mcps(3,i)=massp*ptg(i,3)
162 mcps(4,i)=zero
163 mcps(5,i)=massp*ptg(i,1)
164 mcps(6,i)=massp*ptg(i,2)
165 mcps(7,i)=massp*ptg(i,3)
166 mcps(8,i)=zero
167 ENDDO
168 ENDIF
169C
170 RETURN
171 END
my_real
#define my_real
Definition cppsort.cpp:32
s6fraca
subroutine s6fraca(x, ix1, ix2, ix3, ix4, ix5, ix6, ptg, nel, imas_ds)
Definition s6fraca3.F:29
s6mass3
subroutine s6mass3(rho, ms, partsav, x, v, ipart, mss, rhocp, mcp, mcps, mssa, fill, volu, nc1, nc2, nc3, nc4, nc5, nc6, imas_ds)
Definition s6mass3.F:33