1!-------------------------------------------------------------------------------
2
3! This file is part of Code_Saturne, a general-purpose CFD tool.
4!
5! Copyright (C) 1998-2021 EDF S.A.
6!
7! This program is free software; you can redistribute it and/or modify it under
8! the terms of the GNU General Public License as published by the Free Software
9! Foundation; either version 2 of the License, or (at your option) any later
10! version.
11!
12! This program is distributed in the hope that it will be useful, but WITHOUT
13! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
15! details.
16!
17! You should have received a copy of the GNU General Public License along with
18! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
19! Street, Fifth Floor, Boston, MA 02110-1301, USA.
20
21!-------------------------------------------------------------------------------
22
23!> \file cs_gas_mix_initialization.f90
24!> \brief Initialization of calculation variables for gas mixture modelling
25!> in presence of the steam gas or another gas used as variable deduced
26!> and not solved.
27!>
28!------------------------------------------------------------------------------
29
30!------------------------------------------------------------------------------
31! Arguments
32!------------------------------------------------------------------------------
33!   mode          name          role
34!------------------------------------------------------------------------------
35!______________________________________________________________________________
36
37subroutine cs_gas_mix_initialization
38
39!===============================================================================
40! Module files
41!===============================================================================
42
43use paramx
44use numvar
45use optcal
46use cstphy
47use cstnum
48use pointe
49use entsor
50use parall
51use period
52use ppppar
53use ppthch
54use ppincl
55use mesh
56use field
57use cs_c_bindings
58
59!===============================================================================
60
61implicit none
62
63! Arguments
64
65! Local variables
66
67integer          iel, iesp
68integer          iok
69integer          f_id
70
71character(len=80) :: name_d
72
73double precision volgas, vol_d
74
75type(gas_mix_species_prop) s_d, s_k
76
77double precision, dimension(:), pointer :: cvar_enth, cvar_yk
78double precision, dimension(:), pointer :: y_d
79double precision, dimension(:), pointer :: cpro_cp
80double precision, dimension(:), pointer :: mix_mol_mas
81
82!===============================================================================
83
84!===============================================================================
85! 1. Initialization
86!===============================================================================
87
88iok = 0
89
90!-- Specific heat
91if (icp.ge.0) then
92  call field_get_val_s(icp, cpro_cp)
93
94!-- Stop if Cp is not variable
95else
96  call csexit (1)
97endif
98
99if (ippmod(icompf).lt.0) then
100  ! Enthalpy
101  call field_get_val_s(ivarfl(isca(iscalt)), cvar_enth)
102endif
103
104!Deduced species (h2o_g) with steam gas
105! or Helium or Hydrogen  with noncondensable gases
106if (ippmod(igmix).eq.0) then
107  name_d = "y_he"
108elseif (ippmod(igmix).eq.1) then
109  name_d = "y_h2"
110elseif (ippmod(igmix).ge.2.and.ippmod(igmix).lt.5) then
111  name_d = "y_h2o_g"
112else ! ippmod(igmix).eq.5
113  name_d = "y_o2"
114endif
115call field_get_val_s_by_name(name_d, y_d)
116call field_get_id(name_d, f_id)
117call field_get_key_struct_gas_mix_species_prop(f_id, s_d)
118
119call field_get_val_s(igmxml, mix_mol_mas)
120
121!===============================================================================
122! 2. Deduce the mass fraction (y_d) from the mass fractions (yk) of
123!    the noncondensable gases transported
124!    Note: mass fraction has been provided by the user in the GUI or routines
125!===============================================================================
126
127if (isuite.eq.0) then
128  ! Initialization
129  volgas = 0.d0
130  vol_d  = 0.d0
131
132  do iel = 1, ncel
133    y_d(iel) = 1.d0
134
135    ! Mixture specific Heat
136    cpro_cp(iel) = 0.d0
137
138    ! Mixture molar mass
139    mix_mol_mas(iel) = 0.d0
140  enddo
141
142  do iesp = 1, nscasp
143    ! Mass fraction array of the different species
144    call field_get_val_s(ivarfl(isca(iscasp(iesp))), cvar_yk)
145
146    call field_get_key_struct_gas_mix_species_prop( &
147         ivarfl(isca(iscasp(iesp))), s_k)
148
149    do iel = 1, ncel
150      if (cvar_yk(iel).gt.1.d0.or.cvar_yk(iel).lt.0.d0) then
151        iok = iok + 1
152      endif
153      y_d(iel) = y_d(iel)-cvar_yk(iel)
154
155      ! Mixture specific heat (Cp_m0)
156      cpro_cp(iel) = cpro_cp(iel) + cvar_yk(iel)*s_k%cp
157
158      mix_mol_mas(iel) = mix_mol_mas(iel) + cvar_yk(iel)/s_k%mol_mas
159    enddo
160  enddo
161
162  ! Finalization and check
163  do iel = 1, ncel
164    if (y_d(iel).gt.1.d0.or.y_d(iel).lt.0.d0) then
165      iok = iok + 1
166    endif
167    y_d(iel) = min(max(y_d(iel), 0.d0), 1.d0)
168
169    ! specific heat (Cp_m0) of the gas mixture
170    cpro_cp(iel) = cpro_cp(iel) + y_d(iel)*s_d%cp
171
172    if (ippmod(icompf).lt.0) then
173      ! Enthalpy initialization
174      cvar_enth(iel) = cpro_cp(iel)*t0
175    endif
176
177    mix_mol_mas(iel) = mix_mol_mas(iel) + y_d(iel)/s_d%mol_mas
178    mix_mol_mas(iel) = 1.d0/mix_mol_mas(iel)
179
180    ! Gas deduced and Total gas volumes injected
181    vol_d = vol_d + volume(iel)*    &
182            (y_d(iel)/s_d%mol_mas)*mix_mol_mas(iel)
183    volgas = volgas +volume(iel)
184
185  enddo
186
187  if (irangp.ge.0) then
188   call parsom(volgas)
189   call parsom(vol_d)
190  endif
191
192  !===============================================================================
193  ! 3. Print to the log to check the variables intialization
194  !===============================================================================
195
196  write(nfecra, 200)
197  write(nfecra, 203) volgas , vol_d
198
199endif
200
201!===============================================================================
202! 4. Stop if problem
203!===============================================================================
204
205if (iok.gt.0) then
206  write(nfecra,3090) iok
207  call csexit (1)
208endif
209
210!--------
211! Formats
212!--------
213
214 200 format                                                         &
215 (/,                                                                &
216 5x,'----------------------------------------------------------' ,/,&
217 5x,'**     Gas mixture : Check variables initialization     **' ,/,&
218 5x,'----------------------------------------------------------' ,/)
219
220 203 format( &
221 3x, '   Total   gas Volume:', 3x, g17.9                         ,/,&
222 3x, '   Deduced gas Volume:', 3x, g17.9                         ,/,&
223 3x,                                                                &
224 3x,'----------------------------------------------------------' )
225
226 3090 format(                                                     &
227'@',                                                            /,&
228'@',                                                            /,&
229'@',                                                            /,&
230'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
231'@',                                                            /,&
232'@ @@ WARNING: ABORT IN THE VARIABLES INITIALIZATION',          /,&
233'@    ========',                                                /,&
234'@',                                                            /,&
235'@    THE VARIABLES INITIALIZATION IS INCOMPLETE OR',           /,&
236'@    INCOHERENT WITH THE PARAMETERS VALUE OF THE CALCULATION', /,&
237'@',                                                            /,&
238'@  The calculation will not be run (',i10,' errors).',         /,&
239'@',                                                            /,&
240'@  Refer to the previous warnings for further information.',   /,&
241'@  Pay attention to the initialization of',                    /,&
242'@                                the time-step',               /,&
243'@                                the turbulence',              /,&
244'@                                the scalars and variances',   /,&
245'@                                the time averages',           /,&
246'@',                                                            /,&
247'@  Verify the initialization and the restart file.',           /,&
248'@  In the case where the values read in the restart file',     /,&
249'@    are incorrect, they may be modified with',                /,&
250'@    cs_user_initialization.f90 or with the interface.',       /,&
251'@',                                                            /,&
252'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
253'@',                                                            /)
254
255!----
256! End
257!----
258
259return
260end subroutine cs_gas_mix_initialization
261