! Copyright 2008-2021 Earth Sciences Department, BSC-CNS
!
! This file is part of MONARCH.
!
! MONARCH 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 3 of the License, or
! (at your option) any later version.
!
! MONARCH 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 MONARCH. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
!
      MODULE MODULE_SULFUR_CHEM
!
!-----------------------------------------------------------------------
!
!***  THE OUTER DRIVER FOR THE STAND ALONE SULFUR GAS-AQ PAHSE CHEMICAL MECHANISM.
!
!-----------------------------------------------------------------------
! HISTORY LOG:
!
!   2014-04-17  Jorba - Creation of the module.
!
!-----------------------------------------------------------------------
!
      USE MODULE_KINDS
!
      USE MODULE_DM_PARALLEL, ONLY    : MYPE_SHARE
!
      USE messy_main_constants_mem, ONLY : M_H2O 
!
      USE messy_mecca
!
      USE messy_mecca_aero       , ONLY      : mecca_aero_init_gasaq,mecca_aero_calc_k_ex
!
      USE messy_cmn_gasaq        , ONLY       : cmn_gasaq_initialize
!
!
      USE messy_mecca_kpp_parameters   !, ONLY : NSPEC,NVAR,NFIX,ind_SO2,ind_DMS,ind_O3,ind_OH,ind_HO2,ind_SO4mm_a
!
      USE messy_mecca_kpp_global , ONLY: APN,IHT_MAX,IHS_MAX !, ONLY : C,FIX,TEMP,PRESS,CAIR,JX  & ! c, rconst, temp, press, dt, JX, khet_*,
                                 !       ,xaer,cvfac,lwc,k_exf,k_exb,k_exf_N2O5     & ! nsubsteps, logsteps, substep, method,
                                 !       ,k_exf_ClNO3,k_exf_BrNO3,APN ! rtol, atol, mcexp, .
!
      USE messy_mecca_kpp, ONLY: NKPPCTRL,icntrl,fill_temp,fill_cair,fill_press, fill_khet_tr,fill_khet_st,fill_jx    &
                                ,fill_lwc,fill_cvfac,fill_xaer,fill_k_exf,fill_k_exb,fill_k_exf_n2o5,fill_k_exf_clno3 &
                                ,fill_k_exf_brno3,kpp_integrate
!
      USE messy_mecca_kpp_util,ONLY: initialize_indexarrays
!
      USE MODULE_BSC_CHEM_DATA
!
      USE MODULE_BSC_CONSTANTS_CHEM
!
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      INTEGER :: MYPE
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
      SUBROUTINE RUN_SULFUR(                                            &
                NTIMESTEP,DT,NPHS                                       &
               ,START_HOUR                                              &
               ,AERO_BSC,NUM_AERO_BSC                                   &
               ,NUM_ASH,NUM_DUST,NUM_SALT                               &
               ,NUM_OM,NUM_BC,NUM_SO4                                   &
               ,CHEM,NUM_GAS_TOTAL                                      &
               ,P_PHY,T_PHY,RHO_PHY,WATER,NUM_WATER,P_QV,P_QC,P_QR      &
               ,JPNL                                                    &
               ,IDS,IDE,JDS,JDE,LM                                      &
               ,IMS,IME,JMS,JME,KMS,KME                                 &
               ,ITS,ITE,JTS,JTE)
!***********************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:  DRIVER TO MECCA SULFUR MODEL
!   PRGRMMR: JORBA           ORG: W/NP22     DATE: 14-04-17
!
! ABSTRACT:
!     RUN_SULFUR_CHEM DRIVES THE CHEMISTRY SCHEMES FOR SULFUR CHEMISTRY
!
! PROGRAM HISTORY LOG (with changes to called routines) :
!   14-04-17  JORBA      - ORIGINATOR OF THE DRIVER
!
! USAGE: CALL RUN_SULFUR FROM AERO_BSC_DRIVER
!
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : 1
!$$$
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      INTEGER(KIND=KINT),INTENT(IN) :: IDS,IDE,JDS,JDE,LM                          &
                           ,IMS,IME,JMS,JME,KMS,KME                     &
                           ,ITS,ITE,JTS,JTE                             &
                           ,NPHS,NTIMESTEP,START_HOUR                   &
                           ,NUM_WATER,P_QV,P_QC,P_QR
!
      INTEGER(KIND=KINT),DIMENSION(ITS:ITE,JTS:JTE),INTENT(IN) :: JPNL
!
      REAL(KIND=KFPT),INTENT(IN) :: DT

      REAL(KIND=KFPT),DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_WATER),INTENT(IN) :: WATER

      INTEGER(KIND=KINT),INTENT(IN) :: NUM_GAS_TOTAL

      REAL(KIND=KFPT),DIMENSION(ITS:ITE,JTS:JTE,1:LM,NUM_GAS_TOTAL),INTENT(INOUT) ::  CHEM

      INTEGER(KIND=KINT),INTENT(IN) :: NUM_ASH,NUM_DUST,NUM_SALT,NUM_OM,NUM_BC,NUM_SO4,NUM_AERO_BSC

      REAL(KIND=KFPT),DIMENSION(ITS:ITE,JTS:JTE,1:LM,1:NUM_AERO_BSC),INTENT(INOUT)  :: AERO_BSC

      REAL(KIND=KFPT),DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: P_PHY, T_PHY  ! AIR TEMPERATURE(X,Z,Y) Z=1 bottom Z=LM top (K)

      REAL(KIND=KFPT),DIMENSION(ITS:ITE,1:LM,JTS:JTE),INTENT(IN) :: RHO_PHY ! Density of air(X,Z,Y) Z=1 bottom Z=LM top (kg/m3)
!
!-----------------------------------------------------------------------
!***
!***  LOCAL VARIABLES
!***
!-----------------------------------------------------------------------

!! KPP SP - Single precision kind
!  INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(6,30)
!! KPP DP - Double precision kind
!  INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(14,300)
!! KPP QP - Quadruple precision kind
!  INTEGER, PARAMETER :: qp = SELECTED_REAL_KIND(18,400)

      INTEGER :: status

      INTEGER :: NCHEM,IT,JT,KT,KFLIP,KSE,KSS
      REAL :: TCHEM,TSTART,TEND,DTCHEM,DTSOLVER

! MECCA-KPP VARIABLES

      INTEGER, PARAMETER :: NBL = 1 ! N_block_length

      REAL(kind=dp) :: T
      REAL(kind=dp) :: RSTATE(20)
      INTEGER :: i

      INTEGER, PARAMETER :: IP_MAX = 94

      REAL :: factr

      real(DP), parameter ::  avognumkpp = 6.02252e23       ! number of Avogadro molecules/mole

      real, parameter :: eps=0.622

      real(DP) airdenbox,h2o,h2o_a01,factoraa,factorab

      REAL(DP), PARAMETER :: RHO_H2O=1000. !kg/m3

      REAL(DP), DIMENSION(NBL,NSPEC) :: cbl

  ! PHYS / CHEM
  REAL(DP), DIMENSION(NSPEC) :: cdriver
  REAL(DP) :: cair                ! concentration of air [mcl/cc]
  REAL(DP) :: temp                ! temperature [K]
  REAL(DP) :: press               ! pressure [Pa]
  REAL(DP) :: relhum              ! relative humidity [0-1], > 1 warning, > 1.1 error
  REAL(DP) :: spechum   ! specific humidity [water vapor(kg))/(air mass(kg)]

  REAL(DP) :: timesteplen ! timestep integrator

  REAL(DP) :: jx(IP_MAX) = 0.
  REAL(DP), DIMENSION(APN) :: xaer
  REAL(DP) :: cvfac(APN)
  REAL(DP), DIMENSION(APN) :: lwc
  REAL(DP) :: k_exf(APN,NSPEC)
  REAL(DP) :: k_exb(APN,NSPEC)
  REAL(DP) :: k_exf_N2O5(APN)
  REAL(DP) :: k_exf_ClNO3(APN)
  REAL(DP) :: k_exf_BrNO3(APN)
  REAL(DP) :: dummy_khet_Tr(IHT_MAX) ! dummy, not needed in box model
  REAL(DP) :: dummy_khet_St(IHS_MAX) ! dummy, not needed in box model
  ! (for C, cair, and temp, see caaba_mem.f90)
  ! (see also important notes about temp, press, and cair in gas.eqn!)

  ! sea water composition, relative to total salt:
!  REAL(DP) :: HCO3m_rel, NO3m_rel, Clm_rel, Brm_rel, Im_rel, IO3m_rel, &
!    SO4mm_rel

  REAL(DP), DIMENSION(APN) :: csalt, exchng, radius

  LOGICAL :: l_het(APN) =.TRUE.
!
!-----------------------------------------------------------------------

      MYPE=MYPE_SHARE

      IF(MYPE==0)THEN
        WRITE(0,*) 'RUN_SULFUR AT NTIMESTEP: ',NTIMESTEP
      ENDIF

      KSS=1
      KSE=NUM_GAS_TOTAL

! Initialize Henry and Acomodation parameters
      
      CALL cmn_gasaq_initialize(status)

      CALL mecca_aero_init_gasaq(l_print=.FALSE.)

! DT step integration
!!!DT meteo integration time step in seconds
!!!DTCHEM chemistry integration time step in seconds (DT)
!!!NCHEM*DT time between chemistry execution
!!!NTIMESTEP*DT start time of chemistry integration (TCHEM)

      NCHEM=NPHS
      TCHEM=START_HOUR*3600.0+DT*NTIMESTEP 
      TCHEM=MOD(TCHEM,86400.0)
      DTCHEM=NCHEM*DT
      TSTART=TCHEM
      TEND=TSTART+DTCHEM
      DTSOLVER = DTCHEM
      timesteplen = dble(DTCHEM) !/10.

      IF(MYPE==0)THEN
       WRITE(0,*) 'TIME STEPS:',TSTART, TEND, DTSOLVER,timesteplen
      ENDIF

grid_loop: DO KT = 1,JPNL(ITS,JTS) !LM-2 !JPNL(IT,JT) ! We are moving up from the bottom in the flipped arrays
      DO JT = JTS,JTE !JMS,JME
      DO IT = ITS,ITE !IMS,IME
        KFLIP=LM+1-KT
!
!-----------------------------------------------------------------------
!***  NOTE:  THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP.
!***         THE OLD PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1
!***         AT THE BOTTOM.
!-----------------------------------------------------------------------
!
! ATMOSPHERIC VARIABLES
!   temp = (K)
        temp = T_PHY(IT,KT,JT)
!   press = (Pa)
        press = P_PHY(IT,KT,JT)
!   airdenbox = density of air (mol/cc)
!   cair = concentration of pollutant in cm3 of air (mcl/cc)
!   rho_phy = (kg_air/m3)  airdenbox = (mole_air/cm3)
!   molecular weight of air 28.966 g/mol
    airdenbox = RHO_PHY(IT,KT,JT)/28.966e3 !molecular weight of air 28.966 g/mol
        cair = airdenbox*avognumkpp !molecular weight of air 28.966 g/mol
! WATER VAPOUR mcl/cc
         h2o = (WATER(IT,JT,KFLIP,P_QV)/eps)*airdenbox*avognumkpp
!  lwc liquid water content [m3/m3]
        lwc(1) = MAX((WATER(IT,JT,KFLIP,P_QC))*RHO_PHY(IT,KT,JT)/RHO_H2O,1.e-30)
! Initialize aerosol-droplet characteristics to activate aqueous chemistry
      IF(lwc(1).LE.1e-12)THEN !THERE IS NO CLOUD DROPLET AVAILABLE
        xaer(1)=0.
      ELSE
        xaer(1)=1. 
      ENDIF
!
      radius(1)=1e-5 ![m] assume radius of cloud droplets is constant at 10 microns (0.001 cm)
      l_het(1)=.TRUE.
! cvfac: conversion factor dm^3(aq)/mol => cm^3(air)/molecule
     cvfac(:) = 1.E3 / ( avognumkpp * lwc(:) )

      CALL initialize_indexarrays

      CALL initialize_kpp_variables

!   chem units = (ppm);  czz units = (mole/cm3);  cbox units = (molecules/cm3)
!   factoraa = conversion factor from ppm to molec/cm3 
        factoraa = airdenbox*1.0e-6
        factoraa = factoraa*avognumkpp
!   factorab = conversion factor from kg_sulfate/m3 to molec/cm3
!   PM_sulfate=96.09g/mol
        factorab = 1.0e-3/96.09*avognumkpp
!
!------------------------------------------------------------------------
!
       cdriver(:)=0.
!***REMAPING CHEM ARRAY TO FOLLOW KPP INDEXES:******************
!*** Defined in messy_mecca_kpp_parameters.f90
!
      CDRIVER(ind_H2O) = MAX(h2o,1.0E-30*factoraa)
      CDRIVER(ind_SO2) = MAX(CHEM(IT,JT,KFLIP,P_SO2)*factoraa,1.0E-30*factoraa)
      CDRIVER(ind_DMS) = MAX(CHEM(IT,JT,KFLIP,P_DMS)*factoraa,1.0E-30*factoraa)
      CDRIVER(ind_H2O2)= MAX(CHEM(IT,JT,KFLIP,P_H2O2)*factoraa,1.0E-30*factoraa)
      CDRIVER(ind_O3)  = MAX(CHEM(IT,JT,KFLIP,P_O3)*factoraa,1.0E-30*factoraa)
      CDRIVER(ind_OH)  = MAX(CHEM(IT,JT,KFLIP,P_OH)*factoraa,1.0E-30*factoraa)
      CDRIVER(ind_HO2) = MAX(CHEM(IT,JT,KFLIP,P_HO2)*factoraa,1.0E-30*factoraa)
!new, we assume aerosol fully dissolved into cloud droplets
   CDRIVER(ind_SO4mm_a01)= MAX(AERO_BSC(IT,JT,KFLIP,NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+1)*factorab*epsi_so4(1),1.0E-30*factorab)
!**************************************************************************
!H2O2 PHOTOLYSIS RATE FROM CHEM_DATA COMPUTED IN CHEM_DRIVER-PHOT_DRIVER
        factr=1./60. !convert units from (min-1) to (s-1)
        JX(4) = ph_h2o2(IT,KT,JT) * factr    !JX(4) from messy_cmn_photol_mem
! Calculate the exchange coefficients for aerosols
      CALL mecca_aero_calc_k_ex( &
         radius, temp, press, l_het, xaer, lwc, cdriver, &   ! in
         k_exf, k_exb, k_exf_N2O5, k_exf_ClNO3, k_exf_BrNO3) ! out
! Pass the module variables to kpp
    CALL fill_temp(status, SPREAD(temp,1,NBL))
    CALL fill_cair(status, SPREAD(cair,1,NBL))
    CALL fill_press(status, SPREAD(press,1,NBL))
    ! dummy values:
    dummy_khet_St(:) = 0.
    dummy_khet_Tr(:) = 0.
    CALL fill_khet_Tr(status, SPREAD(dummy_khet_Tr,1,NBL))
    CALL fill_khet_St(status, SPREAD(dummy_khet_St,1,NBL))
    ! transfer of jx in mecca to jx in kpp
    CALL fill_jx(status, SPREAD(jx,1,NBL))
    CALL fill_lwc(status, SPREAD(lwc,1,NBL))
    CALL fill_cvfac(status, SPREAD(cvfac,1,NBL))
    CALL fill_xaer(status, SPREAD(xaer,1,NBL))
    CALL fill_k_exf(status, SPREAD(k_exf,1,NBL))
    CALL fill_k_exb(status, SPREAD(k_exb,1,NBL))
    CALL fill_k_exf_N2O5(status, SPREAD(k_exf_N2O5,1,NBL))
    CALL fill_k_exf_ClNO3(status, SPREAD(k_exf_ClNO3,1,NBL))
    CALL fill_k_exf_BrNO3(status, SPREAD(k_exf_BrNO3,1,NBL))

!~~~> Time loop
      T = TSTART
kron: DO WHILE (T < TEND)

      icntrl(3)=2 !ros3: L-stable method, 3 stages, order 3 (recommended)
!
      cdriver(:) = MAX(cdriver(:),0._DP) ! set negative values to zero
      cbl = SPREAD(cdriver,1,NBL) ! add one dummy dimension
      CALL kpp_integrate(timesteplen,cbl)  ! main kpp call
      cdriver = cbl(1,:)          ! remove the dummy dimension

      T = T + timesteplen !RSTATE(1)
      END DO kron
!~~~> End Time loop

!****REMAPING CHEM ARRAY***********************************
!new, we assume aqueous so2 and h2o2 are returned to the air after cloud processing...
      CHEM(IT,JT,KFLIP,P_SO2) = (CDRIVER(ind_SO2)+CDRIVER(ind_SO2_a01))/factoraa 
      CHEM(IT,JT,KFLIP,P_DMS) = CDRIVER(ind_DMS)/factoraa 
      CHEM(IT,JT,KFLIP,P_H2O2)= (CDRIVER(ind_H2O2)+CDRIVER(ind_H2O2_a01))/factoraa
!new, with upload of aqueous sulfate into the cloud
!we assume full dissolution of aerosol in cloud droplets
      AERO_BSC(IT,JT,KFLIP,NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+1) = AERO_BSC(IT,JT,KFLIP,NUM_ASH+NUM_DUST+NUM_SALT+NUM_OM+NUM_BC+1)*(1.-epsi_so4(1))+  &  
          (CDRIVER(ind_SO4mm_a01)+CDRIVER(ind_H2SO4))/factorab
!*******************************************************************

      ENDDO
      ENDDO
      ENDDO grid_loop

      RETURN
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE RUN_SULFUR       
!
!---------------------------------------------------------------------
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!!---------------------------------------------------------------------
!
      END MODULE MODULE_SULFUR_CHEM
!
!-----------------------------------------------------------------------
