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

Go to the source code of this file.

Functions/Subroutines

subroutine multi_computevolume (nel, ng, iparg, sym, elbuf_tab, ixs, ixq, ixtg, volnew, xgrid)

Function/Subroutine Documentation

◆ multi_computevolume()

subroutine multi_computevolume ( integer, intent(in) nel,
integer, intent(in) ng,
integer, dimension(nparg, ngroup), intent(in) iparg,
integer, intent(in) sym,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nixs, numels), intent(in), target ixs,
integer, dimension(nixq, numelq), intent(in), target ixq,
integer, dimension(nixtg, numeltg), intent(in), target ixtg,
dimension(nel), intent(inout) volnew,
dimension(3, numnod), intent(in) xgrid )

Definition at line 35 of file multi_computevolume.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41 use element_mod , only : nixs,nixq,nixtg
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "param_c.inc"
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "mvsiz_p.inc"
53#include "vect01_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER, INTENT(IN) :: NG, NEL, IPARG(NPARG, NGROUP) , SYM
58 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
59 INTEGER, INTENT(IN), TARGET :: IXS(NIXS, NUMELS), IXQ(NIXQ, NUMELQ), IXTG(NIXTG, NUMELTG)
60 my_real, INTENT(INOUT) :: volnew(nel)
61 my_real, INTENT(IN) :: xgrid(3, numnod)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 TYPE(G_BUFEL_), POINTER :: GBUF
66 INTEGER :: II, NGL(MVSIZ), ISOLNOD
67 DOUBLE PRECISION :: X1(MVSIZ), Y1(MVSIZ), Z1(MVSIZ)
68 DOUBLE PRECISION :: X2(MVSIZ), Y2(MVSIZ), Z2(MVSIZ)
69 DOUBLE PRECISION :: X3(MVSIZ), Y3(MVSIZ), Z3(MVSIZ)
70 DOUBLE PRECISION :: X4(MVSIZ), Y4(MVSIZ), Z4(MVSIZ)
71 DOUBLE PRECISION :: X5(MVSIZ), Y5(MVSIZ), Z5(MVSIZ)
72 DOUBLE PRECISION :: X6(MVSIZ), Y6(MVSIZ), Z6(MVSIZ)
73 DOUBLE PRECISION :: X7(MVSIZ), Y7(MVSIZ), Z7(MVSIZ)
74 DOUBLE PRECISION :: X8(MVSIZ), Y8(MVSIZ), Z8(MVSIZ)
75 my_real :: y124(mvsiz), y234(mvsiz)
76 my_real :: jac1(mvsiz), jac2(mvsiz), jac3(mvsiz)
77 my_real :: jac4(mvsiz), jac5(mvsiz), jac6(mvsiz)
78 my_real :: b1, b2, b3, b4
79 my_real :: c1, c2, c3, c4
80 my_real :: d1, d2, d3, d4
81 my_real :: x43, x41, x42, y43, y41, y42, z43, z41, z42
82 my_real :: dummy(mvsiz)
83 INTEGER, DIMENSION(:,:), POINTER :: IX
84 DOUBLE PRECISION :: VOLDP(MVSIZ)
85C-----------------------------------------------------------
86 gbuf => elbuf_tab(ng)%GBUF
87 jeul = iparg(11, ng)
88 isolnod = iparg(28, ng)
89 nft = iparg(3, ng)
90 ity = iparg(5, ng)
91 jhbe = iparg(23,ng)
92 ismstr = iparg(9,ng)
93 lft = 1
94 llt = nel
95C
96 IF (jeul /= 0) THEN
97C Euler : volume does not change
98 DO ii = 1, nel
99 volnew(ii) = gbuf%VOL(ii)
100 ENDDO
101 ELSE
102C ALE : compute new volumes
103 IF (sym == 0) THEN
104C =======
105C 3D case
106C =======
107 ix => ixs(1:nixs, 1 + nft:nel + nft)
108 IF (isolnod /= 4) THEN
109 DO ii = 1, nel
110C Node 1
111 x1(ii) = xgrid(1, ix(2, ii))
112 y1(ii) = xgrid(2, ix(2, ii))
113 z1(ii) = xgrid(3, ix(2, ii))
114C Node 2
115 x2(ii) = xgrid(1, ix(3, ii))
116 y2(ii) = xgrid(2, ix(3, ii))
117 z2(ii) = xgrid(3, ix(3, ii))
118C Node 3
119 x3(ii) = xgrid(1, ix(4, ii))
120 y3(ii) = xgrid(2, ix(4, ii))
121 z3(ii) = xgrid(3, ix(4, ii))
122C Node 4
123 x4(ii) = xgrid(1, ix(5, ii))
124 y4(ii) = xgrid(2, ix(5, ii))
125 z4(ii) = xgrid(3, ix(5, ii))
126C Node 5
127 x5(ii) = xgrid(1, ix(6, ii))
128 y5(ii) = xgrid(2, ix(6, ii))
129 z5(ii) = xgrid(3, ix(6, ii))
130C Node 6
131 x6(ii) = xgrid(1, ix(7, ii))
132 y6(ii) = xgrid(2, ix(7, ii))
133 z6(ii) = xgrid(3, ix(7, ii))
134C Node 7
135 x7(ii) = xgrid(1, ix(8, ii))
136 y7(ii) = xgrid(2, ix(8, ii))
137 z7(ii) = xgrid(3, ix(8, ii))
138C Node 8
139 x8(ii) = xgrid(1, ix(9, ii))
140 y8(ii) = xgrid(2, ix(9, ii))
141 z8(ii) = xgrid(3, ix(9, ii))
142 ngl(ii) = ix(nixs, ii)
143 ENDDO
144 CALL sderi3(
145 1 gbuf%OFF, volnew, ngl, x1,
146 2 x2, x3, x4, x5,
147 3 x6, x7, x8, y1,
148 4 y2, y3, y4, y5,
149 5 y6, y7, y8, z1,
150 6 z2, z3, z4, z5,
151 7 z6, z7, z8, dummy,
152 8 dummy, dummy, dummy, dummy,
153 9 dummy, dummy, dummy, dummy,
154 a dummy, dummy, dummy, dummy,
155 b dummy, dummy, dummy, dummy,
156 c dummy, dummy, dummy, dummy,
157 d dummy, dummy, dummy, jac1,
158 e jac2, jac3, jac4, jac5,
159 f jac6, gbuf%SMSTR,gbuf%OFF, nel,
160 g voldp, jhbe, ismstr, jlag)
161 ELSE
162 DO ii = 1, nel
163C Node 1
164 x1(ii) = xgrid(1, ix(2, ii))
165 y1(ii) = xgrid(2, ix(2, ii))
166 z1(ii) = xgrid(3, ix(2, ii))
167C Node 2
168 x2(ii) = xgrid(1, ix(4, ii))
169 y2(ii) = xgrid(2, ix(4, ii))
170 z2(ii) = xgrid(3, ix(4, ii))
171C Node 3
172 x3(ii) = xgrid(1, ix(7, ii))
173 y3(ii) = xgrid(2, ix(7, ii))
174 z3(ii) = xgrid(3, ix(7, ii))
175C Node 4
176 x4(ii) = xgrid(1, ix(6, ii))
177 y4(ii) = xgrid(2, ix(6, ii))
178 z4(ii) = xgrid(3, ix(6, ii))
179 ngl(ii) = ix(nixs, ii)
180 ENDDO
181 DO ii=1,nel
182 x43 = x4(ii) - x3(ii)
183 y43 = y4(ii) - y3(ii)
184 z43 = z4(ii) - z3(ii)
185 x41 = x4(ii) - x1(ii)
186 y41 = y4(ii) - y1(ii)
187 z41 = z4(ii) - z1(ii)
188 x42 = x4(ii) - x2(ii)
189 y42 = y4(ii) - y2(ii)
190 z42 = z4(ii) - z2(ii)
191C
192 b1 = y43*z42 - y42*z43
193 b2 = y41*z43 - y43*z41
194 b3 = y42*z41 - y41*z42
195 b4 = -(b1 + b2 + b3)
196C
197 c1 = z43*x42 - z42*x43
198 c2 = z41*x43 - z43*x41
199 c3 = z42*x41 - z41*x42
200 c4 = -(c1 + c2 + c3)
201C
202 d1 = x43*y42 - x42*y43
203 d2 = x41*y43 - x43*y41
204 d3 = x42*y41 - x41*y42
205 d4 = -(d1 + d2 + d3)
206C
207 volnew(ii) = (x41*b1 + y41*c1 + z41*d1)*one_over_6
208 ENDDO
209 ENDIF
210 ELSE
211C =======
212C 2D case
213C =======
214 IF (ity == 2) THEN
215C QUADS
216 ix => ixq(1:nixq, 1 + nft:nel + nft)
217 DO ii = 1, nel
218C Node 1
219 y1(ii) = xgrid(2, ix(2, ii))
220 z1(ii) = xgrid(3, ix(2, ii))
221C Node 2
222 y2(ii) = xgrid(2, ix(3, ii))
223 z2(ii) = xgrid(3, ix(3, ii))
224C Node 3
225 y3(ii) = xgrid(2, ix(4, ii))
226 z3(ii) = xgrid(3, ix(4, ii))
227C Node 4
228 y4(ii) = xgrid(2, ix(5, ii))
229 z4(ii) = xgrid(3, ix(5, ii))
230
231 y234(ii)=y2(ii)+y3(ii)+y4(ii)
232 y124(ii)=y1(ii)+y2(ii)+y4(ii)
233
234 ngl(ii) = ix(nixq, ii)
235 ENDDO
236 CALL qvolu2(
237 1 gbuf%OFF, gbuf%AREA,volnew, ngl,
238 2 y1, y2, y3, y4,
239 3 z1, z2, z3, z4,
240 4 y234, y124, nel, jmult,
241 5 jcvt)
242 ELSEIF (ity == 7) THEN
243C TRIANGLES
244 ix => ixtg(1:nixtg, 1 + nft:nel + nft)
245 IF (sym == 2) THEN
246 DO ii = 1, nel
247 y1(ii) = xgrid(2, ix(1 + 1, ii))
248 z1(ii) = xgrid(3, ix(1 + 1, ii))
249 y2(ii) = xgrid(2, ix(1 + 2, ii))
250 z2(ii) = xgrid(3, ix(1 + 2, ii))
251 y3(ii) = xgrid(2, ix(1 + 3, ii))
252 z3(ii) = xgrid(3, ix(1 + 3, ii))
253 gbuf%AREA(ii) = abs(half * ((y2(ii) - y1(ii)) * (z3(ii) - z1(ii)) -
254 . (z2(ii) - z1(ii)) * (y3(ii) - y1(ii))))
255 volnew(ii) = gbuf%AREA(ii)
256 ngl(ii) = ix(nixtg, ii)
257 ENDDO
258 ELSE IF (sym == 1) THEN
259C Axisymmetric case
260 DO ii = 1, nel
261 y1(ii) = xgrid(2, ix(1 + 1, ii))
262 z1(ii) = xgrid(3, ix(1 + 1, ii))
263 y2(ii) = xgrid(2, ix(1 + 2, ii))
264 z2(ii) = xgrid(3, ix(1 + 2, ii))
265 y3(ii) = xgrid(2, ix(1 + 3, ii))
266 z3(ii) = xgrid(3, ix(1 + 3, ii))
267 gbuf%AREA(ii) = abs(half * ((y2(ii) - y1(ii)) * (z3(ii) - z1(ii)) -
268 . (z2(ii) - z1(ii)) * (y3(ii) - y1(ii))))
269 volnew(ii) = (y1(ii) + y2(ii) + y3(ii)) * (
270 . y1(ii) * (z2(ii) - z3(ii)) +
271 . y2(ii) * (z3(ii) - z1(ii)) +
272 . y3(ii) * (z1(ii) - z2(ii))) * one_over_6
273 ngl(ii) = ix(nixtg, ii)
274 ENDDO
275 ENDIF
276 ENDIF
277 ENDIF
278 ENDIF
279
my_real
#define my_real
Definition cppsort.cpp:32
qvolu2
subroutine qvolu2(off, aire, volu, ngl, y1, y2, y3, y4, z1, z2, z3, z4, y234, y124, nel, jmult, jcvt)
Definition qvolu2.F:43
sderi3
subroutine sderi3(vol, veul, geo, igeo, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, jac1, jac2, jac3, jac4, jac5, jac6, ngl, ngeo, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, voldp, nel, jeul, nxref, imulti_fvm)
Definition sderi3.F:44