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 34 of file multi_computevolume.F.

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