!-------------------------------------------------------------------------------

!     This file is part of the Code_Saturne Kernel, element of the
!     Code_Saturne CFD tool.

!     Copyright (C) 1998-2009 EDF S.A., France

!     contact: saturne-support@edf.fr

!     The Code_Saturne Kernel is free software; you can redistribute it
!     and/or modify it under the terms of the GNU General Public License
!     as published by the Free Software Foundation; either version 2 of
!     the License, or (at your option) any later version.

!     The Code_Saturne Kernel is distributed in the hope that it will be
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!     GNU General Public License for more details.

!     You should have received a copy of the GNU General Public License
!     along with the Code_Saturne Kernel; if not, write to the
!     Free Software Foundation, Inc.,
!     51 Franklin St, Fifth Floor,
!     Boston, MA  02110-1301  USA

!-------------------------------------------------------------------------------

subroutine pptbht &
!================

 ( ncoel  ,                                                       &
   nomcoe , ehcoel , cpcoel , wmolce )

!===============================================================================
! FONCTION :
! --------

!         PHYSIQUES PARTICULIERES

!           CALCUL DE L'ENTHALPIE ET DU CP
!                    A PARTIR DE LA BANDE DE JANAF


! Arguments
!_______________.____._____.________________________________________________.
!    nom        !type!mode !                   role                         !
!_______________!____!_____!________________________________________________!
! ncoel         ! e  ! <-- ! nombre de const. elem.                         !
! nomcoe(ngazem)! a  ! <-- ! nom des constituants elementaires              !
! ehcoel        ! tr !  <- ! enthalpie pour chaque constituant              !
! (ngazem,npot) !    !     !                elementaire                     !
! cpcoel(ngazem)! tr !  <- ! cp pour chaque constituant                     !
! wmolce(ngazem)! tr !  <- ! masse molaire de chaque constituant            !
!_______________!____!_____!________________________________________________!

!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
!            --- tableau de travail
!===============================================================================

implicit none

!===============================================================================
! Common blocks
!===============================================================================

include "paramx.h"
include "cstphy.h"
include "entsor.h"
include "ppppar.h"
include "ppthch.h"
include "coincl.h"
include "cpincl.h"
include "ppincl.h"


!===============================================================================

! Arguments

integer          ncoel

character*12     nomcoe(ngazem)

double precision ehcoel(ngazem,npot) , cpcoel(ngazem)
double precision wmolce (ngazem)

! Local variables

character*40     dummy
character*12     nomesp

integer          ind , iches , indtp , inicff , injcff
integer          ne   , nt  , nc , iok
integer          icoeff(ngazem)

double precision cth  , ctc

double precision tlim(3) , wcoeff(2,7) , coeff(ngazem,2,7)

!===============================================================================


!===============================================================================
! 2. LECTURE DU FICHIER DE DONNEES THERMODYNAMIQUES TABLE DE JANAF
!===============================================================================

! Initialisation


do iches= 1, 12
  NOMESP(ICHES:ICHES)=' '
enddo

do ne = 1 , ngazem
  icoeff(ne) = 0
  do inicff = 1, 2
    do injcff = 1, 7
      coeff(ne,inicff,injcff) = 0.d0
    enddo
  enddo
enddo

do ne = 1 , ncoel
  cpcoel(ne)= 0.d0
  do nt = 1, npo
    ehcoel(ne,nt)= 0.d0
  enddo
enddo

OPEN(UNIT=IMPJNF, FILE='JANAF', STATUS='OLD' , FORM='FORMATTED')

READ (IMPJNF,'(A)') DUMMY

! Lecture des domaines de temperature

read (impjnf,*) (tlim(indtp) , indtp=1,3)

! Boucle de lecture des especes chimiques avec stockage partiel

 5    continue

READ (IMPJNF,'(A12,6X,A6)') NOMESP,DUMMY

IF (NOMESP(1:3).EQ.'END') GOTO 100

read (impjnf,*) (wcoeff(1,injcff), injcff=1,5)
read (impjnf,*) (wcoeff(1,injcff), injcff=6,7),                   &
                (wcoeff(2,injcff), injcff=1,3)
read (impjnf,*) (wcoeff(2,injcff), injcff=4,7)

! On ne stocke les coefficients que si
!  l'espece consideree fait partie de l'exemple

do ne = 1, ncoel
  if ( nomcoe(ne).eq.nomesp ) then
    icoeff(ne) = 1
     do inicff = 1, 2
       do injcff = 1, 7
         coeff(ne,inicff,injcff) = wcoeff(inicff,injcff)
       enddo
     enddo
  endif
enddo

goto 5

 100  continue

! Arret de la lecture si tous les renseignements necessaires ont ete
! enregistres

close(impjnf)

! Test et stop eventuel

iok = 0
do ne = 1, ncoel
  if(icoeff(ne).eq.0) then
    iok = iok + 1
    write(nfecra,1000) nomcoe(ne)
  endif
enddo
if(iok.ne.0) then
  write(nfecra,1100) iok
  call csexit (1)
  !==========
endif

 1000 format(                                                           &
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/,&
'@ @@ ATTENTION : PHYSIQUE PARTICULIERE                       ',/,&
'@    =========                                               ',/,&
'@    L''ESPECE ',A12     ,' EST INCONNUE DANS JANAF          ',/,&
'@                                                            ',/,&
'@                                                            '  )
 1100 format(                                                           &
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/,&
'@ @@ ATTENTION : ARRET A L''ENTREE DES DONNEES               ',/,&
'@    =========                                               ',/,&
'@    PHYSIQUE PARTICULIERE                                   ',/,&
'@                                                            ',/,&
'@    LE FICHIER PARAMETRIQUE FAIT REFERENCE A ',I10           ,/,&
'@       ESPECE(S) INCONNUE(S) DANS JANAF (data/thch).        ',/,&
'@                                                            ',/,&
'@  Le calcul ne sera pas execute.                            ',/,&
'@                                                            ',/,&
'@  Verifier le fichier parametrique.                         ',/,&
'@                                                            ',/,&
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
'@                                                            ',/)


!======================================================================================
! 3. CALCUL DES ENTHALPIES ET DES CP
!======================================================================================

! Constante des gaz parfaits en J/mol/K

do nt = 1,npo

! Determination du jeu de coefficients utilises

  if (th(nt) .gt. tlim(2)) then
    ind = 1
  else
    ind = 2
  endif

  do ne = 1, ncoel
    ehcoel(ne,nt)  = coeff(ne,ind,6) + coeff(ne,ind,1) * th(nt)
    cpcoel(ne)     =                   coeff(ne,ind,1)
    cth = th(nt)
    ctc = 1.d0

! Dans la table de Janaf, les COEFF sont adimensionnels (CP/R,H/R)

    do nc = 2, 5
      cth = cth * th(nt)
      ctc = ctc * th(nt)
      ehcoel(ne,nt) = ehcoel(ne,nt)                               &
                    + coeff(ne,ind,nc) * cth / dble(nc)
      cpcoel(ne) = cpcoel(ne) + coeff(ne,ind,nc) * ctc
    enddo

!      Calcul du CP et du H pour chaque espece

    ehcoel(ne,nt) = ehcoel(ne,nt) * rr / wmolce(ne)
    cpcoel(ne)    = cpcoel(ne)    * rr / wmolce(ne)
  enddo

enddo

return

end subroutine
