OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
multi_globalize.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine multi_globalize (elbuf_tab, iparg, itask, multi_fvm, partsav, iparts, gresav, igrth, grth)

Function/Subroutine Documentation

◆ multi_globalize()

subroutine multi_globalize ( type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg, *), intent(in) iparg,
integer, intent(in) itask,
type(multi_fvm_struct), intent(inout) multi_fvm,
dimension(*), intent(inout) partsav,
integer, dimension(*), intent(in) iparts,
dimension(*), intent(inout) gresav,
integer, dimension(*), intent(in) igrth,
integer, dimension(*), intent(in) grth )

Definition at line 34 of file multi_globalize.F.

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-----------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
multi_bilan
subroutine multi_bilan(partsav, vol, multi_fvm, nel, nft, iparts, gresav, igrth, grth)
Definition multi_bilan.F:33
initbuf_mod
Definition initbuf.F:160