c@a
c@versb
C-----------------------------------------------------------------------
C
CVERS                  Code_Saturne version 1.3
C                      ------------------------
C
C     This file is part of the Code_Saturne Kernel, element of the
C     Code_Saturne CFD tool.
C 
C     Copyright (C) 1998-2007 EDF S.A., France
C
C     contact: saturne-support@edf.fr
C 
C     The Code_Saturne Kernel is free software; you can redistribute it
C     and/or modify it under the terms of the GNU General Public License
C     as published by the Free Software Foundation; either version 2 of
C     the License, or (at your option) any later version.
C 
C     The Code_Saturne Kernel is distributed in the hope that it will be
C     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
C     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details.
C 
C     You should have received a copy of the GNU General Public License
C     along with the Code_Saturne Kernel; if not, write to the
C     Free Software Foundation, Inc.,
C     51 Franklin St, Fifth Floor,
C     Boston, MA  02110-1301  USA
C
C-----------------------------------------------------------------------
c@verse
                        SUBROUTINE CPFLUX
C                       *****************
C     -------------------------------------------------------------
     & ( IDBIA0 , IDBRA0 ,
     &   NCELET , NCEL   ,
     &   RTPA   , PROPCE , VOLUME ,
     &   W1     , W2     , W3     ,
     &   RA     )
C     -------------------------------------------------------------
C***********************************************************************
C FONCTION :
C --------
c@foncb
CFONC
CFONC CALCUL DES TERMES DE TRANSFERT DE MASSE ENTRE LA PHASE CONTINUE
CFONC ET LA PHASE DISPERSEE
CFONC
CFONC
c@fonce
C                             ARGUMENTS
c@argub
CARGU .______________.____._____.______________________________________.
CARGU !    NOM       !TYPE!MODE !                   ROLE               !
CARGU !______________!____!_____!______________________________________!
CARGU ! IDBIA0       ! E  !  -> ! NUMERO DE LA 1ERE CASE LIBRE DANS IA !
CARGU ! IDBRA0       ! E  !  -> ! NUMERO DE LA 1ERE CASE LIBRE DANS RA !
CARGU ! NCELET       ! E  !  -> ! NOMBRE D'ELEMENTS HALO COMPRIS       !
CARGU ! NCEL         ! E  !  -> ! NOMBRE D'ELEMENTS ACTIFS             !
CARGU ! RTPA         ! TR !  -> ! VARIABLES DE CALCUL AU CENTRE DES    !
CARGU ! (NCELET,*)   !    !     !    CELLULES (INSTANT PRECEDENT)      !
CARGU ! PROPCE       ! TR ! <-> ! PROPRIETES PHYSIQUES AU CENTRE DES   !
CARGU ! (NCELET,*)   !    !     !    CELLULES                          !
CARGU ! VOLUME       ! TR !  -> ! VOLUME D'UN DES NCELET ELEMENTS      !
CARGU ! (NCELET      !    !     !                                      !
CARGU ! W1, W2, W3   ! TR !  -  ! TABLEAUX DE TRAVAIL                  !
CARGU ! RA(*)        ! TR !  -  ! MACRO TABLEAU REEL                   !
CARGU !______________!____!_____!______________________________________!
c@argue
C
c@commb
CCOMM                             COMMONS
CCOMM .______________.____._____.______________________________________.
CCOMM !    NOM       !TYPE!MODE !                   ROLE               !
CCOMM !______________!____!_____!______________________________________!
CCOMM !______________!____!_____!______________________________________!
c@comme
C
C     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
C            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
C     MODE : -> DONNEE, <- RESULTAT, <-> DONNEE MODIFIEE,
C            - TABLEAU DE TRAVAIL
C***********************************************************************
C
      IMPLICIT NONE
C
C***********************************************************************
C     DONNEES EN COMMON
C***********************************************************************
C
      INCLUDE "paramx.h"
      INCLUDE "numvar.h"
      INCLUDE "optcal.h"
      INCLUDE "cstphy.h"
      INCLUDE "cstnum.h"
      INCLUDE "entsor.h"
      INCLUDE "parall.h"
      INCLUDE "ppppar.h"
      INCLUDE "ppthch.h"
      INCLUDE "coincl.h"
      INCLUDE "cpincl.h"
      INCLUDE "ppincl.h"
C
C***********************************************************************
C
C ARGUMENTS
C
      INTEGER          IDBIA0 , IDBRA0
      INTEGER          NCELET , NCEL
C
      DOUBLE PRECISION RTPA(NCELET,*), PROPCE(NCELET,*)
      DOUBLE PRECISION W1(NCELET), W2(NCELET), W3(NCELET)
      DOUBLE PRECISION VOLUME(NCELET)
      DOUBLE PRECISION RA(*)
C
C VARIABLES LOCALES
C
      INTEGER          IDEBIA , IDEBRA
      INTEGER          IEL    , IPHAS  , ICHA   , ICLA
      INTEGER          IPCROM , IPCTE1 , IPCTEM , IPCRO2 , IPCDIA
      INTEGER          IPCGD1 , IPCGD2 , IPCGCH , IPCGHT , IPCYOX
C
      DOUBLE PRECISION X2     , XCH    , XCK    , XASH   , XNP , XUASH
      DOUBLE PRECISION PPARO2 , XDFCHI , XDFEXT , XDFTOT0 , XDFTOT1
      DOUBLE PRECISION DEVTO1(NCHARM)  , DEVTO2(NCHARM) , COXCK ,  DEN
      DOUBLE PRECISION DIACKA
C
C***********************************************************************
C=======================================================================
C 1. INITIALISATIONS ET CALCULS PRELIMINAIRES
C=======================================================================
C
C --- Initialisation memoire
C
      IDEBIA = IDBIA0
      IDEBRA = IDBRA0
C
C --- Initialisation des termes de transfert de masse
C
      DO ICLA = 1, NCLACP
        IPCGD1 = IPPROC(IGMDV1(ICLA))
        IPCGD2 = IPPROC(IGMDV2(ICLA))
        IPCGCH = IPPROC(IGMDCH(ICLA))
        IPCGHT = IPPROC(IGMHET(ICLA))
        DO IEL = 1, NCEL
          PROPCE(IEL,IPCGD1) = ZERO
          PROPCE(IEL,IPCGD2) = ZERO
          PROPCE(IEL,IPCGCH) = ZERO
          PROPCE(IEL,IPCGHT) = ZERO
        ENDDO
      ENDDO
C
C --- Initialisation des tableaux de travail
C
      DO IEL = 1, NCEL
        W1(IEL) = ZERO
        W2(IEL) = ZERO
        W3(IEL) = ZERO
      ENDDO
C
C --- Calcul de la masse volumique du melange gazeux
C
      IPHAS  = 1
      IPCROM = IPPROC(IROM(IPHAS))
C
C ---- W1 = Somme (X2i)
C      W2 = Somme (X2i/Rho2i)
C
      DO ICLA = 1, NCLACP
        IPCRO2 = IPPROC(IROM2(ICLA))
        DO IEL = 1, NCEL
          XCK  = RTPA(IEL,ISCA(IXCK(ICLA)))
          XCH  = RTPA(IEL,ISCA(IXCH(ICLA)))
          XASH = RTPA(IEL,ISCA(INP (ICLA)))*XMASH(ICLA)
          X2   = XCH + XCK + XASH
          W1(IEL) = W1(IEL) + X2
          W2(IEL) = W2(IEL) + X2 / PROPCE(IEL,IPCRO2)
        ENDDO
      ENDDO
C
C ---- W3 : Rho 1
C
      DO IEL = 1, NCEL
        W3(IEL) = (1.D0-W1(IEL)) / (1.D0/PROPCE(IEL,IPCROM)-W2(IEL))
      ENDDO
C
C
C
C=======================================================================
C 2. TRANSFERTS DE MASSE PAR DEVOLATILISATION
C=======================================================================
C
      IPCTE1 = IPPROC(ITEMP1)
C
      DO ICLA = 1, NCLACP
C
        IPCGD1 = IPPROC(IGMDV1(ICLA))
        IPCGD2 = IPPROC(IGMDV2(ICLA))
        IPCGCH = IPPROC(IGMDCH(ICLA))
        IPCTEM = IPCTE1
        IF ( IPPMOD(ICP3PL).EQ.1 .OR. IPPMOD(ICP3PV).EQ.1 ) THEN
          IPCTEM = IPPROC(ITEMP2(ICLA))
        ENDIF
C
        DO IEL = 1, NCEL
C
C --- Transfert de masse du au degagemnt des MV legeres (s-1) < 0
C
          PROPCE(IEL,IPCGD1) = -Y1CH(ICHCOR(ICLA))*A1CH(ICHCOR(ICLA))
     &      * EXP(-E1CH(ICHCOR(ICLA))/(RR*PROPCE(IEL,IPCTEM)))
C
C --- Transfert de masse du au degagemnt des MV lourdes (s-1) < 0
C
          PROPCE(IEL,IPCGD2) = -Y2CH(ICHCOR(ICLA))*A2CH(ICHCOR(ICLA))
     &      * EXP(-E2CH(ICHCOR(ICLA))/(RR*PROPCE(IEL,IPCTEM)))
C
C --- Taux de disparition du charbon reactif (s-1) < 0
C
          PROPCE(IEL,IPCGCH) = - A1CH(ICHCOR(ICLA))
     &      * EXP(-E1CH(ICHCOR(ICLA))/(RR*PROPCE(IEL,IPCTEM)))
     &                         - A2CH(ICHCOR(ICLA))
     &      * EXP(-E2CH(ICHCOR(ICLA))/(RR*PROPCE(IEL,IPCTEM)))
C
        ENDDO
C
      ENDDO
C
C
C=======================================================================
C 3. CALCUL DE RHO_COKE MOYEN POUR CHAQUE CHARBON
C    On suppose pour le calcul de la masse volumique du coke que
C    la devolatilisation a lieu a volume constant
C=======================================================================
C
C --- Initialisation
C
      DO ICHA = 1, NCHARB
        DEVTO1(ICHA) = ZERO
        DEVTO2(ICHA) = ZERO
        RHOCK(ICHA)  = RHO0CH(ICHA)
      ENDDO
C
C --- Calcul de l'integrale de GMDEV1 et GMDEV2 pour chaque charbon
C
      IPHAS = 1
      IPCROM = IPPROC(IROM(IPHAS))
      DO ICLA = 1, NCLACP
        IPCGD1 = IPPROC(IGMDV1(ICLA))
        IPCGD2 = IPPROC(IGMDV2(ICLA))
        DO IEL = 1, NCEL
          XCH = RTPA(IEL,ISCA(IXCH(ICLA)))
          DEVTO1(ICHCOR(ICLA)) = DEVTO1(ICHCOR(ICLA)) -
     &      ( PROPCE(IEL,IPCGD1)*XCH*PROPCE(IEL,IPCROM)
     &        *VOLUME(IEL) )
          DEVTO2(ICHCOR(ICLA)) = DEVTO2(ICHCOR(ICLA)) -
     &      ( PROPCE(IEL,IPCGD2)*XCH*PROPCE(IEL,IPCROM)
     &        *VOLUME(IEL) )
        ENDDO
        IF(IRANGP.GE.0) THEN
          CALL PARSOM(DEVTO1(ICHCOR(ICLA)))
          CALL PARSOM(DEVTO2(ICHCOR(ICLA)))
        ENDIF
      ENDDO
C
C --- Calcul de la masse volumique moyenne du coke
C
      DO ICHA = 1, NCHARB
        DEN = Y2CH(ICHA)*DEVTO1(ICHA)+Y1CH(ICHA)*DEVTO2(ICHA)
        IF ( DEN.GT.EPSICP ) THEN
          RHOCK(ICHA) = RHO0CH(ICHA) * ( 1.D0 -
     &     ( Y1CH(ICHA)*Y2CH(ICHA)*(DEVTO1(ICHA)+DEVTO2(ICHA))/DEN ) )
        ENDIF
      ENDDO
C
C
C=======================================================================
C 4. TRANSFERTS DE MASSE PAR COMBUSTION HETEROGENE
C=======================================================================
C
      IPCYOX = IPPROC(IYM1(IO2))
      IPCTE1 = IPPROC(ITEMP1)
C
      DO ICLA = 1, NCLACP
C
        IPCGHT = IPPROC(IGMHET(ICLA))
        IPCDIA = IPPROC(IDIAM2(ICLA))
        IPCTEM = IPCTE1
        ICHA   = ICHCOR(ICLA)
        IF ( IPPMOD(ICP3PL).EQ.1 .OR. IPPMOD(ICP3PV).EQ.1 ) THEN
          IPCTEM = IPPROC(ITEMP2(ICLA))
        ENDIF
C
        DO IEL = 1, NCEL
C
          XNP   = RTPA(IEL,ISCA(INP(ICLA)))
          XUASH = XNP*(1.D0-XASHCH(ICHA))*XMP0(ICLA)
C
C --- Calcul de la pression partielle en oxygene (atm)
C                                                 ---
C       PO2 = RHO1*RR*T*YO2/MO2
C
          PPARO2 = W3(IEL)*RR*PROPCE(IEL,IPCTE1)
     &           * PROPCE(IEL,IPCYOX)/WMOLE(IO2)
          PPARO2 = PPARO2 / PREFTH
C
C --- Coefficient de cinetique chimique de formation de CO
C       en (kg.m-2.s-1.atm(-n))
C
          XDFCHI = AHETCH(ICHCOR(ICLA))
     &      * EXP(-EHETCH(ICHCOR(ICLA))*4185.D0
     &             / (RR * PROPCE(IEL,IPCTEM)) )
C
C --- Coefficient de diffusion en  (Kg/m2/s/atm) : XDFEXT
C     Coefficient global pour n=0.5 en (kg/m2/s) : XDFTOT0
C     Coefficient global pour n=1   en (Kg/m2/s) : XDFTOT1
C
          DIACKA = PROPCE(IEL,IPCDIA)/DIAM20(ICLA)
          IF ( DIACKA .GT. EPSICP ) THEN
            XDFEXT = 2.53D-7*((PROPCE(IEL,IPCTEM))**0.75D0)
     &              / PROPCE(IEL,IPCDIA)*2.D0
            XDFTOT1 = PPARO2 / ( 1.D0/XDFCHI + 1.D0/XDFEXT )
            XDFTOT0 = -(XDFCHI**2)/(2.D0*XDFEXT)+(PPARO2*XDFCHI**2
     &                + (XDFCHI**4)/(4.D0*XDFEXT**2))**0.5D0
          ELSE
            XDFTOT1 = XDFCHI*PPARO2
            XDFTOT0 = XDFCHI*PPARO2**0.5D0
          ENDIF
C
C Rq AE : Pour l'instant, on se limite a ce test
C         L'introduction d'une correlation de soufflage viendra
C         ulterieurement.
C
C --- Calcul de COXCK tq : Se = COXCK * XCK**(2/3)
C
          COXCK = ZERO
          IF ( XUASH.GT.EPSICP ) THEN
            COXCK = PI*(DIAM20(ICLA)**2)*
     &            (RHO20(ICLA)/(RHOCK(ICHA)*XUASH))**(2.D0/3.D0)
          ENDIF
C
C --- Calcul de PROPCE(IEL,IPCGHT) = - COXCK*XDFTOT0*PPARO2*XNP < 0
C --- ou  PROPCE(IEL,IPCGHT) = - COXCK*XDFTOT1*PPARO2*XNP < 0
C
          IF (IOCHET(ICHA).EQ.1) THEN
            PROPCE(IEL,IPCGHT) = - XDFTOT1*COXCK*XNP
          ELSE
            PROPCE(IEL,IPCGHT) = - XDFTOT0*COXCK*XNP
          ENDIF
C
        ENDDO
C
      ENDDO
C
C
C
C=======================================================================
C FORMATS
C----
C
C
C
C----
C FIN
C----
C
      RETURN
      END
c@z