OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
smass3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine smass3 (rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)

Function/Subroutine Documentation

◆ smass3()

subroutine smass3 ( rho,
ms,
partsav,
x,
v,
integer, dimension(*) ipart,
mss,
volu,
msnf,
mssf,
in,
vr,
ins,
wma,
rhocp,
mcp,
mcps,
mssa,
rhof,
frac,
fill,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) nc5,
integer, dimension(*) nc6,
integer, dimension(*) nc7,
integer, dimension(*) nc8 )

Definition at line 37 of file smass3.F.

44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47 USE ale_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C G l o b a l P a r a m e t e r s
54C-----------------------------------------------
55#include "mvsiz_p.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER IPART(*),NDDIM
60 my_real
61 . rho(*),ms(*),x(3,*),v(3,*),partsav(20,*),volu(*),
62 . mss(8,*), mssf(8,*), msnf(*),in(*),vr(3,*),ins(8,*),wma(*),
63 . rhocp(*),mcp(*),mcps(8,*), mssa(*), rhof(*), frac(*), fill(*)
64 INTEGER NC1(*), NC2(*), NC3(*), NC4(*), NC5(*), NC6(*), NC7(*), NC8(*)
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "com01_c.inc"
69#include "vect01_c.inc"
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I, J, IP,I1,I2,I3,I4,I5,I6,I7,I8
74 my_real xx,yy,zz,xy,yz,zx, massp,iner,rcp
75 my_real mass(mvsiz),massf(mvsiz)
76C-------------------------------
77C=======================================================================
78 DO i=lft,llt
79 mass(i) =fill(i)*rho(i)*volu(i)*one_over_8
80 massf(i) =fill(i)*frac(i)*rhof(i)*volu(i)*one_over_8
81 i1 = nc1(i)
82 i2 = nc2(i)
83 i3 = nc3(i)
84 i4 = nc4(i)
85 i5 = nc5(i)
86 i6 = nc6(i)
87 i7 = nc7(i)
88 i8 = nc8(i)
89 mss(1,i)=mass(i)
90 mss(2,i)=mass(i)
91 mss(3,i)=mass(i)
92 mss(4,i)=mass(i)
93 mss(5,i)=mass(i)
94 mss(6,i)=mass(i)
95 mss(7,i)=mass(i)
96 mss(8,i)=mass(i)
97C
98 ip=ipart(i)
99 partsav(1,ip)=partsav(1,ip) + eight*mass(i)
100 partsav(2,ip)=partsav(2,ip) + mass(i)*
101 . (x(1,i1)+x(1,i2)+x(1,i3)+x(1,i4)
102 . +x(1,i5)+x(1,i6)+x(1,i7)+x(1,i8))
103 partsav(3,ip)=partsav(3,ip) + mass(i)*
104 . (x(2,i1)+x(2,i2)+x(2,i3)+x(2,i4)
105 . +x(2,i5)+x(2,i6)+x(2,i7)+x(2,i8))
106 partsav(4,ip)=partsav(4,ip) + mass(i)*
107 . (x(3,i1)+x(3,i2)+x(3,i3)+x(3,i4)
108 . +x(3,i5)+x(3,i6)+x(3,i7)+x(3,i8))
109 xx = (x(1,i1)*x(1,i1)+x(1,i2)*x(1,i2)
110 . +x(1,i3)*x(1,i3)+x(1,i4)*x(1,i4)
111 . +x(1,i5)*x(1,i5)+x(1,i6)*x(1,i6)
112 . +x(1,i7)*x(1,i7)+x(1,i8)*x(1,i8))
113 xy = (x(1,i1)*x(2,i1)+x(1,i2)*x(2,i2)
114 . +x(1,i3)*x(2,i3)+x(1,i4)*x(2,i4)
115 . +x(1,i5)*x(2,i5)+x(1,i6)*x(2,i6)
116 . +x(1,i7)*x(2,i7)+x(1,i8)*x(2,i8))
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 . +x(2,i5)*x(2,i5)+x(2,i6)*x(2,i6)
120 . +x(2,i7)*x(2,i7)+x(2,i8)*x(2,i8))
121 yz = (x(2,i1)*x(3,i1)+x(2,i2)*x(3,i2)
122 . +x(2,i3)*x(3,i3)+x(2,i4)*x(3,i4)
123 . +x(2,i5)*x(3,i5)+x(2,i6)*x(3,i6)
124 . +x(2,i7)*x(3,i7)+x(2,i8)*x(3,i8))
125 zz = (x(3,i1)*x(3,i1)+x(3,i2)*x(3,i2)
126 . +x(3,i3)*x(3,i3)+x(3,i4)*x(3,i4)
127 . +x(3,i5)*x(3,i5)+x(3,i6)*x(3,i6)
128 . +x(3,i7)*x(3,i7)+x(3,i8)*x(3,i8))
129 zx = (x(3,i1)*x(1,i1)+x(3,i2)*x(1,i2)
130 . +x(3,i3)*x(1,i3)+x(3,i4)*x(1,i4)
131 . +x(3,i5)*x(1,i5)+x(3,i6)*x(1,i6)
132 . +x(3,i7)*x(1,i7)+x(3,i8)*x(1,i8))
133 partsav(5,ip) =partsav(5,ip) + mass(i) * (yy+zz)
134 partsav(6,ip) =partsav(6,ip) + mass(i) * (zz+xx)
135 partsav(7,ip) =partsav(7,ip) + mass(i) * (xx+yy)
136 partsav(8,ip) =partsav(8,ip) - mass(i) * xy
137 partsav(9,ip) =partsav(9,ip) - mass(i) * yz
138 partsav(10,ip)=partsav(10,ip) - mass(i) * zx
139C
140 partsav(11,ip)=partsav(11,ip) + mass(i)*
141 . (v(1,i1)+v(1,i2)+v(1,i3)+v(1,i4)
142 . +v(1,i5)+v(1,i6)+v(1,i7)+v(1,i8))
143 partsav(12,ip)=partsav(12,ip) + mass(i)*
144 . (v(2,i1)+v(2,i2)+v(2,i3)+v(2,i4)
145 . +v(2,i5)+v(2,i6)+v(2,i7)+v(2,i8))
146 partsav(13,ip)=partsav(13,ip) + mass(i)*
147 . (v(3,i1)+v(3,i2)+v(3,i3)+v(3,i4)
148 . +v(3,i5)+v(3,i6)+v(3,i7)+v(3,i8))
149 partsav(14,ip)=partsav(14,ip) + half * mass(i) *
150 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1)
151 . +v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2)
152 . +v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3)
153 . +v(1,i4)*v(1,i4)+v(2,i4)*v(2,i4)+v(3,i4)*v(3,i4)
154 . +v(1,i5)*v(1,i5)+v(2,i5)*v(2,i5)+v(3,i5)*v(3,i5)
155 . +v(1,i6)*v(1,i6)+v(2,i6)*v(2,i6)+v(3,i6)*v(3,i6)
156 . +v(1,i7)*v(1,i7)+v(2,i7)*v(2,i7)+v(3,i7)*v(3,i7)
157 . +v(1,i8)*v(1,i8)+v(2,i8)*v(2,i8)+v(3,i8)*v(3,i8))
158 ENDDO
159C
160 IF(irest_mselt /= 0)THEN
161 DO i=lft,llt
162 mssa(nft+i)=mass(i)
163 ENDDO
164 ENDIF
165C
166 IF(jale == 3 .AND. jlag == 1)THEN
167 DO i=lft,llt
168 i1 = nc1(i)
169 i2 = nc2(i)
170 i3 = nc3(i)
171 i4 = nc4(i)
172 i5 = nc5(i)
173 i6 = nc6(i)
174 i7 = nc7(i)
175 i8 = nc8(i)
176 mssf(1,i)=massf(i)
177 mssf(2,i)=massf(i)
178 mssf(3,i)=massf(i)
179 mssf(4,i)=massf(i)
180 mssf(5,i)=massf(i)
181 mssf(6,i)=massf(i)
182 mssf(7,i)=massf(i)
183 mssf(8,i)=massf(i)
184 ENDDO
185 ELSEIF(jale+jeul > 0)THEN
186 DO i=lft,llt
187 i1 = nc1(i)
188 i2 = nc2(i)
189 i3 = nc3(i)
190 i4 = nc4(i)
191 i5 = nc5(i)
192 i6 = nc6(i)
193 i7 = nc7(i)
194 i8 = nc8(i)
195 mssf(1,i)=mass(i)
196 mssf(2,i)=mass(i)
197 mssf(3,i)=mass(i)
198 mssf(4,i)=mass(i)
199 mssf(5,i)=mass(i)
200 mssf(6,i)=mass(i)
201 mssf(7,i)=mass(i)
202 mssf(8,i)=mass(i)
203 ENDDO
204 ENDIF
205C
206 IF(jthe < 0 ) THEN
207 DO i=lft,llt
208 rcp=fill(i)*rhocp(i)*volu(i)*one_over_8
209 mcps(1,i) =rcp
210 mcps(2,i)= rcp
211 mcps(3,i)= rcp
212 mcps(4,i)= rcp
213 mcps(5,i)= rcp
214 mcps(6,i)= rcp
215 mcps(7,i)= rcp
216 mcps(8,i)= rcp
217 ENDDO
218 ENDIF
219C
220 IF(isrot == 1)THEN
221 IF(iroddl == 0)THEN
222C prov gw
223 WRITE(6,'(A)') 'INTERNAL ERROR 1119'
224 CALL my_exit(2)
225C STOP 1119
226 ENDIF
227 DO i=lft,llt
228 iner=(mass(i)*volu(i)**two_third)/six
229 ins(1,i)=iner
230 ins(2,i)=iner
231 ins(3,i)=iner
232 ins(4,i)=iner
233 ins(5,i)=iner
234 ins(6,i)=iner
235 ins(7,i)=iner
236 ins(8,i)=iner
237 ENDDO
238 ENDIF
239C
240 IF(jale > 0 .AND. ale%GRID%NWALE == 4)THEN
241 DO i=lft,llt
242 i1 = nc1(i)
243 i2 = nc2(i)
244 i3 = nc3(i)
245 i4 = nc4(i)
246 i5 = nc5(i)
247 i6 = nc6(i)
248 i7 = nc7(i)
249 i8 = nc8(i)
250 wma(i1)=wma(i1)+three_half
251 wma(i2)=wma(i2)+three_half
252 wma(i3)=wma(i3)+three_half
253 wma(i4)=wma(i4)+three_half
254 wma(i5)=wma(i5)+three_half
255 wma(i6)=wma(i6)+three_half
256 wma(i7)=wma(i7)+three_half
257 wma(i8)=wma(i8)+three_half
258 ENDDO
259 ENDIF
260C-----------
261 RETURN
my_exit
void my_exit(int *i)
Definition analyse.c:1038
my_real
#define my_real
Definition cppsort.cpp:32
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249