! 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/>.

!> \file
!> The monarch_emission_model_MEGAN_t object and related functions

!> Driver for the MEGAN emissions model
module monarch_emission_model_MEGAN
! MONARCH always has MPI
#define MONARCH_USE_MPI

#ifdef DO_PARTMC

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! Model versions available !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

#define VERSION_2 1

  use monarch_column,                       only : monarch_column_t
  use monarch_constants,                    only : mint, mflt, mdbl
  use monarch_emission_model,               only : monarch_emission_model_t
  use monarch_util,                         only : string_t

  implicit none
  private

  public :: monarch_emission_model_MEGAN_t

  !> Constant data for MEGAN version 2
  type megan_v2_const_data_t
    !> Number of MEGAN species classes
    integer(kind=mint) :: num_classes = 20
    !> Isoprene emission factor [mol km-2 hr-1]
    real(kind=mflt), allocatable :: msebio_isop( :,: )
    !> Plant functional group percentage [0-1] FIXME what group? / 0-1 or 0-100?
    real(kind=mflt), allocatable :: pftp_bt( :,: )
    !> Plant functional group percentage [0-1] FIXME what group? / 0-1 or 0-100?
    real(kind=mflt), allocatable :: pftp_nt( :,: )
    !> Plant functional group percentage [0-1] FIXME what group? / 0-1 or 0-100?
    real(kind=mflt), allocatable :: pftp_sb( :,: )
    !> Plant functional group percentage [0-1] FIXME what group? / 0-1 or 0-100?
    real(kind=mflt), allocatable :: pftp_hb( :,: )
    !> Climatological leaf area index FIXME units?
    real(kind=mflt), allocatable :: mlai( :,:,: )
    !> Climatological surface air temperature [K] (monthly average)
    real(kind=mflt), allocatable :: mtsa( :,: )
    !> Climatological downward radiation [W m-2]
    !! (monthly average of 24-hr radiation)
    real(kind=mflt), allocatable :: mswdown( :,: )
  contains
    !> Allocate memory for constant arrays
    procedure :: alloc => v2_alloc
  end type megan_v2_const_data_t

  !> MEGAN emission model driver
  type, extends (monarch_emission_model_t) :: monarch_emission_model_MEGAN_t
    private
    !> MEGAN version
    integer(kind=mint) :: version
    !> Number of MEGAN species
    integer(kind=mint) :: num_megan_species = 0
    !> MEGAN species names
    type(string_t), allocatable :: megan_species_name( : )
    !> PartMC-phlex emission rxn id
    integer(kind=mint), allocatable :: map_rxn_id( : )
    !> MEGAN species id
    integer(kind=mint), allocatable :: map_species_id( : )
    !> Emission scaling factor. MEGAN species emission rates are multiplied
    !! by this factor before being added to PartMC-phlex emission reactions.
    real(kind=mdbl), allocatable :: map_scale_factor( : )
    !> MEGAN version 2 constant data
    type(megan_v2_const_data_t) :: v2_const_data
    !> Working column object
    type(monarch_column_t), pointer :: column => null( )
    !> Working array for MEGAN class emissions adjustment factor [unitless]
    real(kind=mdbl), allocatable :: class_adj_factor( : )
    !> Working array for MEGAN emissions [ppm s-1]
    real(kind=mdbl), allocatable :: megan_species_emissions( : )
    !> Emission rates [ppm s-1] or [ug m-3 s-1]
    !! Dimensions are ( West<->East idx, South<->North idx,
    !!   PartMC-phlex MEGAN rxn )
    real(kind=mdbl), allocatable :: emission_rate( :,:,: )
    !> Flag indicating the first call to MEGAN
    logical :: first_call = .true.
  contains
    !> Recalculate the emission rates for this model
    procedure :: calc_rates
    !> Get a MEGAN species id by name
    procedure :: megan_species_id
    !> Get the current emission rate for a particular rxn and grid cell
    !! (PRIVATE)
    procedure :: get_rxn_rate
    !> Initialize the model (PRIVATE)
    procedure :: initialize_model
    !> Determine the number of bytes required to pack the given object
    procedure :: pack_size
    !> Packs the given object in the buffer, advancing position
    procedure :: bin_pack
    !> Unpacks the given object from the buffer, advancing position
    procedure :: bin_unpack
    !> Print the emission model data
    procedure :: print => do_print
    !> Create a map between MEGAN species and PartMC-phlex emission rxns
    procedure, private :: create_map
    !> Run the MEGAN version 2 box model
    procedure, private :: run_v2_box_model
    !> Send MEGAN version 2 constant data to compute tasks
    procedure, private :: send_v2_const_data
  end type monarch_emission_model_MEGAN_t

  !> Constructor for the monarch_emission_model_MEGAN_t type
  interface monarch_emission_model_MEGAN_t
    procedure :: constructor
  end interface monarch_emission_model_MEGAN_t

contains

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Constructor for the monarch_emission_model_MEGAN_t type
  function constructor( phlex_core, model_props, diag, next_rxn_id )         &
      result( new_obj )

    use module_data_megan2,           only : v2_species_name => spca_spc,    &
                                             v2_is_isoprene  => is_isoprene, &
                                             v2_imgn_isop    => imgn_isop
    use monarch_diagnostics,          only : monarch_diagnostics_t
    use monarch_util,                 only : assert, assert_msg, die_msg
    use pmc_phlex_core,               only : phlex_core_t
    use pmc_property,                 only : property_t

    !> New MEGAN model driver
    type(monarch_emission_model_MEGAN_t), pointer :: new_obj
    !> Phlex-core
    type(phlex_core_t), target, intent(inout) :: phlex_core
    !> Input model properties
    !! Should only be included in calls from primary processes
    type(property_t), intent(in), optional :: model_props
    !> Diagnostics object attached to the solver internal state with model
    !! dimensions. Should only be included in calls from primary process.
    type(monarch_diagnostics_t), intent(in), optional :: diag
    !> Next reaction id. Will be advanced after reacting the new object
    integer(kind=mint), intent(inout), optional :: next_rxn_id

    integer(kind=mint) :: i_spec
    character(len=:), allocatable :: key, str_val

    ! Allocate space for the new driver
    allocate( new_obj )

    new_obj%phlex_core => phlex_core

    ! Only load data on primary process
    if( .not.present( model_props ) ) return
    call assert( 587613332, present( diag ) )
    call assert( 900387146, present( next_rxn_id ) )

    ! Set the starting reaction id to use for this model
    new_obj%starting_rxn_id = next_rxn_id

    ! Get the requested version of MEGAN to use, and load the number of
    ! MEGAN species and their names
    key ="version"
    call assert_msg( 185936196, model_props%get_string( key, str_val ),      &
                     "Missing version for MEGAN model" )
    select case( str_val )
      case( "2.04" )
        new_obj%version = VERSION_2
        new_obj%num_megan_species = 138
        call assert_msg( 538232698, v2_is_isoprene .eq. 1,                   &
                         "Isoprene must have a MEGAN species index of 1" )
        call assert_msg( 819254708, v2_imgn_isop .eq. 1,                     &
                         "Isoprene must have a MEGAN class index of 1" )
        allocate( new_obj%megan_species_name( new_obj%num_megan_species ) )
        forall( i_spec = 1 : new_obj%num_megan_species )
          new_obj%megan_species_name(i_spec)%string =                        &
              trim( v2_species_name(i_spec) )
        end forall
      case default
        call die_msg( 902344199, "Invalid MEGAN version specified: "//       &
                      str_val )
    end select

    ! Save the starting rxn id
    new_obj%starting_rxn_id = next_rxn_id

    ! Match PartMC-phlex emissions rxn species with their MEGAN index
    call new_obj%create_map( )

    ! Advance the next reaction id by the number emission reactions for this
    ! model
    next_rxn_id = next_rxn_id + new_obj%n_rxns

  end function constructor

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Recalculate the emission rates for this model
  subroutine calc_rates( this, diag )

    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_util,                       only : die_msg

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(inout) :: this
    !> Diagnostics object attached to current internal state
    type(monarch_diagnostics_t), intent(in) ::diag

    integer(kind=mint) :: WE_idx, SN_idx, i_map

    ! Reset the emission rates
    this%emission_rate( :,:,: ) = 0.0

    ! Run the MEGAN model
    select case( this%version )

      ! Version 2
      case( VERSION_2 )

        ! Send constant data to compute processes
        ! TODO move to initialization once halo exchange can be done at that
        !      point. [Right now halo exchange can't be called before
        !      SET_DOMAIN_SPECS( ).]
        if( this%first_call ) then
          call this%send_v2_const_data( diag )
          this%first_call = .false.
        end if

        ! FIXME Determine whether to update values based on timestep?

        ! Calculate the MEGAN species emissions
        call this%run_v2_box_model( diag )

      case default
        call die_msg( 626852480, "Internal error" )
    end select

  end subroutine calc_rates

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Get a MEGAN species id by name. Returns true if the species is found and
  !! false otherwise
  logical function megan_species_id( this, spec_name, id )

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(in) :: this
    !> Species name
    character(len=:), allocatable, intent(in) :: spec_name
    !> MEGAN species id
    integer(kind=mint), intent(out) :: id

    integer(kind=mint) :: i_spec

    megan_species_id = .false.

    do i_spec = 1, this%num_megan_species
      if( spec_name .eq. this%megan_species_name( i_spec )%string ) then
        id = i_spec
        megan_species_id = .true.
        return
      end if
    end do

  end function megan_species_id

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Get the current emission rate for a particular rxn and grid cell
  !! (PRIVATE)
  pure function get_rxn_rate( this, indices, rxn_id ) result( rate )

    use monarch_util,                       only : monarch_point_t

    !> Emission rate [ppm s-1] or [ug m-3 s-1]
    real(kind=mdbl) :: rate
    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(in) :: this
    !> Indices for the grid cell
    type(monarch_point_t), intent(in) :: indices
    !> Internal index for the emission reaction
    !! (1...n_rxns)
    integer(kind=mint) , intent(in)  :: rxn_id

    rate = this%emission_rate( indices%WE_idx( ),                            &
                               indices%SN_idx( ),                            &
                               rxn_id )

  end function get_rxn_rate

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Initialize the model (PRIVATE)
  subroutine initialize_model( this, diag, species_map )

    use monarch_diagnostics,         only : monarch_diagnostics_t
    use monarch_species_map,         only : monarch_species_map_t
    use monarch_util,                only : monarch_dimensions_t, die_msg

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(inout) :: this
    !> Diagnostics object
    type(monarch_diagnostics_t), intent(in) :: diag
    !> PartMC-Phlex <-> MONARCH species map
    type(monarch_species_map_t), target, intent(in) :: species_map

    type(monarch_dimensions_t) :: task_dims, mem_dims, domain_dims

    task_dims   = diag%task_integration_dimensions( )
    mem_dims    = diag%task_memory_dimensions( )
    domain_dims = diag%total_domain_dimensions( )

    ! Initialize the column object
    this%column => monarch_column_t( this%phlex_core, species_map, diag )

    ! Allocate space for the working emissions array
    allocate( this%megan_species_emissions( this%num_megan_species ) )

    ! Allocate space for emission rxn rates
    allocate( this%emission_rate( task_dims%lower%WE_idx( ):                 &
                                  task_dims%upper%WE_idx( ),                 &
                                  task_dims%lower%SN_idx( ):                 &
                                  task_dims%upper%SN_idx( ),                 &
                                  this%n_rxns ) )

    ! Do version-specific initialization
    select case( this%version )
      case( VERSION_2 )

        ! Allocate memory for constant data
        call this%v2_const_data%alloc( diag )

        ! Allocate space for the class adjustment factors
        allocate( this%class_adj_factor( this%v2_const_data%num_classes ) )

      case default
        call die_msg( 158028705, "Internal error" )
    end select

  end subroutine initialize_model

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Determine the number of bytes required to pack the given object
  function pack_size( this, comm )

    use monarch_mpi,                only : mnrc_mpi_pack_size_integer,       &
                                           mnrc_mpi_pack_size_integer_array, &
                                           mnrc_mpi_pack_size_double_array

    !> Number of bytes need to pack the object
    integer(kind=mint) :: pack_size
    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(in) :: this
    !> MPI communicator
    integer(kind=mint), intent(in) :: comm

    pack_size =                                                              &
        mnrc_mpi_pack_size_integer(       this%n_rxns           , comm )   + &
        mnrc_mpi_pack_size_integer(       this%starting_rxn_id  , comm )   + &
        mnrc_mpi_pack_size_integer(       this%version          , comm )   + &
        mnrc_mpi_pack_size_integer(       this%num_megan_species, comm )   + &
        mnrc_mpi_pack_size_integer_array( this%map_rxn_id       , comm )   + &
        mnrc_mpi_pack_size_integer_array( this%map_species_id   , comm )   + &
        mnrc_mpi_pack_size_double_array(  this%map_scale_factor , comm )

  end function pack_size

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Packs the given object in the buffer, advancing position
  subroutine bin_pack( this, buffer, pos, comm )
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                only : mnrc_mpi_pack_integer,            &
                                           mnrc_mpi_pack_integer_array,      &
                                           mnrc_mpi_pack_double_array
    use monarch_util,               only : assert
#endif

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(in) :: this
    !> Memory buffer
    character, intent(inout) :: buffer( : )
    !> Current buffer position
    integer(kind=mint), intent(inout) :: pos
    !> MPI communicator
    integer(kind=mint), intent(in) :: comm

#ifdef MONARCH_USE_MPI
    integer :: prev_position

    prev_position = pos
    call mnrc_mpi_pack_integer(       buffer, pos, this%n_rxns    , comm )
    call mnrc_mpi_pack_integer(       buffer, pos, this%starting_rxn_id      &
                                                                  , comm )
    call mnrc_mpi_pack_integer(       buffer, pos, this%version   , comm )
    call mnrc_mpi_pack_integer(       buffer, pos, this%num_megan_species    &
                                                                  , comm )
    call mnrc_mpi_pack_integer_array( buffer, pos, this%map_rxn_id, comm )
    call mnrc_mpi_pack_integer_array( buffer, pos, this%map_species_id       &
                                                                  , comm )
    call mnrc_mpi_pack_double_array(  buffer, pos, this%map_scale_factor     &
                                                                  , comm )
    call assert( 862706008, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_pack

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Unpacks the given object from the buffer, advancing position
  subroutine bin_unpack( this, buffer, pos, comm )
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                only : mnrc_mpi_unpack_integer,          &
                                           mnrc_mpi_unpack_integer_array,    &
                                           mnrc_mpi_unpack_double_array
    use monarch_util,               only : assert
#endif

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(inout) :: this
    !> Memory buffer
    character, intent(inout) :: buffer( : )
    !> Current buffer position
    integer(kind=mint), intent(inout) :: pos
    !> MPI communicator
    integer(kind=mint), intent(in) :: comm

#ifdef MONARCH_USE_MPI
    integer :: prev_position

    prev_position = pos
    call mnrc_mpi_unpack_integer(       buffer, pos, this%n_rxns    , comm )
    call mnrc_mpi_unpack_integer(       buffer, pos, this%starting_rxn_id    &
                                                                    , comm )
    call mnrc_mpi_unpack_integer(       buffer, pos, this%version   , comm )
    call mnrc_mpi_unpack_integer(       buffer, pos, this%num_megan_species  &
                                                                    , comm )
    call mnrc_mpi_unpack_integer_array( buffer, pos, this%map_rxn_id, comm )
    call mnrc_mpi_unpack_integer_array( buffer, pos, this%map_species_id     &
                                                                    , comm )
    call mnrc_mpi_unpack_double_array(  buffer, pos, this%map_scale_factor   &
                                                                    , comm )
    call assert( 862706008, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_unpack

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Print the emission model data
  subroutine do_print( this, file_unit )

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(in) :: this
    !> File unit to write to
    integer(kind=mint), intent(in) :: file_unit

    integer(kind=mint) :: i_map
    character(len=*), parameter :: fmt_blank_line = "('')"
    character(len=*), parameter :: fmt1 = "(' | ',A15,' | ',A8,' | ',A16,"//  &
                                          "' | ',A14,' |')"
    character(len=*), parameter :: fmt2 = "(' | ',I15,' | ',I8,' | ',A16,"//  &
                                          "' | ',1x,ES13.3,' |')"

    write(file_unit,fmt_blank_line)
    write(file_unit,*) "***************************"
    write(file_unit,*) "** MEGAN Emission Driver **"
    write(file_unit,*) "***************************"
    write(file_unit,fmt_blank_line)
    write(file_unit,*) "Number of MEGAN emission reactions", this%n_rxns
    select case( this%version )
      case( VERSION_2 )
        write(file_unit,*) "MEGAN Version 2.04"
        write(file_unit,*) "Number of MEGAN species:", this%num_megan_species
        write(file_unit,*) "PartMC-phlex <-> MEGAN map"
        if( allocated( this%megan_species_name ) ) then
          write(file_unit,fmt1) "Rxn id", "MEGAN id", "MEGAN species",       &
                                "Scaling factor"
          do i_map = 1, size( this%map_rxn_id )
            write(file_unit,fmt2) this%map_rxn_id( i_map ),                  &
                                  this%map_species_id( i_map ),              &
                                  this%megan_species_name(                   &
                                    this%map_species_id( i_map ) )%string,   &
                                  this%map_scale_factor( i_map )
          end do
        end if
    end select
    write(file_unit,fmt_blank_line)
    write(file_unit,*) "*******************************"
    write(file_unit,*) "** End MEGAN Emission Driver **"
    write(file_unit,*) "*******************************"
    write(file_unit,fmt_blank_line)

  end subroutine do_print

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Create a map between MEGAN species and PartMC-phlex emission reactions
  subroutine create_map( this )

    use monarch_util,                       only : assert, assert_msg
    use pmc_mechanism_data,                 only : mechanism_data_t
    use pmc_property,                       only : property_t
    use pmc_rxn_data,                       only : rxn_data_t
    use pmc_rxn_emission,                   only : rxn_emission_t

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(inout) :: this

    integer(kind=mint) :: i_rxn, i_mgn_rxn, i_spec, n_rxn, n_rxn_spec, i_map
    type(mechanism_data_t), pointer :: mechanism
    class(rxn_data_t), pointer :: rxn
    type(property_t), pointer :: MEGAN_spec_set, MEGAN_spec_prop
    character(len=:), allocatable :: megan_key, scale_key, spec_name
    real(kind=mdbl) :: scale_factor

    ! FIXME This assumes MONARCH only uses one PMC mechanism at a time
    mechanism => this%phlex_core%mechanism( 1 )%val

    ! key names for MEGAN emission reactions
    megan_key = "MEGAN input"
    scale_key = "scaling factor"

    ! Count the number of emission reactions and total species--reaction
    ! contributions
    n_rxn      = 0
    n_rxn_spec = 0
    do i_rxn = 1, mechanism%size( )
      rxn => mechanism%get_rxn( i_rxn )
      select type( rxn_emission => rxn )
        class is( rxn_emission_t )
          if( rxn%property_set%get_property_t( megan_key,                    &
                                               MEGAN_spec_set ) ) then
            n_rxn = n_rxn + 1
            n_rxn_spec = n_rxn_spec + MEGAN_spec_set%size( )
          end if
      end select
    end do

    ! Set the number of reactions updated by this model
    this%n_rxns = n_rxn

    ! Allocate space for the MEGAN map
    allocate( this%map_rxn_id(       n_rxn_spec ) )
    allocate( this%map_species_id(   n_rxn_spec ) )
    allocate( this%map_scale_factor( n_rxn_spec ) )
    this%map_scale_factor( : ) = 1.0

    ! Create the species map
    i_map     = 0
    i_mgn_rxn = this%starting_rxn_id - 1
    do i_rxn = 1, mechanism%size( )
      rxn => mechanism%get_rxn( i_rxn )

      ! find emission reactions
      select type( rxn_emission => rxn )
        class is( rxn_emission_t )

          ! check if MEGAN properties are included with this emission rxn
          if( rxn%property_set%get_property_t( megan_key,                    &
                                               MEGAN_spec_set ) ) then
            i_mgn_rxn = i_mgn_rxn + 1

            ! find each MEGAN species specified in the rxn data
            call MEGAN_spec_set%iter_reset( )
            do while( MEGAN_spec_set%get_key( spec_name ) )

              ! Set the unique rxn id
              call rxn_emission%set_rxn_id( i_mgn_rxn )
              call assert_msg( 689716479, len( trim( spec_name ) ) .gt. 0,   &
                               "Missing MEGAN species name in emissions rxn" )
              i_map = i_map + 1

              ! Save the unique rxn id for this MEGAN species <-> rxn pair
              this%map_rxn_id( i_map ) = i_mgn_rxn
              call assert_msg( 624184331,                                    &
                               this%megan_species_id( spec_name,             &
                                   this%map_species_id( i_map ) ),           &
                               "Cannot find MEGAN species "//spec_name )

              ! Get properties included with this species
              call assert_msg( 442154248,                                    &
                     MEGAN_spec_set%get_property_t( val = MEGAN_spec_prop ), &
                     "Malformed MEGAN data in emission rxn for species '"//  &
                     spec_name//"'" )

              ! Check for the optional scaling factor
              if( MEGAN_spec_prop%get_real( scale_key, scale_factor ) ) then
                this%map_scale_factor( i_map ) = scale_factor
              end if

              call MEGAN_spec_set%iter_next( )
            end do
          end if
      end select
    end do

    ! Make sure nothing strange happened
    call assert( 351071580, i_mgn_rxn .eq. this%n_rxns +                     &
                                           this%starting_rxn_id - 1 )
    call assert( 570443963, i_map     .eq. n_rxn_spec  )

  end subroutine create_map

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Run the MEGAN version 2 box model for the process integration domain
  subroutine run_v2_box_model( this, diag )

    use module_bioemi_megan2,      only : gamma_lai, gamma_p, gamma_tisop,   &
                                          gamma_tnisp, gamma_a
    use module_data_megan2
    use monarch_diagnostics,       only : monarch_diagnostics_t
    use monarch_util,              only : monarch_point_t,                   &
                                          monarch_dimensions_t,              &
                                          warn_assert_msg, to_string

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(inout) :: this
    !> Diagnostics object attached to current internal state
    type(monarch_diagnostics_t), intent(in) ::diag

    type(monarch_dimensions_t) :: task_dims
    type(monarch_point_t) :: cell
    integer(kind=mint) :: i_spec, i_class, i_func_grp, i_map, i_rxn
    integer(kind=mint) :: WE_idx, SN_idx
    integer(kind=mint) :: curr_month, curr_year, julian_day
    integer(kind=mint) :: prev_month
    real(kind=mflt) ::  prev_month_days
    real(kind=mdbl) :: emission_factor
    real(kind=mflt) :: UTC_mid_step__hrs

    ! Minimum emission rate [mol km-2 hr-1]
    ! FIXME Find out why this limit exists
    real(kind=mflt), parameter :: lower_cutoff_emission_rate = 0.001

    ! Conversion from [mol km-2 hr-1] to [ppm s-1]
    real(kind=mdbl) :: molkm2hr_to_ppms

    ! Plant functional group emission factors [0...1]
    real(kind=mflt), dimension(n_pft) :: plant_func_grp_emis_factor

    ! Photosynthetic photon flux density [umol m-2 s-1]
    real(kind=mflt) :: photo_flux_density

    ! Average photosynthetic photon flux density [umol m-2 s-1]
    real(kind=mflt) :: avg_photo_flux_density

    ! Emission adjustment factor for leaf area
    real(kind=mflt) :: gam_LHT

    ! Light emission activity factor
    real(kind=mflt) :: gam_PHO

    ! Soil moisture factor
    real(kind=mflt) :: gam_SMT = 1.0

    ! Temperature response factor
    real(kind=mflt) :: gam_TMP

    ! Leaf age correction factor
    real(kind=mflt) :: gam_AGE

    task_dims =  diag%task_integration_dimensions( )
    const_data_ptr : associate( const => this%v2_const_data )

    curr_month        = diag%current_month( )
    curr_year         = diag%current_year( )
    prev_month        = mod( curr_month + 10, 12 ) + 1
    prev_month_days   = diag%days_per_month( curr_year - prev_month / 12,    &
                                             prev_month )
    julian_day        = diag%julian_day( )
    UTC_mid_step__hrs = diag%mid_time_step_UTC__s( ) / 60.0

    ! Initialize the cell indices
    cell = diag%new_point( )

    ! All emissions at the surface
    call cell%set_vertical_idx( 1 )

    ! Loop over all the task columns, calculating emission rates
    do WE_idx = task_dims%lower%WE_idx( ), task_dims%upper%WE_idx( )
      call cell%set_WE_idx( WE_idx )
      do SN_idx = task_dims%lower%SN_idx( ), task_dims%upper%SN_idx( )
        call cell%set_SN_idx( SN_idx )

        ! Update the column state
        ! FIXME This duplicates calculations that are performed in the
        !       PartMC-phlex interface already
        call this%column%update( diag, cell )

        ! The photolysis photon flux density is calculated from the downward
        ! solar radiation at the surface [W m-2] converted to [umol m-2 s-1]
        ! (TODO reference for 4.766 conversion factor) assuming half of the
        ! radiation is in the 400-700 nm band
        photo_flux_density     = 4.766 * 0.5 *                               &
            diag%surface_downward_shortwave_radiation__Wm2( cell )
        avg_photo_flux_density = 4.766 * 0.5 *                               &
            const%mswdown( WE_idx, SN_idx )

        ! Check photolysis photon flux density ranges
        call warn_assert_msg( 141960268,                                     &
            photo_flux_density .ge. 0.0 .or. photo_flux_density .le. 2600.0, &
            "Photolyis photon flux out of range in cell "//                  &
            to_string( WE_idx )//", "//to_string( SN_idx )//": "//           &
            to_string( photo_flux_density ) )
        call warn_assert_msg( 186816030,                                     &
            avg_photo_flux_density .ge. 0.0 .or.                             &
            avg_photo_flux_density .le. 2600.0,                              &
            "Average photolyis photon flux out of range in cell "//          &
            to_string( WE_idx )//", "//to_string( SN_idx )//": "//           &
            to_string( avg_photo_flux_density ) )

        ! Get the leaf area index factor gamma_LHT TODO units?
        call gamma_lai(                               &
            const%mlai( WE_idx, SN_idx, curr_month ), & ! [in] current month leaf index
            gam_LHT                                   & ! [out] leaf area index factor
            )

        ! Get the light emission activity factor gam_PHO TODO units?
        call gamma_p(                                 &
            julian_day,                               & ! [in] Julian day [1...365]
            UTC_mid_step__hrs,                        & ! [in] mid time-step UTC [hrs]
            real( diag%latitude__deg( cell ), kind=mflt ),  & ! [in] latitude [degrees]
            real( diag%longitude__deg( cell ), kind=mflt ), & ! [in] longitude [degrees]
            photo_flux_density,                       & ! [in] Photolysis photon flux
                                                        !      denisty [umol m-2 s-1]
            avg_photo_flux_density,                   & ! [in] monthly average photo flux
                                                        !      density [umol m-2 s-1]
            gam_PHO                                   & ! [out] light emission activity
                                                        !       factor
            )

        ! Calculate emission adjustment factors for each MEGAN class
        do i_class = 1, const%num_classes

          ! Get the temperature response factor gam_TMP TODO units?
          if( i_class .eq. imgn_isop ) then
            call gamma_tisop(                         &
                real( diag%temperature_at_2m__K( cell ), kind=mflt ), & ! [in] temperture at 2 m [K]
                const%mtsa( WE_idx, SN_idx ),         & ! [in] monthly mean temperature [K]
                gam_TMP                               & ! [out] temperature response factor
                )
          else
            call gamma_tnisp(                         &
                i_class,                              & ! [in] species class index
                real( diag%temperature_at_2m__K( cell ), kind=mflt ), & ! [in] temperture at 2 m [K]
                gam_TMP                               & ! [out] temperature response factor
                )
          end if

          ! Get the leaf age correction factor gam_AGE
          call gamma_a(                               &
              i_class,                                & ! [in] species class index
              const%mlai( WE_idx, SN_idx, curr_month ), & ! [in] current month leaf area index
              const%mlai( WE_idx, SN_idx, prev_month ), & ! [in] previous month leaf area index
              prev_month_days,                        & ! [in] days in the previous month
              real( diag%temperature_at_2m__K( cell ), kind=mflt ), & ! [in] temperture at 2 m [K]
              gam_AGE                                 & ! [out] leaf age correction factor
              )

          ! Calcualte the overall adjustment factor for the class [unitless]
          this%class_adj_factor( i_class )          = &
              gam_TMP                               * & ! temperature response factor
              gam_AGE                               * & ! leaf age correction factor
              gam_LHT                               * & ! leaf area index factor
              gam_SMT                               * & ! soil moisture factor
              rho_fct( i_class )                    * & ! plant canopy prod/loss factor
              ( 1.0 + ( gam_PHO - 1.0 )             * & ! light emission activity factor
                        ldf_fct( i_class ) )            ! fraction to apply light emission
                                                        !   activity factor to

        end do

        ! Calculate the emission rate conversion factor
        molkm2hr_to_ppms = 0.02897                  / & ! molec weight of air [kg mol-1]
              ( 3600.0                              * & ! [s hr-1]
                diag%air_density__kgm3( cell )      * & ! air density [kg_air m-3]
                this%column%layer_thickness__m( cell%vertical_idx( ) ) ) ! layer height [m]

        ! Calculate MEGAN species emissions [ppm s-1]
        do i_spec = 1, this%num_megan_species

          ! Get the class index for this species
          i_class = mg20_map( i_spec )

          ! Special treatment for isoprene
          if( i_spec .eq. is_isoprene ) then

            this%megan_species_emissions( i_spec ) =  & ! species emission rate [ppm s-1]
              this%class_adj_factor( i_class )      * & ! class adjustment factor
              const%msebio_isop( WE_idx, SN_idx )   * & ! isoprene emission factor
              molkm2hr_to_ppms                          ! [mol km-2 hr-1] -> [ppm s-1]

          ! non-isoprene species
          else

            ! Update the plant function group emission factors
            ! converting from percent to decimal
            plant_func_grp_emis_factor( k_bt )        = & ! broadleaf tree emiss factor
                0.01 * const%pftp_bt( WE_idx, SN_idx )
            plant_func_grp_emis_factor( k_nt )        = & ! needle leaf tree emiss factor
                0.01 * const%pftp_nt( WE_idx, SN_idx )
            plant_func_grp_emis_factor( k_sb )        = & ! shrub/bush emiss factor
                0.01 * const%pftp_sb( WE_idx, SN_idx )
            plant_func_grp_emis_factor( k_hb )        = & ! herb/crops/grass emiss factor
                0.01 * const%pftp_hb( WE_idx, SN_idx )

            ! Calculate the species emission factor [ug m-2 hr-1]
            emission_factor = 0.0
            do i_func_grp = 1, n_pft
              emission_factor = emission_factor             + &
                  plant_func_grp_emis_factor( i_func_grp )  * & ! Plant function group emission factor
                  EF( i_class, i_func_grp )                 * & ! Class/group emission factor
                  EF_frac( i_spec, i_func_grp )                 ! Species/group emission factor
            end do

            ! Calculate the emission rate for this species [ppm s-1]
            ! ([ug m-2] = [g km-2])
            this%megan_species_emissions( i_spec )    = &
                emission_factor                       * & ! species emiss fact [ug m-2 hr-1]
                this%class_adj_factor( i_class )      / & ! class adj factor [unitless]
                spca_mwt( i_spec )                    * & ! species molec weight [g mol-1]
                molkm2hr_to_ppms                          ! [mol km-2 hr-1] -> [ppm s-1]

          end if

          ! Enforce a lower cutoff of emission rates
          if( this%megan_species_emissions( i_spec ) .lt.                    &
              lower_cutoff_emission_rate * molkm2hr_to_ppms ) then
            this%megan_species_emissions( i_spec ) = 0.0
          end if

        end do

        ! Convert MEGAN species emissions to PartMC-phlex emission rates
        ! [ppm s-1]
        do i_map = 1, size( this%map_rxn_id )
          i_rxn = this%map_rxn_id( i_map ) - this%starting_rxn_id + 1
          this%emission_rate( WE_idx, SN_idx, i_rxn )                      = &
            this%emission_rate( WE_idx, SN_idx, i_rxn )                    + &
            this%megan_species_emissions( this%map_species_id( i_map ) )   * &
            this%map_scale_factor( i_map )
        end do
      end do
    end do

    end associate const_data_ptr

  end subroutine run_v2_box_model

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Allocate memory for MEGAN version 2 constant data
  subroutine v2_alloc( this, diag )

    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_util,                       only : monarch_dimensions_t

    !> MEGAN version 2 constant data
    class(megan_v2_const_data_t), intent(inout) :: this
    !> Diagnostics object
    type(monarch_diagnostics_t), intent(in) :: diag

    type(monarch_dimensions_t) :: memory_dims
    integer(kind=mint) :: ims, ime, jms, jme

    memory_dims = diag%task_memory_dimensions( )

    ims = memory_dims%lower%WE_idx( )
    ime = memory_dims%upper%WE_idx( )
    jms = memory_dims%lower%SN_idx( )
    jme = memory_dims%upper%SN_idx( )

    allocate( this%msebio_isop( ims:ime, jms:jme ) )
    allocate( this%pftp_bt(     ims:ime, jms:jme ) )
    allocate( this%pftp_nt(     ims:ime, jms:jme ) )
    allocate( this%pftp_sb(     ims:ime, jms:jme ) )
    allocate( this%pftp_hb(     ims:ime, jms:jme ) )
    allocate( this%mlai(        ims:ime, jms:jme, 12 ) )
    allocate( this%mtsa(        ims:ime, jms:jme ) )
    allocate( this%mswdown(     ims:ime, jms:jme ) )

  end subroutine v2_alloc

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Send MEGAN version 2 constant data to compute tasks
  subroutine send_v2_const_data( this, diag )

    use module_bioemi_megan2,        only : v2_init => READ_MEGAN_CNST_FIELDS
    use monarch_diagnostics,         only : monarch_diagnostics_t
    use monarch_util,                only : monarch_dimensions_t

    !> Emission model driver
    class(monarch_emission_model_MEGAN_t), intent(inout) :: this
    !> Diagnostics object
    type(monarch_diagnostics_t), intent(in) :: diag

    type(monarch_dimensions_t) :: task_dims, mem_dims, domain_dims

    task_dims   = diag%task_integration_dimensions( )
    mem_dims    = diag%task_memory_dimensions( )
    domain_dims = diag%total_domain_dimensions( )

    ! Read constant data from the input files
    ! TODO Consider replacing with subroutine that takes diag and
    !       megan_v2_const_data as inputs
    call v2_init(                                                            &
            this%v2_const_data%msebio_isop,                                  &
            this%v2_const_data%pftp_bt,                                      &
            this%v2_const_data%pftp_nt,                                      &
            this%v2_const_data%pftp_sb,                                      &
            this%v2_const_data%pftp_hb,                                      &
            this%v2_const_data%mlai,                                         &
            this%v2_const_data%mtsa,                                         &
            this%v2_const_data%mswdown,                                      &
            domain_dims%lower%WE_idx( ),                                     &
            domain_dims%upper%WE_idx( ),                                     &
            domain_dims%lower%SN_idx( ),                                     &
            domain_dims%upper%SN_idx( ),                                     &
            domain_dims%upper%vertical_idx( ),                               &
            mem_dims%lower%WE_idx( ),                                        &
            mem_dims%upper%WE_idx( ),                                        &
            mem_dims%lower%SN_idx( ),                                        &
            mem_dims%upper%SN_idx( ),                                        &
            mem_dims%lower%vertical_idx( ),                                  &
            mem_dims%upper%vertical_idx( ),                                  &
            task_dims%lower%WE_idx( ),                                       &
            task_dims%upper%WE_idx( ),                                       &
            task_dims%lower%SN_idx( ),                                       &
            task_dims%upper%SN_idx( )                                        &
            )

  end subroutine send_v2_const_data

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#endif
end module monarch_emission_model_MEGAN
