
! Copyright (C) 2002 - Observatoire de Paris/Meudon
!                      Universite Paris 7
!                      CNRS (France)
!                      Contact : Jacques.Lebourlot@obspm.fr
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License version 2
! as published by the Free Software Foundation.
!
! This program 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 this program; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

! JLB - 23 May 2008

MODULE PXDR_EXCITHD

  PRIVATE

  PUBLIC :: EQLHDV, COLHD

CONTAINS

!%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE EQLHDV (iopt)
!%%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PXDR_AUXILIAR
   USE PXDR_STR_DATA
   USE PXDR_RF_TOOLS

!  HD detailed balance

   IMPLICIT NONE

   INTEGER, INTENT (IN)                         :: iopt

   REAL (KIND=dp), DIMENSION (:,:), ALLOCATABLE :: fr_des
   INTEGER                                      :: jsp_hd
   INTEGER                                      :: nused, nrxi
   INTEGER                                      :: mm, lev, leva
   REAL (KIND=dp)                               :: toto, fabric, destru
   REAL (KIND=dp)                               :: ratefhd, ratedhd
   REAL (KIND=dp)                               :: taux, dumy
   INTEGER                                      :: k, k1, k2, k3
   INTEGER                                      :: ij, iv, iju, ivu, levu

   jsp_hd = in_sp(i_hd)
   nused = spec_lin(jsp_hd)%use

   IF ( .NOT. ALLOCATED(fr_des)) THEN
      ALLOCATE (fr_des(1:nused,npg))
   ENDIF

   DO mm = 1, npg
      toto = 0.0_dp
      DO lev = 1, nused
         fr_des(lev,mm) = spec_lin(jsp_hd)%gst(lev) * EXP(-spec_lin(jsp_hd)%elk(lev) / tdust(mm,iopt))
         toto = toto + fr_des(lev,mm)
      ENDDO
      fr_des(:,mm) = fr_des(:,mm) / toto
   ENDDO

!  TIMHD useful datas for caracteristic time scales of HD (in s-1 cm-3)
!      TIMHD(iopt,1) : FABRIC : HD formation by gas phase chemistry
!      TIMHD(iopt,2) : DESTRU : HD destruction by gas phase chemistry
!      TIMHD(iopt,3) : RATEGR : HD formation on grains
!      TIMHD(iopt,4) : DESPHO : HD destruction by photons

   create(1:nused) = 0.0_dp
   remove(1:nused) = 0.0_dp

   fabric = 0.0_dp
   destru = 0.0_dp

!  Chemical destruction and formation of HD
!      formation on grains (k=1) and photodissociations are excluded here
!  Warning: adsorption not yet included !

   nrxi = xmatk(i_hd)%nbt

   ratefhd = 0.0_dp   ! Total HD formation on grains
   ratedhd = 0.0_dp   ! Total desorption from grains
   DO k = 1, nrxi
      SELECT CASE (xmatk(i_hd)%fdt(k)%it)
      CASE (7)  ! Photo-dissociation
         ! Matrix evrdhd is added below
      CASE (211) ! Formation on grains
         IF (xmatk(i_hd)%fdt(k)%k > 0.0_dp) THEN
            k1 = xmatk(i_hd)%fdt(k)%r1
            k2 = xmatk(i_hd)%fdt(k)%r2
            ratefhd = ratefhd + xmatk(i_hd)%fdt(k)%k * ab(k1) * ab(k2)
         ENDIF
      CASE (116, 117, 118)  ! Various desorption processes
         k1 = xmatk(i_hd)%fdt(k)%r1
         taux = xmatk(i_hd)%fdt(k)%k
         mm = MOD(k1-nspec,npg)
         IF (mm == 0) THEN
            mm = npg
         ENDIF
         DO lev = 1, nused
            create(lev) = create(lev) + taux * ab(k1) * fr_des(lev,mm)
         ENDDO
         ratedhd = ratedhd + taux * ab(k1)
      CASE DEFAULT
         k1 = xmatk(i_hd)%fdt(k)%r1
         k2 = xmatk(i_hd)%fdt(k)%r2
         k3 = xmatk(i_hd)%fdt(k)%r3
         taux = xmatk(i_hd)%fdt(k)%k
         IF (taux > 0.0_dp) THEN
            fabric = fabric + taux * ab(k1) * ab(k2) * ab(k3)
         ELSE
            destru = destru + taux * ab(k1) * ab(k2) * ab(k3)
         ENDIF
      END SELECT
   ENDDO

!------------------------
!  HD formation on grains
!------------------------

   timhd1(iopt) = fabric + ratedhd
   timhd2(iopt) = - destru
   timhd3(iopt) = ratefhd
   timhd4(iopt) = pdiesp(kdeph0+1,iopt) * ab(i_hd)

   DO lev = 1, nused
      ij = njl_hd(lev)
      iv = nvl_hd(lev)
      dumy = 0.0_dp
      DO levu = nused+1, nlevhd
         iju = njl_hd(levu)
         ivu = nvl_hd(levu)
         dumy = dumy + pophd(ivu,iju) * cashd(levu,lev)
      ENDDO
      create(lev) = create(lev) + (dumy + pophd(iv,ij)) * ratefhd
   ENDDO

!...............................................................................

!  Which repartition upon formation?
!  Equipartition:

!      fabric = fabric / l0hd

!      DO lev = 1, l0hd
!        create(lev) = create(lev) + fabric
!      ENDDO


!  or: all on j = 0

  leva = lev_hd(0,0)
  create(leva) = create(leva) + fabric

! Destruction proportional to population

   remove = remove - destru

END SUBROUTINE EQLHDV

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

!%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COLHD (ttry)
!%%%%%%%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PXDR_AUXILIAR
   USE PXDR_STR_DATA

!---------------------------------------------
!        ttry  : cloud temperature in the slab
!---------------------------------------------

   IMPLICIT NONE

   REAL (KIND=dp), INTENT (IN)                  :: ttry

   REAL (KIND=dp)                               :: deche, dech1, dech2
   REAL (KIND=dp)                               :: tddhe, tddh1, tddh2
   REAL (KIND=dp)                               :: ctod, fac
   REAL (KIND=dp)                               :: chdhe, chdh, chdph2, chdoh2, c, d
   REAL (KIND=dp)                               :: dip, betas, b0, deltaE, taux
   INTEGER                                      :: ju, jl, levu, levl
   INTEGER                                      :: nj, nv
   INTEGER                                      :: jsp_hd

   jsp_hd = in_sp(i_hd)

   ! New fits (Jacques (1999))
   deche = 1.0_dp / 3.0_dp
   tddhe = deche + ttry * 1.0e-3_dp
   dech1 = 2.0_dp / 3.0_dp
   tddh1 = dech1 + ttry * 1.0e-3_dp
   dech2 = 0.5_dp
   tddh2 = dech2 + ttry * 1.0e-3_dp

   DO levu = 2, l0hd
      ju = njl_hd(levu)
      DO levl = 1, levu-1
         jl = njl_hd(levl)
         fac = (spec_lin(jsp_hd)%elk(levu) - spec_lin(jsp_hd)%elk(levl)) / ttry
         ctod = EXP(-fac) * (2.0_dp*ju+1.0_dp) / (2.0_dp*jl+1.0_dp)

         ! Collision HD - He
         chdhe = 10.0_dp**(q_hd_he(1,levu,levl) + q_hd_he(2,levu,levl) / tddhe &
                        + q_hd_he(3,levu,levl) / (tddhe*tddhe))

         ! Collision HD - H
         chdh = 10.0_dp**(q_hd_h(1,levu,levl) + q_hd_h(2,levu,levl) / tddh1 &
                       + q_hd_h(3,levu,levl) / (tddh1*tddh1))

         ! Collision HD - H2 para
         chdph2 = 10.0_dp**(q_hd_ph2(1,levu,levl) + q_hd_ph2(2,levu,levl) / tddh2 &
                       + q_hd_ph2(3,levu,levl) / (tddh2*tddh2))

         ! Collisions HD - H2 ortho
         chdoh2 = 10.0_dp**(q_hd_oh2(1,levu,levl) + q_hd_oh2(2,levu,levl) / tddh2 &
                         + q_hd_oh2(3,levu,levl) / (tddh2*tddh2))

         c = chdhe * ab(i_he) + chdh * ab(i_h) + chdph2 * ab(i_h2) * h2para + chdoh2 * ab(i_h2) * h2orth
         d = c * ctod

         eqcol(levl,levu) = eqcol(levl,levu) - c
         eqcol(levu,levu) = eqcol(levu,levu) + c
         eqcol(levu,levl) = eqcol(levu,levl) - d
         eqcol(levl,levl) = eqcol(levl,levl) + d
      ENDDO
   ENDDO

!  Collisions with electrons -------------------------------------
!  cf Dickinson et al.  A&A 54,645(1977)

   dip = 8.4e-4_dp
   betas = 11600.0_dp / ttry
   b0 = 45.655_dp
   DO levl = 1, l0hd-1
      nj = njl_hd(levl)
      nv = nvl_hd(levl)
      IF (nv == 0) THEN
         levu = lev_hd(nv,nj+1)
         deltaE = 2.48e-04_dp * b0 * (nj+1)
         c = 9.08e3_dp / (b0*(nj+1))
         taux = (3.56e-06_dp * (dip**2) / SQRT(ttry)) * (nj+1) / (2*nj+1)
         taux = taux * EXP(-betas*deltaE)
         taux = taux * LOG(c*deltaE+(c/betas) * EXP(-0.577_dp / (1.0_dp+2.0_dp*betas*deltaE)))
         taux = taux * ab(nspec)
         eqcol(levu,levl) = eqcol(levu,levl) - taux
         eqcol(levl,levl) = eqcol(levl,levl) + taux
         fac = (spec_lin(jsp_hd)%elk(levu) - spec_lin(jsp_hd)%elk(levl)) / ttry
         ctod = EXP(fac) * (2.0_dp*nj+1.0_dp) / (2.0_dp*nj+3.0_dp)
         taux = taux * ctod
         eqcol(levl,levu) = eqcol(levl,levu) - taux
         eqcol(levu,levu) = eqcol(levu,levu) + taux
      ENDIF
   ENDDO

END SUBROUTINE COLHD

END MODULE PXDR_EXCITHD
