← Back to branch summary

~ubuntu-branches/ubuntu/precise/code-saturne/precise

« back to all changes in this revision

Viewing changes to src/fuel/fuphyv.f90

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-01 17:43:32 UTC
  • mto: (6.1.7 sid)
  • mto: This revision was merged to the branch mainline in revision 11.
  • Revision ID: package-import@ubuntu.com-20111101174332-tl4vk45no0x3emc3
Tags: upstream-2.1.0
Import upstream version 2.1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/fuel/fuphyv.f90
1
 
!-------------------------------------------------------------------------------
2
 
 
3
 
!     This file is part of the Code_Saturne Kernel, element of the
4
 
!     Code_Saturne CFD tool.
5
 
 
6
 
!     Copyright (C) 1998-2009 EDF S.A., France
7
 
 
8
 
!     contact: saturne-support@edf.fr
9
 
 
10
 
!     The Code_Saturne Kernel is free software; you can redistribute it
11
 
!     and/or modify it under the terms of the GNU General Public License
12
 
!     as published by the Free Software Foundation; either version 2 of
13
 
!     the License, or (at your option) any later version.
14
 
 
15
 
!     The Code_Saturne Kernel is distributed in the hope that it will be
16
 
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
17
 
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
 
!     GNU General Public License for more details.
19
 
 
20
 
!     You should have received a copy of the GNU General Public License
21
 
!     along with the Code_Saturne Kernel; if not, write to the
22
 
!     Free Software Foundation, Inc.,
23
 
!     51 Franklin St, Fifth Floor,
24
 
!     Boston, MA  02110-1301  USA
25
 
 
26
 
!-------------------------------------------------------------------------------
27
 
 
28
 
subroutine fuphyv &
29
 
!================
30
 
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  ,                                     &
35
 
   nideve , nrdeve , nituse , nrtuse , nphmx  ,                   &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr , ibrom  , izfppp ,          &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
40
 
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
41
 
   coefa  , coefb  ,                                              &
42
 
   w1     , w2     , w3     , w4     ,                            &
43
 
   w5     , w6     , w7     , w8     ,                            &
44
 
   rdevel , rtuser , ra     )
45
 
 
46
 
!===============================================================================
47
 
! FONCTION :
48
 
! --------
49
 
 
50
 
! ROUTINE PHYSIQUE PARTICULIERE : COMBUSTION FUEL
51
 
 
52
 
! Calcul de RHO du melange
53
 
 
54
 
 
55
 
! ATTENTION :
56
 
! =========
57
 
 
58
 
 
59
 
! Il est INTERDIT de modifier la viscosite turbulente VISCT ici
60
 
!        ========
61
 
!  (une routine specifique est dediee a cela : usvist)
62
 
 
63
 
 
64
 
!  Il FAUT AVOIR PRECISE ICP(IPHAS) = 1
65
 
!     ==================
66
 
!    dans usini1 si on souhaite imposer une chaleur specifique
67
 
!    CP variable pour la phase IPHAS (sinon: ecrasement memoire).
68
 
 
69
 
 
70
 
!  Il FAUT AVOIR PRECISE IVISLS(Numero de scalaire) = 1
71
 
!     ==================
72
 
!     dans usini1 si on souhaite une diffusivite VISCLS variable
73
 
!     pour le scalaire considere (sinon: ecrasement memoire).
74
 
 
75
 
 
76
 
 
77
 
 
78
 
! Remarques :
79
 
! ---------
80
 
 
81
 
! Cette routine est appelee au debut de chaque pas de temps
82
 
 
83
 
!    Ainsi, AU PREMIER PAS DE TEMPS (calcul non suite), les seules
84
 
!    grandeurs initialisees avant appel sont celles donnees
85
 
!      - dans usini1 :
86
 
!             . la masse volumique (initialisee a RO0(IPHAS))
87
 
!             . la viscosite       (initialisee a VISCL0(IPHAS))
88
 
!      - dans usppiv :
89
 
!             . les variables de calcul  (initialisees a 0 par defaut
90
 
!             ou a la valeur donnee dans usiniv)
91
 
 
92
 
! On peut donner ici les lois de variation aux cellules
93
 
!     - de la masse volumique                      ROM    kg/m3
94
 
!         (et eventuellememt aux faces de bord     ROMB   kg/m3)
95
 
!     - de la viscosite moleculaire                VISCL  kg/(m s)
96
 
!     - de la chaleur specifique associee          CP     J/(kg degres)
97
 
!     - des "diffusivites" associees aux scalaires VISCLS kg/(m s)
98
 
 
99
 
 
100
 
! On dispose des types de faces de bord au pas de temps
101
 
!   precedent (sauf au premier pas de temps, ou les tableaux
102
 
!   ITYPFB et ITRIFB n'ont pas ete renseignes)
103
 
 
104
 
 
105
 
! Il est conseille de ne garder dans ce sous programme que
106
 
!    le strict necessaire.
107
 
 
108
 
 
109
 
 
110
 
! Arguments
111
 
!__________________.____._____.________________________________________________.
112
 
! name             !type!mode ! role                                           !
113
 
!__________________!____!_____!________________________________________________!
114
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
115
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
116
 
! ndim             ! i  ! <-- ! spatial dimension                              !
117
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
118
 
! ncel             ! i  ! <-- ! number of cells                                !
119
 
! nfac             ! i  ! <-- ! number of interior faces                       !
120
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
121
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
122
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
123
 
! nnod             ! i  ! <-- ! number of vertices                             !
124
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
125
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
126
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
127
 
! nvar             ! i  ! <-- ! total number of variables                      !
128
 
! nscal            ! i  ! <-- ! total number of scalars                        !
129
 
! nphas            ! i  ! <-- ! number of phases                               !
130
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
131
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
132
 
! nphmx            ! e  ! <-- ! nphsmx                                         !
133
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
134
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
135
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
136
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
137
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
138
 
!  (nfml, nprfml)  !    !     !                                                !
139
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
140
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
141
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
142
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
143
 
! ibrom            ! te ! <-- ! indicateur de remplissage de romb              !
144
 
!   (nphmx   )     !    !     !                                                !
145
 
! izfppp           ! te ! <-- ! numero de zone de la face de bord              !
146
 
! (nfabor)         !    !     !  pour le module phys. part.                    !
147
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
148
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
149
 
! ia(*)            ! ia ! --- ! main integer work array                        !
150
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
151
 
!  (ndim, ncelet)  !    !     !                                                !
152
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
153
 
!  (ndim, nfac)    !    !     !                                                !
154
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
155
 
!  (ndim, nfabor)  !    !     !                                                !
156
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
157
 
!  (ndim, nfac)    !    !     !                                                !
158
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
159
 
!  (ndim, nfabor)  !    !     !                                                !
160
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
161
 
!  (ndim, nnod)    !    !     !                                                !
162
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
163
 
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
164
 
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
165
 
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
166
 
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
167
 
! propfa(nfac, *)  ! ra ! <-- ! physical properties at interior face centers   !
168
 
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
169
 
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
170
 
!  (nfabor, *)     !    !     !                                                !
171
 
! w1...8(ncelet    ! tr ! --- ! tableau de travail                             !
172
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
173
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
174
 
! ra(*)            ! ra ! --- ! main real work array                           !
175
 
!__________________!____!_____!________________________________________________!
176
 
 
177
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
178
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
179
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
180
 
!            --- tableau de travail
181
 
!===============================================================================
182
 
 
183
 
implicit none
184
 
 
185
 
!===============================================================================
186
 
! Common blocks
187
 
!===============================================================================
188
 
 
189
 
include "paramx.h"
190
 
include "numvar.h"
191
 
include "optcal.h"
192
 
include "cstphy.h"
193
 
include "cstnum.h"
194
 
include "entsor.h"
195
 
include "parall.h"
196
 
include "ppppar.h"
197
 
include "ppthch.h"
198
 
include "coincl.h"
199
 
include "cpincl.h"
200
 
include "fuincl.h"
201
 
include "ppincl.h"
202
 
include "ppcpfu.h"
203
 
 
204
 
!===============================================================================
205
 
 
206
 
! Arguments
207
 
 
208
 
integer          idbia0 , idbra0
209
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
210
 
integer          nfml   , nprfml
211
 
integer          nnod   , lndfac , lndfbr , ncelbr
212
 
integer          nvar   , nscal  , nphas
213
 
integer          nideve , nrdeve , nituse , nrtuse , nphmx
214
 
 
215
 
integer          ifacel(2,nfac) , ifabor(nfabor)
216
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
217
 
integer          iprfml(nfml,nprfml)
218
 
integer          ipnfac(nfac+1), nodfac(lndfac)
219
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr), ibrom(nphmx)
220
 
integer          izfppp(nfabor)
221
 
integer          idevel(nideve), ituser(nituse), ia(*)
222
 
 
223
 
double precision xyzcen(ndim,ncelet)
224
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
225
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
226
 
double precision xyznod(ndim,nnod), volume(ncelet)
227
 
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
228
 
double precision propce(ncelet,*)
229
 
double precision propfa(nfac,*), propfb(nfabor,*)
230
 
double precision coefa(nfabor,*), coefb(nfabor,*)
231
 
double precision w1(ncelet),w2(ncelet),w3(ncelet),w4(ncelet)
232
 
double precision w5(ncelet),w6(ncelet),w7(ncelet),w8(ncelet)
233
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
234
 
 
235
 
! Local variables
236
 
 
237
 
integer          idebia, idebra
238
 
integer          ntbfui, ifuwi, ntbfur, ifuwr
239
 
integer          ntbwoi, iwori, ntbwor, iworr
240
 
integer          ifinia, ifinra
241
 
integer          iel, iphas, ipcrom, ipcro2 , ipcte1
242
 
integer          izone, ifac , icla
243
 
integer          ipbrom, iromf
244
 
double precision qtotz
245
 
double precision x1sro1, x2sro2, srrom1, uns1pw
246
 
double precision x2tot, wmolme, unsro1
247
 
double precision x2h2
248
 
 
249
 
integer       ipass
250
 
data          ipass /0/
251
 
save          ipass
252
 
 
253
 
!===============================================================================
254
 
!===============================================================================
255
 
! 0. ON COMPTE LES PASSAGES
256
 
!===============================================================================
257
 
 
258
 
ipass = ipass + 1
259
 
 
260
 
!===============================================================================
261
 
! 1. INITIALISATIONS A CONSERVER
262
 
!===============================================================================
263
 
 
264
 
! --- Initialisation memoire
265
 
 
266
 
idebia = idbia0
267
 
idebra = idbra0
268
 
 
269
 
! --- Initialisation des tableaux de travail
270
 
 
271
 
do iel = 1, ncel
272
 
  w1(iel) = zero
273
 
  w2(iel) = zero
274
 
  w3(iel) = zero
275
 
  w4(iel) = zero
276
 
  w5(iel) = zero
277
 
  w6(iel) = zero
278
 
  w7(iel) = zero
279
 
  w8(iel) = zero
280
 
enddo
281
 
 
282
 
!     Pointeur sur masse volumique du gaz aux cellules
283
 
iromf = ipproc(irom1)
284
 
 
285
 
!===============================================================================
286
 
! 2. CALCUL DES PROPRIETES PHYSIQUES DE LA PHASE DISPERSEE
287
 
!                    VALEURS CELLULES
288
 
!                    ----------------
289
 
!    FRACTION MASSIQUE DE LIQUIDE
290
 
!    DIAMETRE
291
 
!    MASSE VOLUMIQUE
292
 
!===============================================================================
293
 
 
294
 
call fuphy2                                                       &
295
 
!==========
296
 
 ( ncelet , ncel   ,                                              &
297
 
   rtp    , propce )
298
 
 
299
 
!===============================================================================
300
 
! 3. CALCUL DES PROPRIETES PHYSIQUES DE LA PHASE GAZEUSE
301
 
!                    VALEURS CELLULES
302
 
!                    ----------------
303
 
!    TEMPERATURE
304
 
!    MASSE VOLUMIQUE
305
 
!    CONCENTRATIONS DES ESPECES GAZEUSES
306
 
!===============================================================================
307
 
 
308
 
! --- Calcul de l'enthalpie du gaz     dans W8 si transport de H2
309
 
!                           du melange         si pas de transport de H2
310
 
!            de F1M                    dans W2
311
 
!            de F2M                    dans W3
312
 
!            de F3M                    dans W4
313
 
!            de F4M                    dans W5
314
 
!            de F3P2M                  dans W6
315
 
!            de F4P2M                  dans W7
316
 
 
317
 
! ---- W1 = - Somme des X2(i)
318
 
 
319
 
do iel = 1, ncel
320
 
 
321
 
  w1(iel) = 0.d0
322
 
  do icla = 1, nclafu
323
 
    w1(iel) = w1(iel) - rtp(iel,isca(iyfol(icla)))
324
 
  enddo
325
 
  uns1pw  = 1.d0 / ( 1.d0 + w1(iel) )
326
 
  w2(iel) =  rtp(iel,isca(ifvap))  * uns1pw
327
 
  w4(iel) =  rtp(iel,isca(ifhtf))  * uns1pw
328
 
  w6(iel) =  rtp(iel,isca(if4p2m)) * uns1pw
329
 
 
330
 
! PPl 09 08 2006
331
 
!     Les tableaux de travail contiennent les grandeurs massiques de la
332
 
!     phase gaz
333
 
!     Les grandeurs variances de F1 et F3 ne sont pas utilis�es pour
334
 
!     la pdf passant par F4, y placer plutot la variance de F4
335
 
 
336
 
!      W6(IEL) = RTP(IEL,ISCA(IF4P2M)) * UNS1PW
337
 
! PPl 161205
338
 
!       Attention, contrairement au cas charbon, la 2� enthalpie transport�e
339
 
!       dans le cas du fuel est celle de l'ensemble liquide + vapeur
340
 
!       dans les conditions d'�bullition.
341
 
!       La reconstitution de l'enthalpie du gaz seul est donc fausse ...
342
 
 
343
 
!       X1 * H1 = HM - HLF + FVAP * HrefEvap
344
 
!       X2 * H2 = HLF - FVAP * HrefEvap
345
 
!       o� X1 et X2 sont les fraction s massiques des deux phases
346
 
!       H1 l'enthalpie massique de la phase continue
347
 
!       H2 l'enthalpie massique de la phase dispers�e
348
 
!       HM l'enthalpie massique du m�lange
349
 
!       HLF l'enthalpie du liquide et de la vapeur
350
 
!           (ramen�e � la masse de m�lange)
351
 
!       FVAP la fraction massique du traceur attach� � la vapeur
352
 
!       HrefVap l'enthalpie massique de la vapeur dans les
353
 
!            conditons moyennes d'�vaporation soit
354
 
!                      0.5*(TEVAP1+Min(Tevap2,Tliqu))
355
 
 
356
 
!            TEBMOY = 0.5D0 * ( TEVAP1
357
 
!    &              + MIN( PROPCE(IEL,IPPROC(ITEMP3)) , TEVAP2 ) )
358
 
!            EH2 = ( RTP(IEL,ISCA(IHLF ))
359
 
!    &           - RTP(IEL,ISCA(IFVAP))
360
 
!    &           * ( H02FOL + HRFVAP + CP2FOL * (TEBMOY-TREFTH) ) )
361
 
!            W8(IEL) = (RTP(IEL,ISCA(IHM))-EH2) * UNS1PW
362
 
! PPl 200106 c'�tait bien beau tant qu'il n'y avait que de la vapeur
363
 
!  mais avec la combustion h�t�rog�ne c'est le foutoir
364
 
!  on repasse (momentan�ment ?) � une enthalpie de phase
365
 
 
366
 
  x2h2 = 0.d0
367
 
  do icla = 1, nclafu
368
 
    x2h2 = x2h2 + rtp(iel,isca(ihlf(icla)))
369
 
  enddo
370
 
  w8(iel) = ( rtp(iel,isca(ihm)) - x2h2 )                         &
371
 
           *uns1pw
372
 
 
373
 
enddo
374
 
 
375
 
 
376
 
! --- Gestion memoire
377
 
!     Autres tableaux
378
 
 
379
 
! ------ Macro tableau d'entiers TBFUI : NTBFUI
380
 
!        Macro tableau de reels  TBFUR : NTBFUR
381
 
!        Macro tableau d'entiers TBWOI : NTBWOI
382
 
!        Macro tableau de reels  TBWOR : NTBWOR
383
 
 
384
 
ntbfui = 1
385
 
if ( ieqnox .eq. 0 ) then
386
 
  ntbfur = 11
387
 
else
388
 
  ntbfur = 12
389
 
endif
390
 
ntbwoi = 0
391
 
ntbwor = 2
392
 
 
393
 
call memfu1                                                       &
394
 
!==========
395
 
 ( idebia , idebra ,                                              &
396
 
   nvar   , ncelet , ncel   , nfac   , nfabor ,                   &
397
 
   ntbfui , ifuwi  ,                                              &
398
 
   ntbfur , ifuwr  ,                                              &
399
 
   ntbwoi , iwori  ,                                              &
400
 
   ntbwor , iworr  ,                                              &
401
 
   ifinia , ifinra )
402
 
 
403
 
iphas  = 1
404
 
 
405
 
call fuphy1                                                       &
406
 
!==========
407
 
 ( ifinia , ifinra ,                                              &
408
 
   ncelet , ncel   ,                                              &
409
 
   ntbfui , ntbfur , ntbwoi , ntbwor ,                            &
410
 
   w2     , w4     , w6     ,                                     &
411
 
!         FVAP    FHTF    F4P2M
412
 
   w8     ,                                                       &
413
 
!         ENTH du gaz
414
 
   rtp    , propce  , propce(1,iromf) ,                           &
415
 
!                          ---------------- (masse vol. gaz)
416
 
   ia(ifuwi) , ra(ifuwr) ,                                        &
417
 
   ia(iwori) , ra(iworr)  )
418
 
 
419
 
!===============================================================================
420
 
! 4. CALCUL DES PROPRIETES PHYSIQUES DE LA PHASE DISPERSEE
421
 
!                    VALEURS CELLULES
422
 
!                    ----------------
423
 
!    TEMPERATURE
424
 
!===============================================================================
425
 
 
426
 
if ( ippmod(icfuel).ge.0 ) then
427
 
 
428
 
! --- Transport d'H2
429
 
 
430
 
  call futeh2                                                     &
431
 
  !==========
432
 
 ( ncelet , ncel   , nrtuse ,                                     &
433
 
   rtp    , propce , rtuser)
434
 
 
435
 
endif
436
 
 
437
 
 
438
 
!===============================================================================
439
 
! 5. CALCUL DES PROPRIETES PHYSIQUES DU MELANGE
440
 
!                    VALEURS CELLULES
441
 
!                    ----------------
442
 
!    MASSE VOLUMIQUE
443
 
!===============================================================================
444
 
 
445
 
! --- W2 = - Somme des X2(i)
446
 
 
447
 
do iel = 1, ncel
448
 
  w2(iel) = zero
449
 
enddo
450
 
 
451
 
do icla = 1, nclafu
452
 
  do iel = 1, ncel
453
 
    w2(iel) =  w2(iel)-rtp(iel,isca(iyfol(icla)))
454
 
  enddo
455
 
enddo
456
 
 
457
 
! --- Calcul de Rho du melange : 1/Rho = X1/Rho1 + Somme(X2/Rho2)
458
 
!     On sous relaxe quand on a un rho n a disposition, ie
459
 
!       a partir du deuxieme passage ou
460
 
!       a partir du premier passage si on est en suite de calcul et
461
 
!         qu'on a relu la masse volumique dans le fichier suite.
462
 
 
463
 
iphas = 1
464
 
ipcrom = ipproc(irom(iphas))
465
 
 
466
 
if (ipass.gt.1.or.(isuite.eq.1.and.initro(iphas).eq.1)) then
467
 
  srrom1 = srrom
468
 
else
469
 
  srrom1 = 0.d0
470
 
endif
471
 
 
472
 
do iel = 1, ncel
473
 
 
474
 
  x1sro1 = (1.d0+w2(iel)) / propce(iel,iromf)
475
 
  x2sro2 = zero
476
 
  do icla = 1, nclafu
477
 
 
478
 
    ipcro2 = ipproc(irom3(icla))
479
 
    propce(iel,ipcro2) = rho0fl
480
 
 
481
 
    x2sro2 = x2sro2 + rtp(iel,isca(iyfol(icla)))                  &
482
 
                     /propce(iel,ipcro2)
483
 
 
484
 
  enddo
485
 
 
486
 
! ---- Sous relaxation eventuelle a donner dans ppini1.F
487
 
 
488
 
  propce(iel,ipcrom) = srrom1*propce(iel,ipcrom)                  &
489
 
                     + (1.d0-srrom1)/(x1sro1+x2sro2)
490
 
 enddo
491
 
 
492
 
!===============================================================================
493
 
! 6. CALCUL DE RHO DU MELANGE
494
 
 
495
 
!                      VALEURS FACETTES
496
 
!                      ----------------
497
 
!===============================================================================
498
 
 
499
 
iphas = 1
500
 
ibrom(iphas) = 1
501
 
ipbrom = ipprob(irom(iphas))
502
 
ipcrom = ipproc(irom(iphas))
503
 
 
504
 
! ---> Masse volumique au bord pour toutes les facettes
505
 
!      Les facettes d'entree seront recalculees.
506
 
 
507
 
do ifac = 1, nfabor
508
 
  iel = ifabor(ifac)
509
 
  propfb(ifac,ipbrom) = propce(iel,ipcrom)
510
 
enddo
511
 
 
512
 
! ---> Masse volumique au bord pour les facettes d'entree UNIQUEMENT
513
 
!     Le test sur IZONE sert pour les reprises de calcul
514
 
 
515
 
if ( ipass.gt.1 .or. isuite.eq.1 ) then
516
 
  do ifac = 1, nfabor
517
 
 
518
 
    izone = izfppp(ifac)
519
 
    if(izone.gt.0) then
520
 
      if ( ientat(izone).eq.1 .or. ientfl(izone).eq.1 ) then
521
 
        qtotz  = qimpfl(izone) + qimpat(izone)
522
 
        x2tot  = qimpfl(izone) / qtotz
523
 
        x2sro2 = x2tot / rho0fl
524
 
        wmolme = (1.d0 + xsi) / (wmole(io2) + xsi * wmole(in2) )
525
 
        unsro1 = (wmolme * rr * timpat(izone)) / p0(iphas)
526
 
        x1sro1 = (1.d0 - x2tot) * unsro1
527
 
        propfb(ifac,ipbrom) = 1.d0 / (x1sro1 + x2sro2)
528
 
      endif
529
 
    endif
530
 
 
531
 
  enddo
532
 
endif
533
 
 
534
 
!----
535
 
! FIN
536
 
!----
537
 
 
538
 
return
539
 
end subroutine