45 . IXS, IXQ, IPARG, XGRID, ACCELE, VEL, WGRID, MS, MSNF, VEUL,
46 . STIFN, FSKY, IADS, FSKYM,
47 . CONDN, CONDNSKY, MULTI_FVM,NODADT_THERM)
57#include "implicit_f.inc"
66#include "vect01_c.inc"
75 TYPE (ELBUF_STRUCT_),
TARGET,
DIMENSION(NGROUP),
INTENT(IN) :: ELBUF_TAB
76 INTEGER,
INTENT(IN) :: NODADT_THERM
77 INTEGER,
INTENT(IN) :: ITASK, IPARG(NPARG, *), IXS(NIXS, *), IXQ(NIXQ, *),
81 . xgrid(3, *), wgrid(3, *), veul(*), vel(3, *), timestep
85 my_real,
INTENT(INOUT) :: fskym(*), stifn(*), fsky(8,lsky),
86 . condn(*), condnsky(*)
87 TYPE(multi_fvm_struct),
INTENT(IN) :: MULTI_FVM
92 INTEGER :: I, II, K, NF1, ISTRA, ISOLNOD, NSG, IPLA, NG, NEL, NVC
95 my_real ::
norm(3, 6, mvsiz), surf(6, mvsiz), wfac(3, 6, mvsiz)
101 . sti(mvsiz), fr_wav(mvsiz), them(mvsiz,8), conde(mvsiz)
103 . mx1(mvsiz),my1(mvsiz),mz1(mvsiz),
104 . mx2(mvsiz),my2(mvsiz),mz2(mvsiz),
105 . mx3(mvsiz),my3(mvsiz),mz3(mvsiz),
106 . mx4(mvsiz),my4(mvsiz),mz4(mvsiz),
107 . mx5(mvsiz),my5(mvsiz),mz5(mvsiz),
108 . mx6(mvsiz),my6(mvsiz),mz6(mvsiz),
109 . mx7(mvsiz),my7(mvsiz),mz7(mvsiz),
110 . mx8(mvsiz),my8(mvsiz),mz8(mvsiz),
111 . f11(mvsiz),f21(mvsiz),f31(mvsiz),
112 . f12(mvsiz),f22(mvsiz),f32(mvsiz),
113 . f13(mvsiz),f23(mvsiz),f33(mvsiz),
114 . f14(mvsiz),f24(mvsiz),f34(mvsiz),
115 . f15(mvsiz),f25(mvsiz),f35(mvsiz),
116 . f16(mvsiz),f26(mvsiz),f36(mvsiz
117 . f17(mvsiz),f27(mvsiz),f37(mvsiz),
118 . f18(mvsiz),f28(mvsiz),f38(mvsiz),
120 . dmass5(mvsiz), dmass6(mvsiz), dmass7(mvsiz), dmass8(mvsiz),
123 . nc1(mvsiz), nc2(mvsiz), nc3(mvsiz), nc4(mvsiz),
124 . nc5(mvsiz), nc6(mvsiz), nc7(mvsiz), nc8(mvsiz)
127 . AR, FR_WAVE, FTHE, FTHESKY, FFSKY, ,T2,T3
129 TYPE(g_bufel_) ,
POINTER :: GBUF
135 DO ng=itask+1,ngroup,nthread
137 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
138 IF(iparg(8,ng) /= 1)
THEN
141 2 mtn ,nel ,nft ,iad ,ity ,
142 3 npt ,jale ,ismstr ,jeul ,jtur ,
143 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
144 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
145 6 irep ,iint ,igtyp ,israt ,isrot ,
146 7 icsen ,isorth ,isorthg ,ifailure,jsms )
148 gbuf => elbuf_tab(ng)%GBUF
149 IF(jlag /= 1 .AND. ity<=2)
THEN
157 ipartsph = iparg(69,ng)
161 IF (ity == 1 .AND. isolnod /= 4)
THEN
163 gbuf => elbuf_tab(ng)%GBUF
165 CALL snorm3(nel, nft, jale, ixs, xgrid, wgrid,
166 .
norm(1:3, 1:6, 1:nel), wfac(1:3, 1:6, 1:nel), surf(1:6, 1:nel))
168 f11(:) = zero ; f21(:) = zero ; f31(:) = zero
169 f12(:) = zero ; f22(:) = zero ; f32(:) = zero
170 f13(:) = zero ; f23(:) = zero ; f33(:) = zero
171 f14(:) = zero ; f24(:) = zero ; f34(:) = zero
172 f15(:) = zero ; f25(:) = zero ; f35(:) = zero
173 f16(:) = zero ; f26(:) = zero ; f36(:) = zero
174 f17(:) = zero ; f27(:) = zero ; f37(:) = zero
175 f18(:) = zero ; f28(:) = zero ; f38(:) = zero
188 pres(ii) = third * (gbuf%SIG(ii) + gbuf%SIG(ii + nel) + gbuf%SIG(ii + 2 * nel))
190 f11(ii) = f11(ii) - fourth * pres(ii) *
191 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 4, ii) * surf(4, ii) +
norm(1, 6, ii) * surf(6, ii))
192 f21(ii) = f21(ii) - fourth * pres(ii) *
193 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 6, ii) * surf(6, ii))
194 f31(ii) = f31(ii) - fourth * pres(ii) *
195 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 4, ii) * surf(4, ii) +
norm(3, 6, ii) * surf(6, ii))
198 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 4, ii) * surf(4, ii) +
norm(1, 5, ii) * surf(5, ii))
199 f22(ii) = f22(ii) - fourth * pres(ii) *
200 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii))
202 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii))
204 f13(ii) = f13(ii) - fourth * pres(ii) *
205 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 2, ii) * surf(2, ii) +
norm(1, 5, ii) * surf(5, ii))
206 f23(ii) = f23(ii) - fourth * pres(ii) *
207 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 2, ii) * surf(2, ii) +
norm(2, 5, ii) * surf(5, ii))
208 f33(ii) = f33(ii) - fourth * pres(ii) *
209 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 2, ii) * surf(2, ii) +
norm(3, 5, ii) * surf(5, ii))
211 f14(ii) = f14(ii) - fourth * pres(ii) *
212 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 2, ii) * surf(2, ii) +
norm(1, 6, ii) * surf(6, ii))
213 f24(ii) = f24(ii) - fourth * pres(ii) *
214 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 2, ii) * surf(2, ii) +
norm(2, 6, ii) * surf(6, ii))
215 f34(ii) = f34(ii) - fourth * pres(ii) *
216 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 2, ii) * surf(2, ii) +
norm(3, 6, ii) * surf(6, ii))
218 f15(ii) = f15(ii) - fourth * pres(ii) *
219 . (
norm(1, 3, ii) * surf(3, ii) +
norm(1, 4, ii) * surf(4, ii) +
norm(1, 6, ii) * surf(6, ii))
220 f25(ii) = f25(ii) - fourth * pres(ii) *
221 . (
norm(2, 3, ii) * surf(3, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 6, ii) * surf(6, ii))
222 f35(ii) = f35(ii) - fourth * pres(ii) *
223 . (
norm(3, 3, ii) * surf(3, ii) +
norm(3, 4, ii) * surf(4, ii) +
norm(3, 6, ii) * surf(6, ii))
225 f16(ii) = f16(ii) - fourth * pres(ii) *
226 . (
norm(1, 3, ii) * surf(3, ii) +
norm(1, 4, ii) * surf(4, ii) +
norm(1, 5, ii) * surf(5, ii))
227 f26(ii) = f26(ii) - fourth * pres(ii) *
228 . (
norm(2, 3, ii) * surf(3, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii))
229 f36(ii) = f36(ii) - fourth * pres(ii) *
230 . (
norm(3, 3, ii) * surf(3, ii) +
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii))
232 f17(ii) = f17(ii) - fourth * pres(ii) *
233 . (
norm(1, 2, ii) * surf(2, ii) +
norm(1, 3, ii) * surf(3, ii) +
norm(1, 5, ii) * surf(5, ii))
234 f27(ii) = f27(ii) - fourth * pres(ii) *
235 . (
norm(2, 2, ii) * surf(2, ii) +
norm(2, 3, ii) * surf(3, ii) +
norm(2, 5, ii) * surf(5, ii))
236 f37(ii) = f37(ii) - fourth * pres(ii) *
239 f18(ii) = f18(ii) - fourth * pres(ii) *
240 . (
norm(1, 2, ii) * surf(2, ii) +
norm(1, 3, ii) * surf(3, ii) +
norm(1, 6, ii) * surf(6, ii))
242 . (
norm(2, 2, ii) * surf(2, ii) +
norm(2, 3, ii) * surf(3, ii) +
norm(2, 6, ii) * surf(6, ii))
244 . (
norm(3, 2, ii) * surf(2, ii) +
norm(3, 3, ii) * surf(3,
252 1 ms, gbuf%RHO, veul(lveul*nft+44),gbuf%TAG22,
253 2 gbuf%VOL, nc1, nc2, nc3,
254 3 nc4, nc5, nc6, nc7,
255 4 nc8, msnf, nvc, gbuf%OFF,
259 1 fskym, gbuf%RHO, veul(lveul*nft+44),gbuf%TAG22,
260 2 gbuf%VOL, iads, gbuf%OFF, ixs,
270 1 gbuf%OFF,
accele, nc1, nc2,
271 2 nc3, nc4, nc5, nc6,
272 3 nc7, nc8, stifn, sti,
273 4 f11, f21, f31, f12,
274 5 f22, f32, f13, f23,
275 6 f33, f14, f24, f34,
276 7 f15, f25, f35, f16,
277 8 f26, f36, f17, f27,
278 9 f37, f18, f28, f38,
279 a nvc, ar, fr_wave, fr_wav,
280 b mx1, my1, mz1, mx2,
281 c my2, mz2, mx3, my3,
282 d mz3, mx4, my4, mz4,
283 e mx5, my5, mz5, mx6,
284 f my6, mz6, mx7, my7,
285 g mz7, mx8, my8, mz8,
286 h them, fthe, condn, conde,
290 1 gbuf%OFF,sti, fsky, fsky,
291 2 iads, f11, f21, f31,
292 3 f12, f22, f32, f13,
293 4 f23, f33, f14, f24,
294 5 f34, f15, f25, f35,
295 6 f16, f26, f36, f17,
296 7 f27, f37, f18, f28,
297 8 f38, nc1, nc2, nc3,
298 9 nc4, nc5, nc6, nc7,
299 a nc8, ar, fr_wave, fr_wav,
300 b mx1, my1, mz1, mx2,
301 c my2, mz2, mx3, my3,
302 d mz3, mx4, my4, mz4,
303 e mx5, my5, mz5, mx6,
304 f my6, mz6, mx7, my7,
305 g mz7, mx8, my8, mz8,
306 h them, fthesky, condnsky,conde,
307 i nel, nft, jthe, isrot,
308 j ipartsph,nodadt_therm)
310 ELSE IF (ity == 1 .AND. isolnod == 4)
THEN
312 gbuf => elbuf_tab(ng)%GBUF
316 CALL snorm3t(nel, nft, jale, ixs, xgrid, wgrid,
317 .
norm(1:3, 1:6, 1:nel), wfac(1:3, 1:6, 1:nel), surf(1:6,
318 f11(:) = zero ; f21(:) = zero ; f31(:) = zero
319 f12(:) = zero ; f22(:) = zero ; f32(:) = zero
320 f13(:) = zero ; f23(:) = zero ; f33(:) = zero
321 f14(:) = zero ; f24(:) = zero ; f34(:) = zero
322 dmass1(:) = zero ; dmass2(:) = zero ; dmass3(:) = zero ; dmass4(:) = zero
332 pres(ii) = third * (gbuf%SIG(ii) + gbuf%SIG(ii + nel) + gbuf%SIG(ii + 2 * nel))
334 f11(ii) = f11(ii) - third
335 . (
norm(1, 4, ii) * surf
336 f21(ii) = f21(ii) - third * pres(ii) *
337 . (
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii) +
norm(2, 6, ii) * surf(6, ii
338 f31(ii) = f31(ii) - third * pres(ii) *
339 . (
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii) +
norm(3, 6, ii) * surf(6, ii))
341 f12(ii) = f12(ii) - third * pres(ii) *
342 . (
norm(1, 2, ii) * surf(2, ii) +
norm(1, 5, ii) * surf(5, ii) +
norm(1, 6, ii) * surf(6, ii))
343 f22(ii) = f22(ii) - third * pres(ii) *
345 f32(ii) = f32(ii) - third * pres(ii) *
346 . (
norm(3, 2, ii) * surf(2, ii) +
norm(3, 5, ii) * surf(5, ii) +
norm(3, 6, ii) * surf(6, ii))
348 f13(ii) = f13(ii) - third * pres(ii) *
349 . (
norm(1, 4, ii) * surf(4, ii) +
norm(1, 5, ii) * surf(5, ii) +
norm(1, 2, ii) * surf(2, ii))
350 f23(ii) = f23(ii) - third * pres(ii) *
351 . (
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii) +
norm(2, 2, ii) * surf(2, ii))
352 f33(ii) = f33(ii) - third * pres(ii) *
353 . (
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii) +
norm(3, 2, ii) * surf(2, ii))
355 f14(ii) = f14(ii) - third * pres(ii) *
356 . (
norm(1, 4, ii) * surf
357 f24(ii) = f24(ii) - third * pres(ii) *
358 . (
norm(2, 4, ii) * surf(4, ii) +
norm(2, 2, ii) * surf(2, ii) +
norm(2, 6, ii) * surf(6, ii))
359 f34(ii) = f34(ii) - third * pres(ii) *
360 . (
norm(3, 4, ii) * surf(4, ii) +
norm(3, 2, ii) * surf(2, ii) +
norm(3, 6, ii) * surf(6, ii))
365 IF (iparit == 0)
THEN
367 1 ms, gbuf%RHO,gbuf%VOL,nc1,
368 2 nc2, nc3, nc4, msnf,
372 1 fskym, gbuf%RHO,gbuf%VOL,iads,
382 1 gbuf%OFF,
accele, nc1, nc2,
383 2 nc3, nc4, stifn, sti,
384 3 f11, f21, f31, f12,
385 4 f22, f32, f13, f23,
386 5 f33, f14, f24, f34,
387 6 them, fthe, condn, conde,
388 7 nel, jthe, nodadt_therm)
391 1 gbuf%OFF,sti, fsky, fsky,
392 2 iads, f11, f21, f31,
393 3 f12, f22, f32, f13,
394 4 f23, f33, f14, f24,
395 5 f34, them, fthesky, condnsky,
396 6 conde, nel, nft, jthe, nodadt_therm)