46 . IXS, IXQ, IPARG, XGRID, ACCELE, VEL, WGRID, MS, MSNF, VEUL,
47 . STIFN, FSKY, IADS, FSKYM,
48 . CONDN, CONDNSKY, MULTI_FVM,NODADT_THERM)
55 use element_mod ,
only : nixs,nixq
59#include "implicit_f.inc"
68#include "vect01_c.inc"
77 TYPE (ELBUF_STRUCT_),
TARGET,
DIMENSION(NGROUP),
INTENT(IN) :: ELBUF_TAB
78 INTEGER,
INTENT(IN) :: NODADT_THERM
79 INTEGER,
INTENT(IN) :: ITASK, IPARG(NPARG, *), IXS(NIXS, *), IXQ(NIXQ, *),
83 . xgrid(3, *), wgrid(3, *), veul(*), vel(3, *), timestep
87 my_real,
INTENT(INOUT) :: fskym(*), stifn(*), fsky(8,lsky),
88 . condn(*), condnsky(*)
89 TYPE(multi_fvm_struct),
INTENT(IN) :: MULTI_FVM
94 INTEGER :: I, II, K, NF1, ISTRA, ISOLNOD, NSG, IPLA, NG, NEL, NVC
97 my_real ::
norm(3, 6, mvsiz), surf(6, mvsiz), wfac(3, 6, mvsiz)
103 . sti(mvsiz), fr_wav(mvsiz), them(mvsiz,8), conde(mvsiz)
105 . mx1(mvsiz),my1(mvsiz),mz1(mvsiz),
106 . mx2(mvsiz),my2(mvsiz),mz2(mvsiz),
107 . mx3(mvsiz),my3(mvsiz),mz3(mvsiz),
108 . mx4(mvsiz),my4(mvsiz),mz4(mvsiz),
109 . mx5(mvsiz),my5(mvsiz),mz5(mvsiz),
110 . mx6(mvsiz),my6(mvsiz),mz6(mvsiz),
111 . mx7(mvsiz),my7(mvsiz),mz7(mvsiz),
112 . mx8(mvsiz),my8(mvsiz),mz8(mvsiz),
113 . f11(mvsiz),f21(mvsiz),f31(mvsiz),
114 . f12(mvsiz),f22(mvsiz),f32(mvsiz),
115 . f13(mvsiz),f23(mvsiz),f33(mvsiz),
116 . f14(mvsiz),f24(mvsiz),f34(mvsiz),
117 . f15(mvsiz),f25(mvsiz),f35(mvsiz),
118 . f16(mvsiz),f26(mvsiz),f36(mvsiz),
119 . f17(mvsiz),f27(mvsiz),f37(mvsiz),
120 . f18(mvsiz),f28(mvsiz),f38(mvsiz),
121 . dmass1(mvsiz), dmass2(mvsiz), dmass3(mvsiz), dmass4(mvsiz),
122 . dmass5(mvsiz), dmass6(mvsiz), dmass7(mvsiz), dmass8(mvsiz),
125 . nc1(mvsiz), nc2(mvsiz), nc3(mvsiz), nc4(mvsiz),
126 . nc5(mvsiz), nc6(mvsiz), nc7(mvsiz), nc8(mvsiz)
129 . AR, FR_WAVE, FTHE, FTHESKY, FFSKY, T1,T2,T3
131 TYPE(g_bufel_) ,
POINTER :: GBUF
137 DO ng=itask+1,ngroup,nthread
139 IF (tt > zero .AND. iparg(76, ng) == 1) cycle
140 IF(iparg(8,ng) /= 1)
THEN
143 2 mtn ,nel ,nft ,iad ,ity ,
144 3 npt ,jale ,ismstr ,jeul ,jtur ,
145 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
146 5 nvaux ,jpor ,jcvt ,jclose ,ipla ,
147 6 irep ,iint ,igtyp ,israt ,isrot ,
148 7 icsen ,isorth ,isorthg ,ifailure,jsms )
150 gbuf => elbuf_tab(ng)%GBUF
151 IF(jlag /= 1 .AND. ity<=2)
THEN
159 ipartsph = iparg(69,ng)
163 IF (ity == 1 .AND. isolnod /= 4)
THEN
165 gbuf => elbuf_tab(ng)%GBUF
167 CALL snorm3(nel, nft, jale, ixs, xgrid, wgrid,
168 .
norm(1:3, 1:6, 1:nel), wfac(1:3, 1:6, 1:nel), surf(1:6, 1:nel))
170 f11(:) = zero ; f21(:) = zero
171 f12(:) = zero ; f22(:) = zero ; f32(:) = zero
172 f13(:) = zero ; f23(:) = zero ; f33(:) = zero
173 f14(:) = zero ; f24(:) = zero ; f34(:) = zero
174 f15(:) = zero ; f25(:) = zero ; f35(:) = zero
175 f16(:) = zero ; f26(:) = zero ; f36(:) = zero
176 f17(:) = zero ; f27(:) = zero ; f37(:) = zero
177 f18(:) = zero ; f28(:) = zero ; f38(:) = zero
190 pres(ii) = third * (gbuf%SIG(ii) + gbuf%SIG(ii + nel) + gbuf%SIG(ii + 2 * nel))
192 f11(ii) = f11(ii) - fourth * pres(ii) *
193 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 4, ii) * surf(4, ii) +
norm(1, 6, ii) * surf(6, ii))
194 f21(ii) = f21(ii) - fourth * pres(ii) *
195 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 6, ii) * surf(6, ii))
196 f31(ii) = f31(ii) - fourth * pres(ii) *
197 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 4, ii) * surf(4, ii) +
norm(3, 6, ii) * surf(6, ii))
199 f12(ii) = f12(ii) - fourth * pres(ii) *
200 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 4, ii) * surf(4, ii) +
norm(1, 5, ii) * surf(5, ii))
201 f22(ii) = f22(ii) - fourth * pres(ii) *
202 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii))
203 f32(ii) = f32(ii) - fourth * pres(ii) *
204 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii))
206 f13(ii) = f13(ii) - fourth * pres(ii) *
207 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 2, ii) * surf(2, ii) +
norm(1, 5, ii) * surf(5, ii))
208 f23(ii) = f23(ii) - fourth * pres(ii) *
209 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 2, ii) * surf(2, ii) +
norm(2, 5, ii) * surf(5, ii))
210 f33(ii) = f33(ii) - fourth * pres(ii) *
211 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 2, ii) * surf(2, ii) +
norm(3, 5, ii) * surf(5, ii))
213 f14(ii) = f14(ii) - fourth * pres(ii) *
214 . (
norm(1, 1, ii) * surf(1, ii) +
norm(1, 2, ii) * surf(2, ii) +
norm(1, 6, ii) * surf(6, ii))
215 f24(ii) = f24(ii) - fourth * pres(ii) *
216 . (
norm(2, 1, ii) * surf(1, ii) +
norm(2, 2, ii) * surf(2, ii) +
norm(2, 6, ii) * surf(6, ii))
217 f34(ii) = f34(ii) - fourth * pres(ii) *
218 . (
norm(3, 1, ii) * surf(1, ii) +
norm(3, 2, ii) * surf(2, ii) +
norm(3, 6, ii) * surf(6, ii))
220 f15(ii) = f15(ii) - fourth * pres(ii) *
221 . (
norm(1, 3, ii) * surf(3, ii) +
norm(1, 4, ii) * surf(4, ii) +
norm(1, 6, ii) * surf(6, ii))
222 f25(ii) = f25(ii) - fourth * pres(ii) *
223 . (
norm(2, 3, ii) * surf(3, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 6, ii) * surf(6, ii))
224 f35(ii) = f35(ii) - fourth * pres(ii) *
227 f16(ii) = f16(ii) - fourth * pres(ii) *
229 f26(ii) = f26(ii) - fourth * pres(ii) *
230 . (
norm(2, 3, ii) * surf(3, ii) +
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii))
231 f36(ii) = f36(ii) - fourth * pres(ii) *
232 . (
norm(3, 3, ii) * surf(3, ii) +
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii))
234 f17(ii) = f17(ii) - fourth * pres(ii) *
235 . (
norm(1, 2, ii) * surf(2, ii) +
norm(1, 3, ii) * surf(3, ii) +
norm(1, 5, ii) * surf(5, ii))
236 f27(ii) = f27(ii) - fourth * pres(ii) *
237 . (
norm(2, 2, ii) * surf(2, ii) +
norm(2, 3, ii) * surf(3, ii) +
norm(2, 5, ii) * surf(5, ii))
238 f37(ii) = f37(ii) - fourth * pres
239 . (
norm(3, 2, ii) * surf(2, ii) +
norm(3, 3, ii) * surf(3, ii) +
norm(3, 5, ii) * surf(5, ii))
241 f18(ii) = f18(ii) - fourth * pres(ii) *
242 . (
norm(1, 2, ii) * surf(2, ii) +
norm(1, 3, ii) * surf(3, ii) +
norm(1, 6, ii) * surf(6, ii))
243 f28(ii) = f28(ii) - fourth * pres(ii) *
244 . (
norm(2, 2, ii) * surf(2, ii) +
norm(2, 3, ii) * surf(3, ii) +
norm(2, 6, ii) * surf(6, ii))
245 f38(ii) = f38(ii) - fourth * pres(ii) *
246 . (
norm(3, 2, ii) * surf(2, ii) +
norm(3, 3, ii) * surf(3, ii) +
norm(3, 6, ii) * surf(6, ii))
254 1 ms, gbuf%RHO, veul(lveul*nft+44),gbuf%TAG22,
255 2 gbuf%VOL, nc1, nc2, nc3,
256 3 nc4, nc5, nc6, nc7,
257 4 nc8, msnf, nvc, gbuf%OFF,
261 1 fskym, gbuf%RHO, veul(lveul*nft+44),gbuf%TAG22,
262 2 gbuf%VOL, iads, gbuf%OFF, ixs,
272 1 gbuf%OFF,
accele, nc1, nc2,
273 2 nc3, nc4, nc5, nc6,
274 3 nc7, nc8, stifn, sti,
275 4 f11, f21, f31, f12,
276 5 f22, f32, f13, f23,
277 6 f33, f14, f24, f34,
278 7 f15, f25, f35, f16,
279 8 f26, f36, f17, f27,
280 9 f37, f18, f28, f38,
281 a nvc, ar, fr_wave, fr_wav,
282 b mx1, my1, mz1, mx2,
283 c my2, mz2, mx3, my3,
284 d mz3, mx4, my4, mz4,
285 e mx5, my5, mz5, mx6,
286 f my6, mz6, mx7, my7,
287 g mz7, mx8, my8, mz8,
288 h them, fthe, condn, conde,
289 i nel, jthe, isrot, ipartsph,nodadt_therm)
292 1 gbuf%OFF,sti, fsky, fsky,
293 2 iads, f11, f21, f31,
294 3 f12, f22, f32, f13,
295 4 f23, f33, f14, f24,
296 5 f34, f15, f25, f35,
297 6 f16, f26, f36, f17,
298 7 f27, f37, f18, f28,
299 8 f38, nc1, nc2, nc3,
300 9 nc4, nc5, nc6, nc7,
301 a nc8, ar, fr_wave, fr_wav,
302 b mx1, my1, mz1, mx2,
303 c my2, mz2, mx3, my3,
304 d mz3, mx4, my4, mz4,
305 e mx5, my5, mz5, mx6,
306 f my6, mz6, mx7, my7,
307 g mz7, mx8, my8, mz8,
308 h them, fthesky, condnsky,conde,
309 i nel, nft, jthe, isrot,
310 j ipartsph,nodadt_therm)
312 ELSE IF (ity == 1 .AND. isolnod == 4)
THEN
314 gbuf => elbuf_tab(ng)%GBUF
318 CALL snorm3t(nel, nft, jale, ixs, xgrid, wgrid
319 .
norm(1:3, 1:6, 1:nel), wfac(1:3, 1:6, 1:nel), surf
320 f11(:) = zero ; f21(:) = zero ; f31
321 f12(:) = zero ; f22(:) = zero ; f32(:) = zero
322 f13(:) = zero ; f23(:) = zero ; f33(:) = zero
323 f14(:) = zero ; f24(:) = zero ; f34(:) = zero
324 dmass1(:) = zero ; dmass2(:) = zero ; dmass3(:) = zero
336 f11(ii) = f11(ii) - third * pres(ii) *
337 . (
norm(1, 4, ii) * surf(4, ii) +
norm(1, 5, ii) * surf(5, ii) +
norm(1, 6, ii) * surf(6, ii))
338 f21(ii) = f21(ii) - third * pres
339 . (
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii) +
norm(2, 6, ii) * surf(6, ii))
340 f31(ii) = f31(ii) - third * pres(ii) *
341 . (
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii) +
norm(3, 6, ii) * surf(6, ii))
345 f22(ii) = f22(ii) - third * pres(ii) *
346 . (
norm(2, 2, ii) * surf(2, ii) +
norm(2, 5, ii) * surf(5, ii) +
norm(2, 6, ii) * surf(6, ii))
347 f32(ii) = f32(ii) - third * pres(ii) *
348 . (
norm(3, 2, ii) * surf(2, ii) +
norm(3, 5, ii) * surf(5, ii
350 f13(ii) = f13(ii) - third * pres(ii) *
351 . (
norm(1, 4, ii) * surf(4, ii) +
norm(1, 5, ii) * surf(5, ii) +
norm(1, 2, ii) * surf(2, ii))
352 f23(ii) = f23(ii) - third * pres(ii) *
353 . (
norm(2, 4, ii) * surf(4, ii) +
norm(2, 5, ii) * surf(5, ii) +
norm(2, 2, ii) * surf(2, ii))
354 f33(ii) = f33(ii) - third * pres(ii) *
355 . (
norm(3, 4, ii) * surf(4, ii) +
norm(3, 5, ii) * surf(5, ii) +
norm(3, 2, ii) * surf(2, ii))
357 f14(ii) = f14(ii) - third * pres(ii) *
358 . (
norm(1, 4, ii) * surf(4, ii) +
norm(1, 2, ii) * surf(2, ii) +
norm(1, 6, ii) * surf(6, ii))
359 f24(ii) = f24(ii) - third * pres(ii) *
360 . (
norm(2, 4, ii) * surf(4, ii) +
norm(2, 2, ii) * surf(2, ii) +
norm(2, 6, ii) * surf(6, ii))
361 f34(ii) = f34(ii) - third * pres(ii) *
362 . (
norm(3, 4, ii) * surf(4, ii) +
norm(3, 2, ii) * surf(2, ii) +
norm(3, 6, ii) * surf(6, ii))
367 IF (iparit == 0)
THEN
369 1 ms, gbuf%RHO,gbuf%VOL,nc1,
370 2 nc2, nc3, nc4, msnf,
374 1 fskym, gbuf%RHO,gbuf%VOL,iads,
384 1 gbuf%OFF,
accele, nc1, nc2,
385 2 nc3, nc4, stifn, sti,
386 3 f11, f21, f31, f12,
387 4 f22, f32, f13, f23,
388 5 f33, f14, f24, f34,
389 6 them, fthe, condn, conde,
390 7 nel, jthe, nodadt_therm)
393 1 gbuf%OFF,sti, fsky, fsky,
394 2 iads, f11, f21, f31,
395 3 f12, f22, f32, f13,
396 4 f23, f33, f14, f24,
397 5 f34, them, fthesky, condnsky,
398 6 conde, nel, nft, jthe, nodadt_therm)