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

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