! 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 abstract monarch_emission_model_ptr object and related functions

!> Used for building sets of emission model drivers
module monarch_emission_model_pointer
! MONARCH always has MPI
#define MONARCH_USE_MPI
#ifdef DO_PARTMC

  use monarch_constants,                    only : mint, mflt, mdbl
  use monarch_emission_model,               only : monarch_emission_model_t
  use monarch_emission_model_MEGAN,         only :                           &
                                        monarch_emission_model_MEGAN_t
  use monarch_emission_model_netcdf_input,  only :                           &
                                        monarch_emission_model_netcdf_input_t

  implicit none
  private

  public :: monarch_emission_model_ptr

  ! Emission model types
  !> MEGAN Biogenic emission model
  integer(kind=mint), parameter :: EMISSION_MODEL_MEGAN  = 1
  !> NetCDF emission input (for HERMES)
  integer(kind=mint), parameter :: EMISSION_MODEL_NETCDF = 2

  !> Pointer for building emission model driver arrays
  type monarch_emission_model_ptr
    !> Pointer to an emission model driver
    class(monarch_emission_model_t), pointer :: val => null( )
  contains
    !> Get a new instance of an emissions model by name attached to this
    !! pointer
    procedure :: new_by_name
    !> Dereference the pointer
    procedure :: dereference
    !> Determine the number of bytes required to pack the given object
    procedure :: pack_size
    !> Pack the given object to the buffer, advancing position
    procedure :: bin_pack
    !> Unpack the given object from the buffer, advancing position
    procedure :: bin_unpack
    !> Finalize the pointer
    final :: ptr_finalize
  end type monarch_emission_model_ptr

contains
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Create a new instance of an emissions model by name and attach it to
  !! this pointer
  subroutine new_by_name( this, model_type_name, phlex_core, model_props,    &
      diag, next_rxn_id )

    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_util,                       only : assert_msg, die_msg
    use pmc_phlex_core,                     only : phlex_core_t
    use pmc_property,                       only : property_t

    !> Pointer to an emission model driver
    class(monarch_emission_model_ptr), intent(inout) :: this
    !> Type name of the emissions model to instantiate
    character(len=*), intent(in) :: model_type_name
    !> Phlex-core
    type(phlex_core_t), target, intent(inout) :: phlex_core
    !> Model properties
    type(property_t), intent(in) :: model_props
    !> Diagnostics object
    type(monarch_diagnostics_t), intent(in) :: diag
    !> Next unique reaction id available to the emissions model
    !! (This value will be incremented by the number of reactions associated
    !!  with the new model driver.)
    integer(kind=mint), intent(inout) :: next_rxn_id

    ! Make sure there is not currently a model attached to this pointer
    call assert_msg( 378078412, .not. associated( this%val ),                &
                     "Trying to load an emission model to non-null pointer" )

    ! create the appropriate emissions model driver
    select case( model_type_name )

      ! MEGAN biogenic emissions model
      case( "MEGAN" )
        this%val =>                                                          &
            monarch_emission_model_MEGAN_t( phlex_core, model_props, diag,   &
                                            next_rxn_id )

      ! Emissions read from netcdf input files
      case( "NETCDF" )
        this%val =>                                                          &
            monarch_emission_model_netcdf_input_t( phlex_core, model_props,  &
                                                   diag, next_rxn_id )

      case default
        call die_msg( 136647857, "Invalid emissions model name '"//          &
                      model_type_name//"'" )

    end select

  end subroutine new_by_name

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

  !> Dereference an emission model pointer
  elemental subroutine dereference( this )

    !> Pointer to an emission model driver
    class(monarch_emission_model_ptr), intent(inout) :: this

    this%val => null( )

  end subroutine dereference

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

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

    use monarch_mpi,                        only : mnrc_mpi_pack_size_integer

    !> Pointer to an emission model driver
    class(monarch_emission_model_ptr), intent(in) :: this
    !> MPI communicator
    integer(kind=mint), intent(in) :: comm

    pack_size = mnrc_mpi_pack_size_integer( 1, comm )                      + &
                this%val%pack_size( comm )

  end function pack_size

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

  !> Pack the given object to the buffer, advancing position
  subroutine bin_pack( this, buffer, pos, comm )
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                        only : mnrc_mpi_pack_integer
    use monarch_util,                       only : assert, die_msg
#endif

    !> Pointer to an emission model driver
    class(monarch_emission_model_ptr), 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(kind=mint) :: prev_position

    prev_position = pos
    select type( emiss_model => this%val )
      type is( monarch_emission_model_MEGAN_t )
        call mnrc_mpi_pack_integer( buffer, pos, EMISSION_MODEL_MEGAN , comm )
      type is( monarch_emission_model_netcdf_input_t )
        call mnrc_mpi_pack_integer( buffer, pos, EMISSION_MODEL_NETCDF, comm )
      class default
        call die_msg( 576985437, "Invalid emission model type" )
    end select
    call this%val%bin_pack( buffer, pos, comm )
    call assert( 461308319, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_pack

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

  !> Unpack the given object from the buffer, advancing position
  subroutine bin_unpack( this, buffer, pos, comm, phlex_core )
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                        only : mnrc_mpi_unpack_integer
    use monarch_util,                       only : assert, die_msg, to_string
#endif
    use pmc_phlex_core,                     only : phlex_core_t

    !> Pointer to an emission model driver
    class(monarch_emission_model_ptr), 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
    !> Phlex-core
    type(phlex_core_t), target, intent(inout) :: phlex_core

#ifdef MONARCH_USE_MPI
    integer(kind=mint) :: prev_position, model_type

    prev_position = pos
    call mnrc_mpi_unpack_integer( buffer, pos, model_type, comm )
    select case( model_type )
      case( EMISSION_MODEL_MEGAN )
        this%val => monarch_emission_model_MEGAN_t( phlex_core )
      case( EMISSION_MODEL_NETCDF )
        this%val => monarch_emission_model_netcdf_input_t( phlex_core )
      case default
        call die_msg( 153416125, "Invalid emission mode type: "//            &
                      to_string( model_type ) )
    end select
    call this%val%bin_unpack( buffer, pos, comm )
    call assert( 771393170, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_unpack

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

  !> Finalize an emission model pointer
  elemental subroutine ptr_finalize( this )

    !> Pointer to an emission model driver
    type(monarch_emission_model_ptr), intent(inout) :: this

    if( associated( this%val ) ) deallocate( this%val )

  end subroutine ptr_finalize

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#endif
end module monarch_emission_model_pointer
