OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
multi_globalize.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!|| multi_globalize ../engine/source/multifluid/multi_globalize.F
25!||--- called by ------------------------------------------------------
26!|| alemain ../engine/source/ale/alemain.F
27!||--- calls -----------------------------------------------------
28!|| multi_bilan ../engine/source/multifluid/multi_bilan.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| initbuf_mod ../engine/share/resol/initbuf.F
32!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
33!||====================================================================
34 SUBROUTINE multi_globalize(ELBUF_TAB, IPARG, ITASK, MULTI_FVM,
35 . PARTSAV, IPARTS, GRESAV, IGRTH, GRTH)
36C-----------------------------------------------
37C D e s c r i p t i o n
38C-----------------------------------------------
39C Submaterial values contained in Layer buffer
40C a globalized into the global buffer
41C It concerns mass density and internal energy
42C Ponderation is made with volumic fracion of
43C each submaterial
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE initbuf_mod
48 USE elbufdef_mod
49 USE multi_fvm_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "param_c.inc"
59#include "task_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
64 INTEGER, INTENT(IN) :: IPARG(NPARG, *)
65 INTEGER, INTENT(IN) :: ITASK ! SMP TASK
66 my_real, INTENT(INOUT) :: partsav(*), gresav(*)
67 INTEGER, INTENT(IN) :: IPARTS(*), IGRTH(*), GRTH(*)
68 TYPE(multi_fvm_struct), INTENT(INOUT) :: MULTI_FVM
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 TYPE(g_bufel_), POINTER :: GBUF
73 TYPE(l_bufel_), POINTER :: LBUF
74 INTEGER :: NG, II, I
75 INTEGER :: NEL, NFT, MTN
76 INTEGER :: NBMAT, IMAT
77 my_real :: vol_frac,rho_frac
78C-----------------------------------------------
79C B e g i n n i n g o f s u b r o u t i n e
80C-----------------------------------------------
81 DO ng = itask + 1, ngroup, nthread
82 mtn = iparg(1, ng)
83 IF (mtn == 151) THEN
84 nel = iparg(2, ng)
85 nft = iparg(3, ng)
86C Multifluid law number, get the number of materials
87 nbmat = iparg(20, ng)
88C Global buffer of the current group
89 gbuf => elbuf_tab(ng)%GBUF
90C Save velocities in GBUF
91 DO ii = 1, nel
92 i = ii + nft
93 gbuf%MOM(ii + 0 * nel) = multi_fvm%VEL(1, i)
94 gbuf%MOM(ii + 1 * nel) = multi_fvm%VEL(2, i)
95 gbuf%MOM(ii + 2 * nel) = multi_fvm%VEL(3, i)
96 multi_fvm%RHO(ii + nft) = gbuf%RHO(ii)
97 multi_fvm%EINT(ii + nft) = gbuf%EINT(ii)
98 ENDDO
99 IF (nbmat > 1) THEN
100 DO ii = 1, nel
101 i = ii + nft
102 gbuf%RHO(ii) = zero
103 gbuf%EINT(ii) = zero
104 gbuf%TEMP(ii) = zero
105 gbuf%SIG(ii + 0 * nel) = zero
106 gbuf%SIG(ii + 1 * nel) = zero
107 gbuf%SIG(ii + 2 * nel) = zero
108 gbuf%SIG(ii + 3 * nel) = zero
109 gbuf%SIG(ii + 4 * nel) = zero
110 gbuf%SIG(ii + 5 * nel) = zero
111
112 ENDDO
113C Loop over the fluid layers
114 DO imat = 1, nbmat
115 lbuf => elbuf_tab(ng)%BUFLY(imat)%LBUF(1, 1, 1)
116 DO ii = 1, nel
117 i = ii + nft
118 vol_frac = lbuf%VOL(ii) / gbuf%VOL(ii)
119 gbuf%RHO(ii) = gbuf%RHO(ii) + vol_frac * lbuf%RHO(ii)
120 gbuf%EINT(ii) = gbuf%EINT(ii) + vol_frac * lbuf%EINT(ii)
121 gbuf%SIG(ii + 0 * nel) = gbuf%SIG(ii + 0 * nel) + vol_frac * lbuf%SIG(ii + 0 * nel)
122 gbuf%SIG(ii + 1 * nel) = gbuf%SIG(ii + 1 * nel) + vol_frac * lbuf%SIG(ii + 1 * nel)
123 gbuf%SIG(ii + 2 * nel) = gbuf%SIG(ii + 2 * nel) + vol_frac * lbuf%SIG(ii + 2 * nel)
124 gbuf%SIG(ii + 3 * nel) = gbuf%SIG(ii + 3 * nel) + vol_frac * lbuf%SIG(ii + 3 * nel)
125 gbuf%SIG(ii + 4 * nel) = gbuf%SIG(ii + 4 * nel) + vol_frac * lbuf%SIG(ii + 4 * nel)
126 gbuf%SIG(ii + 5 * nel) = gbuf%SIG(ii + 5 * nel) + vol_frac * lbuf%SIG(ii + 5 * nel)
127 multi_fvm%PHASE_ALPHA(imat, i) = vol_frac
128 multi_fvm%PHASE_RHO(imat, i) = lbuf%RHO(ii)
129 multi_fvm%PHASE_EINT(imat, i) = lbuf%EINT(ii)
130 multi_fvm%PHASE_PRES(imat, i) = -third * (
131 . lbuf%SIG(ii + 0 * nel) +
132 . lbuf%SIG(ii + 1 * nel) +
133 . lbuf%SIG(ii + 2 * nel))
134 ENDDO
135 ENDDO ! IMAT = 1, NBMAT
136C Global temperature
137 DO imat = 1, nbmat
138 lbuf => elbuf_tab(ng)%BUFLY(imat)%LBUF(1, 1, 1)
139 DO ii = 1, nel
140 i = ii + nft
141 vol_frac = lbuf%VOL(ii) / gbuf%VOL(ii)
142 rho_frac = lbuf%RHO(ii) / gbuf%RHO(ii)
143 gbuf%TEMP(ii) = gbuf%TEMP(ii) + rho_frac*vol_frac * lbuf%TEMP(ii)
144 ENDDO
145 ENDDO ! IMAT = 1, NBMAT
146C
147 DO ii = 1, nel
148 i = ii + nft
149 multi_fvm%RHO(i) = gbuf%RHO(ii)
150 multi_fvm%EINT(i) = gbuf%EINT(ii)
151 multi_fvm%PRES(i) = -third * (gbuf%SIG(ii + 0 * nel) + gbuf%SIG(ii + 1 * nel) + gbuf%SIG(ii + 2 * nel))
152 ENDDO
153 ENDIF ! NBMAT > 1
154 CALL multi_bilan(partsav, gbuf%VOL, multi_fvm,
155 . nel, nft, iparts(1 + nft), gresav, igrth, grth)
156 ENDIF
157 ENDDO ! NG = ITASK + 1, NGROUP, NTHREAD
158C-----------------------------------------------
159C E n d o f s u b r o u t i n e
160C-----------------------------------------------
161 END SUBROUTINE multi_globalize
#define my_real
Definition cppsort.cpp:32
subroutine multi_bilan(partsav, vol, multi_fvm, nel, nft, iparts, gresav, igrth, grth)
Definition multi_bilan.F:33
subroutine multi_globalize(elbuf_tab, iparg, itask, multi_fvm, partsav, iparts, gresav, igrth, grth)