OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
amomt3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "inter22.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine amomt3 (pm, rho, vol, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, f17, f27, f37, f18, f28, f38, 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, vdx5, vdx6, vdx7, vdx8, vdy1, vdy2, vdy3, vdy4, vdy5, vdy6, vdy7, vdy8, vdz1, vdz2, vdz3, vdz4, vdz5, vdz6, vdz7, vdz8, vdx, vdy, vdz, deltax, vis, mat, qmv, bufmat, iparg1, ixs, iad22, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, nale, nel, nft, mtn, ipm)

Function/Subroutine Documentation

◆ amomt3()

subroutine amomt3 ( pm,
rho,
vol,
x1,
x2,
x3,
x4,
x5,
x6,
x7,
x8,
y1,
y2,
y3,
y4,
y5,
y6,
y7,
y8,
z1,
z2,
z3,
z4,
z5,
z6,
z7,
z8,
vx1,
vx2,
vx3,
vx4,
vx5,
vx6,
vx7,
vx8,
vy1,
vy2,
vy3,
vy4,
vy5,
vy6,
vy7,
vy8,
vz1,
vz2,
vz3,
vz4,
vz5,
vz6,
vz7,
vz8,
f11,
f21,
f31,
f12,
f22,
f32,
f13,
f23,
f33,
f14,
f24,
f34,
f15,
f25,
f35,
f16,
f26,
f36,
f17,
f27,
f37,
f18,
f28,
f38,
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,
vdx5,
vdx6,
vdx7,
vdx8,
vdy1,
vdy2,
vdy3,
vdy4,
vdy5,
vdy6,
vdy7,
vdy8,
vdz1,
vdz2,
vdz3,
vdz4,
vdz5,
vdz6,
vdz7,
vdz8,
vdx,
vdy,
vdz,
deltax,
vis,
integer, dimension(*) mat,
qmv,
bufmat,
integer, dimension(*) iparg1,
integer, dimension(nixs,*) ixs,
iad22,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) nc5,
integer, dimension(*) nc6,
integer, dimension(*) nc7,
integer, dimension(*) nc8,
integer, dimension(*) nale,
integer, intent(in) nel,
integer, intent(in) nft,
integer, intent(in) mtn,
integer, dimension(npropmi,nummat), intent(in) ipm )

Definition at line 35 of file amomt3.F.

72C-----------------------------------------------
73C M o d u l e s
74C-----------------------------------------------
75 USE ale_mod
76 use element_mod , only : nixs
77C-----------------------------------------------
78C I m p l i c i t T y p e s
79C-----------------------------------------------
80#include "implicit_f.inc"
81C-----------------------------------------------
82C G l o b a l P a r a m e t e r s
83C-----------------------------------------------
84#include "mvsiz_p.inc"
85C-----------------------------------------------
86C C o m m o n B l o c k s
87C-----------------------------------------------
88#include "param_c.inc"
89#include "inter22.inc"
90#include "com04_c.inc"
91C-----------------------------------------------
92C D u m m y A r g u m e n t s
93C-----------------------------------------------
94 INTEGER, INTENT(IN) :: NFT
95 INTEGER, INTENT(IN) :: MTN
96 INTEGER, INTENT(IN) :: NEL
97 my_real
98 . pm(npropm,nummat), rho(*),vol(*),
99 . x1(*),x2(*),x3(*),x4(*),x5(*),x6(*),x7(*),x8(*),
100 . y1(*),y2(*),y3(*),y4(*),y5(*),y6(*),y7(*),y8(*),
101 . z1(*),z2(*),z3(*),z4(*),z5(*),z6(*),z7(*),z8(*),
102 . vx1(*),vx2(*),vx3(*),vx4(*),vx5(*),vx6(*),vx7(*),vx8(*),
103 . vy1(*),vy2(*),vy3(*),vy4(*),vy5(*),vy6(*),vy7(*),vy8(*),
104 . vz1(*),vz2(*),vz3(*),vz4(*),vz5(*),vz6(*),vz7(*),vz8(*),
105 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
106 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
107 . f15(*),f25(*),f35(*),f16(*),f26(*),f36(*),
108 . f17(*),f27(*),f37(*),f18(*),f28(*),f38(*),
109 . px1(*),px2(*),px3(*),px4(*),
110 . py1(*),py2(*),py3(*),py4(*),
111 . pz1(*),pz2(*),pz3(*),pz4(*),
112 . dxx(*),dxy(*),dxz(*),
113 . dyx(*),dyy(*),dyz(*),
114 . dzx(*),dzy(*),dzz(*),
115 . vdx1(*),vdx2(*),vdx3(*),vdx4(*),
116 . vdx5(*),vdx6(*),vdx7(*),vdx8(*),
117 . vdy1(*),vdy2(*),vdy3(*),vdy4(*),
118 . vdy5(*),vdy6(*),vdy7(*),vdy8(*),
119 . vdz1(*),vdz2(*),vdz3(*),vdz4(*),
120 . vdz5(*),vdz6(*),vdz7(*),vdz8(*),
121 . vdx(*),vdy(*),vdz(*),
122 . deltax(*),vis(*),qmv(12,*),bufmat(*),iad22(*)
123 INTEGER MAT(*),IPARG1(*),IXS(NIXS,*),
124 . NC1(*), NC2(*), NC3(*), NC4(*), NC5(*), NC6(*), NC7(*), NC8(*),
125 . NALE(*)
126 INTEGER, INTENT(IN) :: IPM(NPROPMI,NUMMAT)
127C-----------------------------------------------
128C L o c a l V a r i a b l e s
129C-----------------------------------------------
130 my_real
131 . v12(mvsiz,3),v23(mvsiz,3),v43(mvsiz,3),v14(mvsiz,3),
132 . v56(mvsiz,3),v67(mvsiz,3),v87(mvsiz,3),v58(mvsiz,3),
133 . v15(mvsiz,3),v26(mvsiz,3),v37(mvsiz,3),v48(mvsiz,3),
134 . f1(mvsiz),f2(mvsiz),f3(mvsiz),
135 . a1(mvsiz),a2(mvsiz),a3(mvsiz),a4(mvsiz),gam(mvsiz),
136 . r(mvsiz,3),s(mvsiz,3),t(mvsiz,3),fac,aaa,dm,dmx,dmy,dmz,
137 . ajv(mvsiz),aj0(mvsiz,3),aj1(mvsiz,3),aj2(mvsiz,3),aj3(mvsiz,3),
138 . v43a(mvsiz,3), v43b(mvsiz,3),
139 . v87a(mvsiz,3), v87b(mvsiz,3)
140 INTEGER I,J,IADBUF,IFLG, MX
141C-----------------------------------------------
142 IF(ale%UPWIND%UPWM == 0. and. iparg1(64) == 1)RETURN !silent boundary
143C-----------------------------------------------
144C MULTIMATERIAL LAW 51
145C-----------------------------------------------
146 IF(mtn == 51 .AND. ale%UPWIND%UPWM /= 3 .AND. iparg1(64) == 0)THEN
147 !-------------------------------------------------------!
148 ! Reynolds theorem ('transportation force') !
149 ! DMi = 0.5*DT1*QMV(i,I) incoming mass from face i !
150 !-------------------------------------------------------!
151 iadbuf = ipm(27,mat(1))
152 iflg = nint(bufmat(31+iadbuf-1))
153
154 IF(iflg>1)RETURN
155
156 !momentum advection with STD upwind & TG
157 mx = mat(1)
158 DO i=1,nel
159 gam(i)= pm(15,mx)
160 ENDDO
161
162 DO i=1,nel
163 IF(int22>0)THEN
164 IF(nint(iad22(i))/=0)cycle
165 ENDIF
166 aaa = qmv(1,i)+qmv(2,i)+qmv(3,i)+qmv(4,i)+qmv(5,i)+qmv(6,i)
167 aaa = aaa/six
168 qmv(1,i) = one_over_8 * (qmv(1,i) - aaa)
169 qmv(2,i) = one_over_8 * (qmv(2,i) - aaa)
170 qmv(3,i) = one_over_8 * (qmv(3,i) - aaa)
171 qmv(4,i) = one_over_8 * (qmv(4,i) - aaa)
172 qmv(5,i) = one_over_8 * (qmv(5,i) - aaa)
173 qmv(6,i) = one_over_8 * (qmv(6,i) - aaa)
174
175 dmx = zero
176 dmy = zero
177 dmz = zero
178 dm = qmv(1,i)+qmv(6,i)+qmv(4,i)
179 dmx = dmx + vx1(i)*dm
180 dmy = dmy + vy1(i)*dm
181 dmz = dmz + vz1(i)*dm
182 dm = qmv(1,i)+qmv(4,i)+qmv(5,i)
183 dmx = dmx + vx2(i)*dm
184 dmy = dmy + vy2(i)*dm
185 dmz = dmz + vz2(i)*dm
186 dm = qmv(1,i)+qmv(5,i)+qmv(2,i)
187 dmx = dmx + vx3(i)*dm
188 dmy = dmy + vy3(i)*dm
189 dmz = dmz + vz3(i)*dm
190 dm = qmv(1,i)+qmv(2,i)+qmv(6,i)
191 dmx = dmx + vx4(i)*dm
192 dmy = dmy + vy4(i)*dm
193 dmz = dmz + vz4(i)*dm
194 dm = qmv(3,i)+qmv(6,i)+qmv(4,i)
195 dmx = dmx + vx5(i)*dm
196 dmy = dmy + vy5(i)*dm
197 dmz = dmz + vz5(i)*dm
198 dm = qmv(3,i)+qmv(4,i)+qmv(5,i)
199 dmx = dmx + vx6(i)*dm
200 dmy = dmy + vy6(i)*dm
201 dmz = dmz + vz6(i)*dm
202 dm = qmv(3,i)+qmv(5,i)+qmv(2,i)
203 dmx = dmx + vx7(i)*dm
204 dmy = dmy + vy7(i)*dm
205 dmz = dmz + vz7(i)*dm
206 dm = qmv(3,i)+qmv(2,i)+qmv(6,i)
207 dmx = dmx + vx8(i)*dm
208 dmy = dmy + vy8(i)*dm
209 dmz = dmz + vz8(i)*dm
210
211
212 !DM.x = -1/8 SUM(DM_i*Vi.x, i=1..8) where DM_i = SUM(QMV(f), f face such as Ni in face)
213 !DM.y = -1/8 SUM(DM_i*Vi.y, i=1..8) where DM_i = SUM(QMV(f), f face such as Ni in face)
214 !DM.z = -1/8 SUM(DM_i*Vi.z, i=1..8) where DM_i = SUM(QMV(f), f face such as Ni in face)
215 dmx = -one_over_8 * dmx
216 dmy = -one_over_8 * dmy
217 dmz = -one_over_8 * dmz
218
219 a1(i) = px1(i)*vdx(i)+py1(i)*vdy(i)+pz1(i)*vdz(i)
220 a2(i) = px2(i)*vdx(i)+py2(i)*vdy(i)+pz2(i)*vdz(i)
221 a3(i) = px3(i)*vdx(i)+py3(i)*vdy(i)+pz3(i)*vdz(i)
222 a4(i) = px4(i)*vdx(i)+py4(i)*vdy(i)+pz4(i)*vdz(i)
223 a1(i) = sign(gam(1),a1(i))
224 a2(i) = sign(gam(1),a2(i))
225 a3(i) = sign(gam(1),a3(i))
226 a4(i) = sign(gam(1),a4(i))
227
228 f11(i) = f11(i) - (one+a1(i))*dmx
229 f12(i) = f12(i) - (one+a2(i))*dmx
230 f13(i) = f13(i) - (one+a3(i))*dmx
231 f14(i) = f14(i) - (one+a4(i))*dmx
232 f15(i) = f15(i) - (one-a3(i))*dmx
233 f16(i) = f16(i) - (one-a4(i))*dmx
234 f17(i) = f17(i) - (one-a1(i))*dmx
235 f18(i) = f18(i) - (one-a2(i))*dmx
236
237 f21(i) = f21(i) - (one+a1(i))*dmy
238 f22(i) = f22(i) - (one+a2(i))*dmy
239 f23(i) = f23(i) - (one+a3(i))*dmy
240 f24(i) = f24(i) - (one+a4(i))*dmy
241 f25(i) = f25(i) - (one-a3(i))*dmy
242 f26(i) = f26(i) - (one-a4(i))*dmy
243 f27(i) = f27(i) - (one-a1(i))*dmy
244 f28(i) = f28(i) - (one-a2(i))*dmy
245
246 f31(i) = f31(i) - (one+a1(i))*dmz
247 f32(i) = f32(i) - (one+a2(i))*dmz
248 f33(i) = f33(i) - (one+a3(i))*dmz
249 f34(i) = f34(i) - (one+a4(i))*dmz
250 f35(i) = f35(i) - (one-a3(i))*dmz
251 f36(i) = f36(i) - (one-a4(i))*dmz
252 f37(i) = f37(i) - (one-a1(i))*dmz
253 f38(i) = f38(i) - (one-a2(i))*dmz
254 ENDDO
255 RETURN
256 ENDIF
257
258
259
260C-----------------------------------------------
261C OTHER FLUID MATERIAL
262C-----------------------------------------------
263
264
265 !--------------------!
266 ! SUPG & TG !
267 ! R,S,T frame !
268 !--------------------!
269 IF(ale%UPWIND%UPWM>1)THEN
270 DO i=1,nel
271 v12(i,1)=x2(i)-x1(i)
272 v12(i,2)=y2(i)-y1(i)
273 v12(i,3)=z2(i)-z1(i)
274 v23(i,1)=x3(i)-x2(i)
275 v23(i,2)=y3(i)-y2(i)
276 v23(i,3)=z3(i)-z2(i)
277 v43(i,1)=x3(i)-x4(i)
278 v43(i,2)=y3(i)-y4(i)
279 v43(i,3)=z3(i)-z4(i)
280 v14(i,1)=x4(i)-x1(i)
281 v14(i,2)=y4(i)-y1(i)
282 v14(i,3)=z4(i)-z1(i)
283 v15(i,1)=x5(i)-x1(i)
284 v15(i,2)=y5(i)-y1(i)
285 v15(i,3)=z5(i)-z1(i)
286 v26(i,1)=x6(i)-x2(i)
287 v26(i,2)=y6(i)-y2(i)
288 v26(i,3)=z6(i)-z2(i)
289 v37(i,1)=x7(i)-x3(i)
290 v37(i,2)=y7(i)-y3(i)
291 v37(i,3)=z7(i)-z3(i)
292 v48(i,1)=x8(i)-x4(i)
293 v48(i,2)=y8(i)-y4(i)
294 v48(i,3)=z8(i)-z4(i)
295 v56(i,1)=x6(i)-x5(i)
296 v56(i,2)=y6(i)-y5(i)
297 v56(i,3)=z6(i)-z5(i)
298 v67(i,1)=x7(i)-x6(i)
299 v67(i,2)=y7(i)-y6(i)
300 v67(i,3)=z7(i)-z6(i)
301 v87(i,1)=x7(i)-x8(i)
302 v87(i,2)=y7(i)-y8(i)
303 v87(i,3)=z7(i)-z8(i)
304 v58(i,1)=x8(i)-x5(i)
305 v58(i,2)=y8(i)-y5(i)
306 v58(i,3)=z8(i)-z5(i)
307 ENDDO
308
309 ! NODE 1 : V12,V14,V15
310 ! NODE 2 : V12,V23,V26
311 ! NODE 3 : V43,V23,V37
312 ! NODE 4 : V43,V14,V48
313 ! NODE 5 : V56,V58,V15
314 ! NODE 6 : V56,V67,V26
315 ! NODE 7 : V87,V67,V37
316 ! NODE 8 : V87,V58,V48
317
318 !PENTA6DG CASE
319 !V43 is change to V43a for frame on node 3
320 !V43 is change to V43b for frame on node 4
321 !V87 is change to V87a for frame on node 3
322 !V87 is change to V87b for frame on node 4
323 DO i=1,nel
324
325 IF(ixs(5,i+nft)==ixs(4,i+nft))THEN
326 v43a(i,1)=x3(i)-x1(i)
327 v43a(i,2)=y3(i)-y1(i)
328 v43a(i,3)=z3(i)-z1(i)
329 v43b(i,1)=x2(i)-x3(i)
330 v43b(i,2)=y2(i)-y3(i)
331 v43b(i,3)=z2(i)-z3(i)
332 ELSE
333 v43a(i,1) = v43(i,1)
334 v43b(i,1) = v43(i,1)
335 v43a(i,2) = v43(i,2)
336 v43b(i,2) = v43(i,2)
337 v43a(i,3) = v43(i,3)
338 v43b(i,3) = v43(i,3)
339 ENDIF
340
341 IF(ixs(9,i+nft)==ixs(8,i+nft))THEN
342 v87a(i,1)=x7(i)-x5(i)
343 v87a(i,2)=y7(i)-y5(i)
344 v87a(i,3)=z7(i)-z5(i)
345 v87b(i,1)=x6(i)-x7(i)
346 v87b(i,2)=y6(i)-y7(i)
347 v87b(i,3)=z6(i)-z7(i)
348 ELSE
349 v87a(i,1) = v87(i,1)
350 v87b(i,1) = v87(i,1)
351 v87a(i,2) = v87(i,2)
352 v87b(i,2) = v87(i,2)
353 v87a(i,3) = v87(i,3)
354 v87b(i,3) = v87(i,3)
355 ENDIF
356 ENDDO
357
358 DO j=1,3
359 DO i=1,nel
360 r(i,j)=fourth*(v12(i,j)+v56(i,j)+v43(i,j)+v87(i,j))
361 s(i,j)=fourth*(v23(i,j)+v14(i,j)+v58(i,j)+v67(i,j))
362 t(i,j)=fourth*(v15(i,j)+v26(i,j)+v37(i,j)+v48(i,j))
363 ENDDO
364 ENDDO
365 ENDIF
366
367 !----------------------------------------------------!
368 ! UPWIND STANDARD (upwm<2) !
369 ! TRANSPORTATION FORCE AT CENTROID !
370 !----------------------------------------------------!
371 IF(ale%UPWIND%UPWM<=1 .OR.iparg1(64)==1)THEN
372
373 IF((iparg1(64)==1))THEN
374 ! VDX,VDY,VDZ IS CALCULATED IN M11VS3 OU M51VS3
375 DO i=1,nel
376 a1(i) =(px1(i)*vdx(i)+py1(i)*vdy(i)+pz1(i)*vdz(i))
377 a2(i) =(px2(i)*vdx(i)+py2(i)*vdy(i)+pz2(i)*vdz(i))
378 a3(i) =(px3(i)*vdx(i)+py3(i)*vdy(i)+pz3(i)*vdz(i))
379 a4(i) =(px4(i)*vdx(i)+py4(i)*vdy(i)+pz4(i)*vdz(i))
380 a1(i) = sign(one,a1(i))
381 a2(i) = sign(one,a2(i))
382 a3(i) = sign(one,a3(i))
383 a4(i) = sign(one,a4(i))
384 ENDDO
385 ELSE
386 IF(ale%UPWIND%UPWM==zero)THEN
387 mx = mat(1)
388 DO i=1,nel
389 gam(i)= pm(15,mx)
390 ENDDO
391 ELSE
392 DO i=1,nel
393 gam(i)= ale%UPWIND%CUPWM
394 ENDDO
395 ENDIF
396 DO i=1,nel
397 a1(i) = px1(i)*vdx(i)+py1(i)*vdy(i)+pz1(i)*vdz(i)
398 a2(i) = px2(i)*vdx(i)+py2(i)*vdy(i)+pz2(i)*vdz(i)
399 a3(i) = px3(i)*vdx(i)+py3(i)*vdy(i)+pz3(i)*vdz(i)
400 a4(i) = px4(i)*vdx(i)+py4(i)*vdy(i)+pz4(i)*vdz(i)
401 a1(i) = sign(gam(1),a1(i))
402 a2(i) = sign(gam(1),a2(i))
403 a3(i) = sign(gam(1),a3(i))
404 a4(i) = sign(gam(1),a4(i))
405 ENDDO
406 ENDIF
407
408 DO i=1,nel
409 fac = one_over_8*rho(i)*vol(i)
410 f1(i) = (vdx(i)*dxx(i)+vdy(i)*dxy(i)+vdz(i)*dxz(i))*fac
411 f2(i) = (vdx(i)*dyx(i)+vdy(i)*dyy(i)+vdz(i)*dyz(i))*fac
412 f3(i) = (vdx(i)*dzx(i)+vdy(i)*dzy(i)+vdz(i)*dzz(i))*fac
413 ENDDO
414
415 !inter22
416 IF(int22>0)THEN
417 DO i=1,nel
418 !currently no momentum transport force for polyedra
419 IF(nint(iad22(i))==0)cycle
420 !no force for brick in cut cell buffer
421 f1(i) = zero
422 f2(i) = zero
423 f3(i) = zero
424 ENDDO
425 ENDIF
426
427 !expand to nodes
428 DO i=1,nel
429 f11(i) = f11(i) - (one+a1(i))*f1(i)
430 f12(i) = f12(i) - (one+a2(i))*f1(i)
431 f13(i) = f13(i) - (one+a3(i))*f1(i)
432 f14(i) = f14(i) - (one+a4(i))*f1(i)
433 f15(i) = f15(i) - (one-a3(i))*f1(i)
434 f16(i) = f16(i) - (one-a4(i))*f1(i)
435 f17(i) = f17(i) - (one-a1(i))*f1(i)
436 f18(i) = f18(i) - (one-a2(i))*f1(i)
437C
438 f21(i) = f21(i) - (one+a1(i))*f2(i)
439 f22(i) = f22(i) - (one+a2(i))*f2(i)
440 f23(i) = f23(i) - (one+a3(i))*f2(i)
441 f24(i) = f24(i) - (one+a4(i))*f2(i)
442 f25(i) = f25(i) - (one-a3(i))*f2(i)
443 f26(i) = f26(i) - (one-a4(i))*f2(i)
444 f27(i) = f27(i) - (one-a1(i))*f2(i)
445 f28(i) = f28(i) - (one-a2(i))*f2(i)
446C
447 f31(i) = f31(i) - (one+a1(i))*f3(i)
448 f32(i) = f32(i) - (one+a2(i))*f3(i)
449 f33(i) = f33(i) - (one+a3(i))*f3(i)
450 f34(i) = f34(i) - (one+a4(i))*f3(i)
451 f35(i) = f35(i) - (one-a3(i))*f3(i)
452 f36(i) = f36(i) - (one-a4(i))*f3(i)
453 f37(i) = f37(i) - (one-a1(i))*f3(i)
454 f38(i) = f38(i) - (one-a2(i))*f3(i)
455 ENDDO
456
457 ELSE
458
459 !-----------------------------------------------------------------------!
460 ! SUPG OR TG
461 ! TRANSPORTATION FORCE WHICH MINIMIZE HOURGLASS !
462 ! <PHI,UJ*DUI/DXJ> ESTIMATED AT NODES !
463 !-----------------------------------------------------------------------!
464 ! NODE 1 (1,2,4,5)
465 CALL ajac3_v(
466 1 v12, v14, v15, aj1,
467 2 aj2, aj3, ajv, nel)
468 DO i=1,nel
469 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
470 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
471 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
472 ENDDO
473 CALL amomtn3(
474 1 rho, deltax, vis, vol,
475 2 aj0, aj1, aj2, aj3,
476 3 ajv, r, s, t,
477 4 vdx1, vdy1, vdz1, vx1,
478 5 vy1, vz1, vx2, vy2,
479 6 vz2, vx4, vy4, vz4,
480 7 vx5, vy5, vz5, f11,
481 8 f21, f31, f12, f22,
482 9 f32, f14, f24, f34,
483 a f15, f25, f35, f13,
484 b f23, f33, f16, f26,
485 c f36, f17, f27, f37,
486 d f18, f28, f38, iad22,
487 e nc1, nc2, nc3, nc4,
488 f nc5, nc6, nc7, nc8,
489 g nale, nel)
490 ! NODE 2 (2,1,3,6)
491 CALL ajac3_v(
492 1 v12, v23, v26, aj1,
493 2 aj2, aj3, ajv, nel)
494 DO i=1,nel
495 aj1(i,1)=-aj1(i,1)
496 aj1(i,2)=-aj1(i,2)
497 aj1(i,3)=-aj1(i,3)
498 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
499 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
500 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
501 ENDDO
502 CALL amomtn3(
503 1 rho, deltax, vis, vol,
504 2 aj0, aj1, aj2, aj3,
505 3 ajv, r, s, t,
506 4 vdx2, vdy2, vdz2, vx2,
507 5 vy2, vz2, vx1, vy1,
508 6 vz1, vx3, vy3, vz3,
509 7 vx6, vy6, vz6, f12,
510 8 f22, f32, f11, f21,
511 9 f31, f13, f23, f33,
512 a f16, f26, f36, f14,
513 b f24, f34, f15, f25,
514 c f35, f17, f27, f37,
515 d f18, f28, f38, iad22,
516 e nc1, nc2, nc3, nc4,
517 f nc5, nc6, nc7, nc8,
518 g nale, nel)
519 ! NODE 3 (3,4,2,8)
520 CALL ajac3_v(
521 1 v43a, v23, v37, aj1,
522 2 aj2, aj3, ajv, nel)
523 DO i=1,nel
524 aj1(i,1)=-aj1(i,1)
525 aj1(i,2)=-aj1(i,2)
526 aj1(i,3)=-aj1(i,3)
527 aj2(i,1)=-aj2(i,1)
528 aj2(i,2)=-aj2(i,2)
529 aj2(i,3)=-aj2(i,3)
530 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
531 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
532 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
533 ENDDO
534 CALL amomtn3(
535 1 rho, deltax, vis, vol,
536 2 aj0, aj1, aj2, aj3,
537 3 ajv, r, s, t,
538 4 vdx3, vdy3, vdz3, vx3,
539 5 vy3, vz3, vx4, vy4,
540 6 vz4, vx2, vy2, vz2,
541 7 vx7, vy7, vz7, f13,
542 8 f23, f33, f14, f24,
543 9 f34, f12, f22, f32,
544 a f17, f27, f37, f11,
545 b f21, f31, f15, f25,
546 c f35, f16, f26, f36,
547 d f18, f28, f38, iad22,
548 e nc1, nc2, nc3, nc4,
549 f nc5, nc6, nc7, nc8,
550 g nale, nel)
551 ! NODE 4 (4,3,1,8)
552 CALL ajac3_v(
553 1 v43b, v14, v48, aj1,
554 2 aj2, aj3, ajv, nel)
555 DO i=1,nel
556 aj2(i,1)=-aj2(i,1)
557 aj2(i,2)=-aj2(i,2)
558 aj2(i,3)=-aj2(i,3)
559 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
560 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
561 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
562 ENDDO
563 CALL amomtn3(
564 1 rho, deltax, vis, vol,
565 2 aj0, aj1, aj2, aj3,
566 3 ajv, r, s, t,
567 4 vdx4, vdy4, vdz4, vx4,
568 5 vy4, vz4, vx3, vy3,
569 6 vz3, vx1, vy1, vz1,
570 7 vx8, vy8, vz8, f14,
571 8 f24, f34, f13, f23,
572 9 f33, f11, f21, f31,
573 a f18, f28, f38, f12,
574 b f22, f32, f15, f25,
575 c f35, f16, f26, f36,
576 d f17, f27, f37, iad22,
577 e nc1, nc2, nc3, nc4,
578 f nc5, nc6, nc7, nc8,
579 g nale, nel)
580 ! NODE 5 (5,6,8,1)
581 CALL ajac3_v(
582 1 v56, v58, v15, aj1,
583 2 aj2, aj3, ajv, nel)
584 DO i=1,nel
585 aj3(i,1)=-aj3(i,1)
586 aj3(i,2)=-aj3(i,2)
587 aj3(i,3)=-aj3(i,3)
588 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
589 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
590 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
591 ENDDO
592 CALL amomtn3(
593 1 rho, deltax, vis, vol,
594 2 aj0, aj1, aj2, aj3,
595 3 ajv, r, s, t,
596 4 vdx5, vdy5, vdz5, vx5,
597 5 vy5, vz5, vx6, vy6,
598 6 vz6, vx8, vy8, vz8,
599 7 vx1, vy1, vz1, f15,
600 8 f25, f35, f16, f26,
601 9 f36, f18, f28, f38,
602 a f11, f21, f31, f12,
603 b f22, f32, f13, f23,
604 c f33, f14, f24, f34,
605 d f17, f27, f37, iad22,
606 e nc1, nc2, nc3, nc4,
607 f nc5, nc6, nc7, nc8,
608 g nale, nel)
609 ! NODE 6 (6,5,7,2)
610 CALL ajac3_v(
611 1 v56, v67, v26, aj1,
612 2 aj2, aj3, ajv, nel)
613 DO i=1,nel
614 aj3(i,1)=-aj3(i,1)
615 aj3(i,2)=-aj3(i,2)
616 aj3(i,3)=-aj3(i,3)
617 aj1(i,1)=-aj1(i,1)
618 aj1(i,2)=-aj1(i,2)
619 aj1(i,3)=-aj1(i,3)
620 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
621 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
622 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
623 ENDDO
624 CALL amomtn3(
625 1 rho, deltax, vis, vol,
626 2 aj0, aj1, aj2, aj3,
627 3 ajv, r, s, t,
628 4 vdx6, vdy6, vdz6, vx6,
629 5 vy6, vz6, vx5, vy5,
630 6 vz5, vx7, vy7, vz7,
631 7 vx2, vy2, vz2, f16,
632 8 f26, f36, f15, f25,
633 9 f35, f17, f27, f37,
634 a f12, f22, f32, f11,
635 b f21, f31, f13, f23,
636 c f33, f14, f24, f34,
637 d f18, f28, f38, iad22,
638 e nc1, nc2, nc3, nc4,
639 f nc5, nc6, nc7, nc8,
640 g nale, nel)
641 ! NODE 7 (7,8,6,3)
642 CALL ajac3_v(
643 1 v87a, v67, v37, aj1,
644 2 aj2, aj3, ajv, nel)
645 DO i=1,nel
646 aj1(i,1)=-aj1(i,1)
647 aj1(i,2)=-aj1(i,2)
648 aj1(i,3)=-aj1(i,3)
649 aj2(i,1)=-aj2(i,1)
650 aj2(i,2)=-aj2(i,2)
651 aj2(i,3)=-aj2(i,3)
652 aj3(i,1)=-aj3(i,1)
653 aj3(i,2)=-aj3(i,2)
654 aj3(i,3)=-aj3(i,3)
655 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
656 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
657 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
658 ENDDO
659 CALL amomtn3(
660 1 rho, deltax, vis, vol,
661 2 aj0, aj1, aj2, aj3,
662 3 ajv, r, s, t,
663 4 vdx7, vdy7, vdz7, vx7,
664 5 vy7, vz7, vx8, vy8,
665 6 vz8, vx6, vy6, vz6,
666 7 vx3, vy3, vz3, f17,
667 8 f27, f37, f18, f28,
668 9 f38, f16, f26, f36,
669 a f13, f23, f33, f11,
670 b f21, f31, f12, f22,
671 c f32, f14, f24, f34,
672 d f15, f25, f35, iad22,
673 e nc1, nc2, nc3, nc4,
674 f nc5, nc6, nc7, nc8,
675 g nale, nel)
676 ! NODE 8
677 CALL ajac3_v(
678 1 v87b, v58, v48, aj1,
679 2 aj2, aj3, ajv, nel)
680 DO i=1,nel
681 aj2(i,1)=-aj2(i,1)
682 aj2(i,2)=-aj2(i,2)
683 aj2(i,3)=-aj2(i,3)
684 aj3(i,1)=-aj3(i,1)
685 aj3(i,2)=-aj3(i,2)
686 aj3(i,3)=-aj3(i,3)
687 aj0(i,1)=-(aj1(i,1)+aj2(i,1)+aj3(i,1))
688 aj0(i,2)=-(aj1(i,2)+aj2(i,2)+aj3(i,2))
689 aj0(i,3)=-(aj1(i,3)+aj2(i,3)+aj3(i,3))
690 ENDDO
691 CALL amomtn3(
692 1 rho, deltax, vis, vol,
693 2 aj0, aj1, aj2, aj3,
694 3 ajv, r, s, t,
695 4 vdx8, vdy8, vdz8, vx8,
696 5 vy8, vz8, vx7, vy7,
697 6 vz7, vx5, vy5, vz5,
698 7 vx4, vy4, vz4, f18,
699 8 f28, f38, f17, f27,
700 9 f37, f15, f25, f35,
701 a f14, f24, f34, f11,
702 b f21, f31, f12, f22,
703 c f32, f13, f23, f33,
704 d f16, f26, f36, iad22,
705 e nc1, nc2, nc3, nc4,
706 f nc5, nc6, nc7, nc8,
707 g nale, nel)
708 ENDIF
709 RETURN
ajac3_v
subroutine ajac3_v(v1, v2, v3, aj1, aj2, aj3, ajv, nel)
Definition ajac3.F:31
amomtn3
subroutine amomtn3(rho, deltax, vis, vol, a0, a1, a2, a3, ajv, r, s, t, vdx0, vdy0, vdz0, vx0, vy0, vz0, vx1, vy1, vz1, vx2, vy2, vz2, vx3, vy3, vz3, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, f17, f27, f37, f18, f28, f38, iad22, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, nale, nel)
Definition amomtn3.F:49
my_real
#define my_real
Definition cppsort.cpp:32
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253