OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
amass3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "inter22.inc"
#include "com01_c.inc"
#include "lockon.inc"
#include "vectorize.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine amass3 (ms, rho, volgp, tag22, volu, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, msnf, nvc, off, ixs, nel, jeul)

Function/Subroutine Documentation

◆ amass3()

subroutine amass3 ( ms,
rho,
volgp,
tag22,
volu,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) nc5,
integer, dimension(*) nc6,
integer, dimension(*) nc7,
integer, dimension(*) nc8,
msnf,
integer nvc,
off,
integer, dimension(nixs,*) ixs,
integer, intent(in) nel,
integer, intent(in) jeul )

Definition at line 33 of file amass3.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
43 use element_mod , only : nixs
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48#include "comlock.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"
53#include "param_c.inc"
54#include "inter22.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER, INTENT(IN) :: NEL
59 INTEGER, INTENT(IN) :: JEUL
61 . ms(*), rho(*),volu(*),volgp(lveul,*),
62 . msnf(*),off(*),tag22(*)
63 INTEGER NC1(*),NC2(*),NC3(*),NC4(*),NC5(*),NC6(*),NC7(*),NC8(*)
64 INTEGER NVC,IXS(NIXS,*)
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "com01_c.inc"
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I,IFLAG,MCELL,NIN,ICELL,NCELL,IB,J
73 my_real dmass(mvsiz),fac
74 INTEGER NVC1,NVC2,NVC3,NVC4,NVC5,NVC6,NVC7,NVC8
75 my_real tnod(mvsiz,8)
76C-----------------------------------------------
77 nvc1 = nvc / 128
78 nvc2 = (nvc-nvc1*128) / 64
79 nvc3 = (nvc-nvc1*128-nvc2*64) / 32
80 nvc4 = (nvc-nvc1*128-nvc2*64-nvc3*32)/16
81 nvc5 = (nvc-nvc1*128-nvc2*64-nvc3*32-nvc4*16)/8
82 nvc6 = (nvc-nvc1*128-nvc2*64-nvc3*32-nvc4*16-nvc5*8)/4
83 nvc7 = (nvc-nvc1*128-nvc2*64-nvc3*32-nvc4*16-nvc5*8-nvc6*4)/2
84 nvc8 = nvc-nvc1*128-nvc2*64-nvc3*32-nvc4*16-nvc5*8-nvc6*4-nvc7*2
85 iflag=integ8*jeul
86
87 nin = 1
88 fac = zero
89
90 !--------------------------------------------------------------------------!
91 ! COMPUTE ELEMENTARY MASS AND ITS DISTRIBUTION ON NODES. !
92 ! FOR CUT CELL TNOD(1:8,I) ENABLE TO DISTRIBUTE MASS TO RELATED NODES ONLY !
93 !--------------------------------------------------------------------------!
94 IF(iflag/=1)THEN
95 IF(int22==0)THEN
96 !DEFAULT FORMULATION
97 tnod(1:nel,1:8) = one
98 DO i=1,nel
99 dmass(i)=one_over_8*rho(i)*volu(i)*off(i)
100 ENDDO
101 !INTERFACE 22 : CUT CELLS
102 ELSE
103 DO i=1,nel
104 ib = nint(tag22(i))
105 IF(ib>0)THEN
106 ncell = brick_list(nin,ib)%NBCUT
107 IF(ncell==0)THEN
108 tnod(i,1:8) = one
109 dmass(i)=one_over_8*rho(i)*volu(i)*off(i)
110 cycle
111 ENDIF
112 tnod(i,1:8) = zero
113 mcell = brick_list(nin,ib)%mainID
114 IF(mcell==0)cycle ! next Main Cell
115 fac = brick_list(nin,ib)%POLY(mcell)%NumNOD
116 IF(fac>0)THEN
117 fac=one/fac
118 DO j=1,8
119 icell=brick_list(nin,ib)%NODE(j)%WhichCell
120 IF(icell/=mcell)cycle
121 tnod(i,j) = one !this node is used by polyhedron
122 ENDDO
123 ELSE
124 fac = zero
125 ENDIF
126 ELSE
127 fac = one_over_8
128 tnod(i,1:8) = one !uncut cell distributes centroid mass to all 8 nodes
129 ENDIF
130 dmass(i)=fac*rho(i)*volu(i)*off(i)
131 ENDDO
132 ENDIF
133 endif!IFLAG=1
134C
135#include "lockon.inc"
136 IF(iflag/=0)THEN
137 DO i=1,nel
138 dmass(i)=rho(i)*volgp(1,i)*off(i)
139 ENDDO
140 ENDIF
141
142 !---------------------------------------------!
143 ! NODAL MASS : ELEMENTARY MASS IS DISTRIBUTED !
144 !---------------------------------------------!
145 IF(nvc1==0)THEN
146#include "vectorize.inc"
147 DO i=1,nel
148 ms(nc1(i)) = ms(nc1(i)) + tnod(i,1)*dmass(i) !by default all nodes are tagged. For cut cells only nodes defining the polyhedron is tagged
149 msnf(nc1(i)) = msnf(nc1(i)) + tnod(i,1)*dmass(i)
150 ENDDO
151 ELSE
152 DO i=1,nel
153 ms(nc1(i)) = ms(nc1(i)) + tnod(i,1)*dmass(i)
154 msnf(nc1(i)) = msnf(nc1(i)) + tnod(i,1)*dmass(i)
155 ENDDO
156 ENDIF
157C
158 IF(iflag/=0)THEN
159 DO i=1,nel
160 dmass(i)=rho(i)*volgp(2,i)*off(i)
161 ENDDO
162 ENDIF
163 IF(nvc2==0)THEN
164#include "vectorize.inc"
165 DO i=1,nel
166 ms(nc2(i)) = ms(nc2(i)) + tnod(i,2)*dmass(i)
167 msnf(nc2(i)) = msnf(nc2(i)) + tnod(i,2)*dmass(i)
168 ENDDO
169 ELSE
170 DO i=1,nel
171 ms(nc2(i)) = ms(nc2(i)) + tnod(i,2)*dmass(i)
172 msnf(nc2(i)) = msnf(nc2(i)) + tnod(i,2)*dmass(i)
173 ENDDO
174 ENDIF
175C
176 IF(iflag/=0)THEN
177 DO i=1,nel
178 dmass(i)=rho(i)*volgp(3,i)*off(i)
179 ENDDO
180 ENDIF
181 IF(nvc3==0)THEN
182#include "vectorize.inc"
183 DO i=1,nel
184 ms(nc3(i)) = ms(nc3(i)) + tnod(i,3)*dmass(i)
185 msnf(nc3(i)) = msnf(nc3(i)) + tnod(i,3)*dmass(i)
186 ENDDO
187 ELSE
188 DO i=1,nel
189 ms(nc3(i)) = ms(nc3(i)) + tnod(i,3)*dmass(i)
190 msnf(nc3(i)) = msnf(nc3(i)) + tnod(i,3)*dmass(i)
191 ENDDO
192 ENDIF
193C
194 IF(iflag/=0)THEN
195 DO i=1,nel
196 dmass(i)=rho(i)*volgp(4,i)*off(i)
197 ENDDO
198 ENDIF
199 IF(nvc4==0)THEN
200#include "vectorize.inc"
201 DO i=1,nel
202 ms(nc4(i)) = ms(nc4(i)) + tnod(i,4)*dmass(i)
203 msnf(nc4(i)) = msnf(nc4(i)) + tnod(i,4)*dmass(i)
204 ENDDO
205 ELSE
206 DO i=1,nel
207 ms(nc4(i)) = ms(nc4(i)) + tnod(i,4)*dmass(i)
208 msnf(nc4(i)) = msnf(nc4(i)) + tnod(i,4)*dmass(i)
209 ENDDO
210 ENDIF
211C
212 IF(iflag/=0)THEN
213 DO i=1,nel
214 dmass(i)=rho(i)*volgp(5,i)*off(i)
215 ENDDO
216 ENDIF
217 IF(nvc5==0)THEN
218#include "vectorize.inc"
219 DO i=1,nel
220 ms(nc5(i)) = ms(nc5(i)) + tnod(i,5)*dmass(i)
221 msnf(nc5(i)) = msnf(nc5(i)) + tnod(i,5)*dmass(i)
222 ENDDO
223 ELSE
224 DO i=1,nel
225 ms(nc5(i)) = ms(nc5(i)) + tnod(i,5)*dmass(i)
226 msnf(nc5(i)) = msnf(nc5(i)) + tnod(i,5)*dmass(i)
227 ENDDO
228 ENDIF
229C
230 IF(iflag/=0)THEN
231 DO i=1,nel
232 dmass(i)=rho(i)*volgp(6,i)*off(i)
233 ENDDO
234 ENDIF
235 IF(nvc6==0)THEN
236#include "vectorize.inc"
237 DO i=1,nel
238 ms(nc6(i)) = ms(nc6(i)) + tnod(i,6)*dmass(i)
239 msnf(nc6(i)) = msnf(nc6(i)) + tnod(i,6)*dmass(i)
240 ENDDO
241 ELSE
242 DO i=1,nel
243 ms(nc6(i)) = ms(nc6(i)) + tnod(i,6)*dmass(i)
244 msnf(nc6(i)) = msnf(nc6(i)) + tnod(i,6)*dmass(i)
245 ENDDO
246 ENDIF
247C
248 IF(iflag/=0)THEN
249 DO i=1,nel
250 dmass(i)=rho(i)*volgp(7,i)*off(i)
251 ENDDO
252 ENDIF
253 IF(nvc7==0)THEN
254#include "vectorize.inc"
255 DO i=1,nel
256 ms(nc7(i)) = ms(nc7(i)) + tnod(i,7)*dmass(i)
257 msnf(nc7(i)) = msnf(nc7(i)) + tnod(i,7)*dmass(i)
258 ENDDO
259 ELSE
260 DO i=1,nel
261 ms(nc7(i)) = ms(nc7(i)) + tnod(i,7)*dmass(i)
262 msnf(nc7(i)) = msnf(nc7(i)) + tnod(i,7)*dmass(i)
263 ENDDO
264 ENDIF
265C
266 IF(iflag/=0)THEN
267 DO i=1,nel
268 dmass(i)=rho(i)*volgp(8,i)*off(i)
269 ENDDO
270 ENDIF
271 IF(nvc8==0)THEN
272#include "vectorize.inc"
273 DO i=1,nel
274 ms(nc8(i)) = ms(nc8(i)) + tnod(i,8)*dmass(i)
275 msnf(nc8(i)) = msnf(nc8(i)) + tnod(i,8)*dmass(i)
276 ENDDO
277 ELSE
278 DO i=1,nel
279 ms(nc8(i)) = ms(nc8(i)) + tnod(i,8)*dmass(i)
280 msnf(nc8(i)) = msnf(nc8(i)) + tnod(i,8)*dmass(i)
281 ENDDO
282 ENDIF
283#include "lockoff.inc"
284C
285 RETURN
#define my_real
Definition cppsort.cpp:32
type(brick_entity), dimension(:,:), allocatable, target brick_list