OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
a4momt3.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!|| a4momt3 ../engine/source/elements/solid/solide4/a4momt3.F
25!||--- called by ------------------------------------------------------
26!|| s4forc3 ../engine/source/elements/solid/solide4/s4forc3.F
27!||--- calls -----------------------------------------------------
28!|| a4momtn3 ../engine/source/elements/solid/solide4/a4momtn3.F
29!|| upwind4 ../engine/source/elements/solid/solide4/upwind4.F
30!||--- uses -----------------------------------------------------
31!|| ale_mod ../common_source/modules/ale/ale_mod.F
32!||====================================================================
33 SUBROUTINE a4momt3(
34 1 PM, RHO, VOL, X1,
35 2 X2, X3, X4, Y1,
36 3 Y2, Y3, Y4, Z1,
37 4 Z2, Z3, Z4, VX1,
38 5 VX2, VX3, VX4, VY1,
39 6 VY2, VY3, VY4, VZ1,
40 7 VZ2, VZ3, VZ4, F11,
41 8 F21, F31, F12, F22,
42 9 F32, F13, F23, F33,
43 A F14, F24, F34, PX1,
44 B PX2, PX3, PX4, PY1,
45 C PY2, PY3, PY4, PZ1,
46 D PZ2, PZ3, PZ4, DXX,
47 E DXY, DXZ, DYX, DYY,
48 F DYZ, DZX, DZY, DZZ,
49 G VDX1, VDX2, VDX3, VDX4,
50 H VDY1, VDY2, VDY3, VDY4,
51 I VDZ1, VDZ2, VDZ3, VDZ4,
52 J VDX, VDY, VDZ, DELTAX,
53 K VIS, MAT, RX, RY,
54 L RZ, SX, SY, SZ,
55 M TX, TY, TZ, NEL,
56 N MTN)
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE ale_mod
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C G l o b a l P a r a m e t e r s
67C-----------------------------------------------
68#include "mvsiz_p.inc"
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "param_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER, INTENT(IN) :: MTN
77 INTEGER, INTENT(IN) :: NEL
78 my_real
79 . PM(NPROPM,*), RHO(*),VOL(*),
80 . X1(*),X2(*),X3(*),X4(*),
81 . Y1(*),Y2(*),Y3(*),Y4(*),
82 . Z1(*),Z2(*),Z3(*),Z4(*),
83 . vx1(*),vx2(*),vx3(*),vx4(*),
84 . vy1(*),vy2(*),vy3(*),vy4(*),
85 . vz1(*),vz2(*),vz3(*),vz4(*),
86 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
87 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
88 . px1(*),px2(*),px3(*),px4(*),
89 . py1(*),py2(*),py3(*),py4(*),
90 . pz1(*),pz2(*),pz3(*),pz4(*),
91 . dxx(*),dxy(*),dxz(*),
92 . dyx(*),dyy(*),dyz(*),
93 . dzx(*),dzy(*),dzz(*),
94 . vdx1(*),vdx2(*),vdx3(*),vdx4(*),
95 . vdy1(*),vdy2(*),vdy3(*),vdy4(*),
96 . vdz1(*),vdz2(*),vdz3(*),vdz4(*),
97 . vdx(*),vdy(*),vdz(*),
98 . deltax(*),vis(*),
99 . rx(*) , ry(*) , rz(*) ,
100 . sx(*) , sy(*) , sz(*) ,
101 . tx(*) , ty(*) , tz(*)
102 INTEGER MAT(*)
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 my_real
107 . F1(MVSIZ),F2(MVSIZ),F3(MVSIZ),
108 . A1(MVSIZ),A2(MVSIZ),A3(MVSIZ),A4(MVSIZ),GAM(MVSIZ),
109 . R(MVSIZ,3),S(MVSIZ,3),T(MVSIZ,3),FAC
110 INTEGER I
111C-----------------------------------------------
112C P r e - C o n d i t i o n s
113C-----------------------------------------------
114 IF(MTN==11)return
115C-----------------------------------------------
116C S o u r c e C o d e
117C-----------------------------------------------
118
119 ! CALCUL DE LA FORCE DE TRANSPORT AU CENTRE
120 ! STANDARD UPWIND UTILISANT LES DONNEES MATERIAUX
121 IF(ale%UPWIND%UPWM<2 .OR.mtn==11)THEN
122 IF(mtn==11.AND.ale%UPWIND%UPWM>1)THEN
123 ! VDX,VDY,VDZ EST CALCULE DANS M11VS3
124 DO i=1,nel
125 r(i,1)=rx(i)
126 r(i,2)=ry(i)
127 r(i,3)=rz(i)
128 s(i,1)=sx(i)
129 s(i,2)=sy(i)
130 s(i,3)=sz(i)
131 t(i,1)=tx(i)
132 t(i,2)=ty(i)
133 t(i,3)=tz(i)
134 ENDDO
135 CALL upwind4(
136 1 rho, vis, vdx, vdy,
137 2 vdz, r, s, t,
138 3 gam, nel)
139 DO i=1,nel
140 fac=gam(i)
141 a1(i) = fac*(px1(i)*vdx(i)+py1(i)*vdy(i)+pz1(i)*vdz(i))
142 a2(i) = fac*(px2(i)*vdx(i)+py2(i)*vdy(i)+pz2(i)*vdz(i))
143 a3(i) = fac*(px3(i)*vdx(i)+py3(i)*vdy(i)+pz3(i)*vdz(i))
144 a4(i) = fac*(px4(i)*vdx(i)+py4(i)*vdy(i)+pz4(i)*vdz(i))
145 ENDDO
146
147 else!IF(MTN==11.AND.ALE%UPWIND%UPWM>1)
148
149 IF(ale%UPWIND%UPWM==zero)THEN
150 DO i=1,nel
151 gam(i)= pm(15,mat(i))
152 ENDDO
153 ELSE
154 DO i=1,nel
155 gam(i)= ale%UPWIND%CUPWM
156 ENDDO
157 ENDIF
158 DO i=1,nel
159 a1(i) = px1(i)*vdx(i)+py1(i)*vdy(i)+pz1(i)*vdz(i)
160 a2(i) = px2(i)*vdx(i)+py2(i)*vdy(i)+pz2(i)*vdz(i)
161 a3(i) = px3(i)*vdx(i)+py3(i)*vdy(i)+pz3(i)*vdz(i)
162 a4(i) = px4(i)*vdx(i)+py4(i)*vdy(i)+pz4(i)*vdz(i)
163 a1(i) = sign(gam(i),a1(i))
164 a2(i) = sign(gam(i),a2(i))
165 a3(i) = sign(gam(i),a3(i))
166 a4(i) = sign(gam(i),a4(i))
167 ENDDO
168
169 ENDIF !IF(MTN==11.AND.ALE%UPWIND%UPWM>1)
170
171 DO i=1,nel
172 fac = fourth*rho(i)*vol(i)
173 f1(i) = (vdx(i)*dxx(i)+vdy(i)*dxy(i)+vdz(i)*dxz(i))*fac
174 f2(i) = (vdx(i)*dyx(i)+vdy(i)*dyy(i)+vdz(i)*dyz(i))*fac
175 f3(i) = (vdx(i)*dzx(i)+vdy(i)*dzy(i)+vdz(i)*dzz(i))*fac
176 ENDDO
177
178 DO i=1,nel
179 f11(i) = f11(i) - (one+a1(i))*f1(i)
180 f12(i) = f12(i) - (one+a2(i))*f1(i)
181 f13(i) = f13(i) - (one+a3(i))*f1(i)
182 f14(i) = f14(i) - (one+a4(i))*f1(i)
183
184 f21(i) = f21(i) - (one+a1(i))*f2(i)
185 f22(i) = f22(i) - (one+a3(i))*f2(i)
186 f23(i) = f23(i) - (one+a3(i))*f2(i)
187 f24(i) = f24(i) - (one+a4(i))*f2(i)
188
189 f31(i) = f31(i) - (one+a1(i))*f3(i)
190 f32(i) = f32(i) - (one+a3(i))*f3(i)
191 f33(i) = f33(i) - (one+a3(i))*f3(i)
192 f34(i) = f34(i) - (one+a4(i))*f3(i)
193 ENDDO
194
195 ELSE ! IF(ALE%UPWIND%UPWM<2 .OR.MTN==11)
196
197 ! SUPG OU TG
198 ! TRANSPORTATION FORCE
199 ! <PHI,UJ*DUI/DXJ> EVALUATED AT NODES
200
201 DO i=1,nel
202 r(i,1)=rx(i)-sx(i)
203 r(i,2)=ry(i)-sy(i)
204 r(i,3)=rz(i)-sz(i)
205 s(i,1)=rx(i)-tx(i)
206 s(i,2)=ry(i)-ty(i)
207 s(i,3)=rz(i)-tz(i)
208 t(i,1)=rx(i)
209 t(i,2)=ry(i)
210 t(i,3)=rz(i)
211 ENDDO
212 ! CURRENT DEFINITION FOR R,S,T (Node 1)
213 ! +------+
214 ! ^ /+
215 ! | / +
216 ! T| / +
217 ! | /S +
218 ! | / +
219 ! |/ +
220 ! +----->+
221 ! 1 R
222 CALL a4momtn3(
223 1 rho, vol, vis, r,
224 2 s, t, deltax, vdx,
225 3 vdy, vdz, dxx, dxy,
226 4 dxz, dyx, dyy, dyz,
227 5 dzx, dzy, dzz, px1,
228 6 py1, pz1, vdx1, vdy1,
229 7 vdz1, f11, f21, f31,
230 8 nel)
231
232 DO i=1,nel
233 r(i,1)=sx(i)-tx(i)
234 r(i,2)=sy(i)-ty(i)
235 r(i,3)=sz(i)-tz(i)
236 s(i,1)=sx(i)
237 s(i,2)=sy(i)
238 s(i,3)=sz(i)
239 t(i,1)=sx(i)-rx(i)
240 t(i,2)=sy(i)-ry(i)
241 t(i,3)=sz(i)-rz(i)
242 ENDDO
243 ! CURRENT DEFINITION FOR R,S,T (Node 2)
244 ! +------+
245 ! +\ ^
246 ! + \ | r
247 ! + \S |
248 ! + \ |
249 ! + \ |
250 ! + \|
251 ! +<-----0
252 ! T 2
253 CALL a4momtn3(
254 1 rho, vol, vis, r,
255 2 s, t, deltax, vdx,
256 3 vdy, vdz, dxx, dxy,
257 4 dxz, dyx, dyy, dyz,
258 5 dzx, dzy, dzz, px2,
259 6 py2, pz2, vdx2, vdy2,
260 7 vdz2, f12, f22, f32,
261 8 nel)
262
263 DO i=1,nel
264 r(i,1)=tx(i)
265 r(i,2)=ty(i)
266 r(i,3)=tz(i)
267 s(i,1)=tx(i)-rx(i)
268 s(i,2)=ty(i)-ry(i)
269 s(i,3)=tz(i)-rz(i)
270 t(i,1)=tx(i)-sx(i)
271 t(i,2)=ty(i)-sy(i)
272 t(i,3)=tz(i)-sz(i)
273 ENDDO
274 ! CURRENT DEFINITION FOR R,S,T
275 ! R
276 ! +<-----O 3
277 ! + /|
278 ! + / |
279 ! + /S |
280 ! + / |T
281 ! + / |
282 ! +/ |
283 ! +------+
284 !
285 CALL a4momtn3(
286 1 rho, vol, vis, r,
287 2 s, t, deltax, vdx,
288 3 vdy, vdz, dxx, dxy,
289 4 dxz, dyx, dyy, dyz,
290 5 dzx, dzy, dzz, px3,
291 6 py3, pz3, vdx3, vdy3,
292 7 vdz3, f13, f23, f33,
293 8 nel)
294
295 DO i=1,nel
296 r(i,1)=rx(i)
297 r(i,2)=ry(i)
298 r(i,3)=rz(i)
299 s(i,1)=sx(i)
300 s(i,2)=sy(i)
301 s(i,3)=sz(i)
302 t(i,1)=tx(i)
303 t(i,2)=ty(i)
304 t(i,3)=tz(i)
305 ENDDO
306 ! CURRENT DEFINITION FOR R,S,T
307 ! 4 T
308 ! O------+
309 ! |\ +
310 ! | \ +
311 ! R | \S +
312 ! | \ +
313 ! | \ +
314 ! | \+
315 ! +------+
316 !
317 CALL a4momtn3(
318 1 rho, vol, vis, r,
319 2 s, t, deltax, vdx,
320 3 vdy, vdz, dxx, dxy,
321 4 dxz, dyx, dyy, dyz,
322 5 dzx, dzy, dzz, px4,
323 6 py4, pz4, vdx4, vdy4,
324 7 vdz4, f14, f24, f34,
325 8 nel)
326
327
328 endif!IF(ALE%UPWIND%UPWM<2 .OR.MTN==11)
329
330 RETURN
331 END
332
subroutine a4momt3(pm, rho, vol, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, vdx1, vdx2, vdx3, vdx4, vdy1, vdy2, vdy3, vdy4, vdz1, vdz2, vdz3, vdz4, vdx, vdy, vdz, deltax, vis, mat, rx, ry, rz, sx, sy, sz, tx, ty, tz, nel, mtn)
Definition a4momt3.F:57
subroutine a4momtn3(rho, vol, vis, r, s, t, deltax, vmx, vmy, vmz, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, px, py, pz, vdx, vdy, vdz, fx, fy, fz, nel)
Definition a4momtn3.F:39
type(ale_) ale
Definition ale_mod.F:249
subroutine upwind4(rho, vis, vdx, vdy, vdz, r, s, t, gam, nel)
Definition upwind4.F:35