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

!> Use for building and managing sets of output diagnstics
module monarch_output_diagnostics_pointer
! MONARCH always has MPI
#define MONARCH_USE_MPI

  use monarch_constants,              only : mint, mflt, mdbl
  use monarch_output_diagnostics,     only : monarch_output_diagnostics_t
  use monarch_output_diag_aero_optics,only : monarch_output_diag_aero_optics_t
  use monarch_output_diag_debug,      only : monarch_output_diag_debug_t
  use monarch_output_diag_phys,       only : monarch_output_diag_phys_t

  implicit none
  private

  public :: monarch_output_diagnostics_ptr

  ! Output diagnostic types
  !> Aerosol optical properties
  integer(kind=mint), parameter :: DIAG_AERO_OPTICS = 1
  !> Debugging diagnostics
  integer(kind=mint), parameter :: DIAG_DEBUG       = 2
  !> Physical properties
  integer(kind=mint), parameter :: DIAG_PHYS_PROP   = 3

  !> Pointer for building output diagnostics arrays
  type :: monarch_output_diagnostics_ptr
    !> Pointer to an output diagnostic
    class(monarch_output_diagnostics_t), pointer :: val => null( )
  contains
    !> Attach this pointer to a new instance of an output diagnostic
    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_output_diagnostics_ptr

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

  !> Attach this pointer to a new instance of a output diagnostic by name
  subroutine new_by_name( this, output_diag_name, diag, aero_rep )

    use monarch_aerosol_representation,     only :                           &
                                            monarch_aerosol_representation_t
    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_util,                       only : assert_msg, die_msg

    !> Pointer to an output diagnostic
    class(monarch_output_diagnostics_ptr), intent(inout) :: this
    !> Name of the output diagnostic to instantiate
    character(len=*), intent(in) :: output_diag_name
    !> Diagnostics object
    type(monarch_diagnostics_t), intent(in) :: diag
    !> Aerosol representation
    class(monarch_aerosol_representation_t), target, intent(in) :: aero_rep

    ! Make sure this pointer is not already attached
    call assert_msg( 260094659, .not. associated( this%val ),                &
                     "Trying to overwrite an output diagnostic." )

    ! Create an instance of the specified output diagnostic
    select case( output_diag_name )
      case( "aerosol optics" )
        this%val => monarch_output_diag_aero_optics_t( diag, aero_rep )
      case( "debugging" )
        this%val => monarch_output_diag_debug_t( diag, aero_rep )
      case( "physical properties" )
        this%val => monarch_output_diag_phys_t( diag, aero_rep )
      case default
        call die_msg( 874712931, "Unknown output diagnostic: '"//            &
                      output_diag_name//"'" )
    end select

  end subroutine new_by_name

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

  !> Dereference an output diagnostics pointer
  elemental subroutine dereference( this )

    !> Pointer to an output diagnostic
    class(monarch_output_diagnostics_ptr), intent(inout) :: this

    this%val => null( )

  end subroutine dereference

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

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

    use monarch_mpi,                        only : mnrc_mpi_pack_size_integer

    !> Pointer to an output diagnostic
    class(monarch_output_diagnostics_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 on 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 output diagnostic
    class(monarch_output_diagnostics_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( output_diag => this%val )
      type is( monarch_output_diag_aero_optics_t )
        call mnrc_mpi_pack_integer( buffer, pos, DIAG_AERO_OPTICS, comm )
      type is( monarch_output_diag_debug_t )
        call mnrc_mpi_pack_integer( buffer, pos, DIAG_DEBUG, comm )
      type is( monarch_output_diag_phys_t )
        call mnrc_mpi_pack_integer( buffer, pos, DIAG_PHYS_PROP, comm )
      class default
        call die_msg( 249404490, "Invalid type for output diagnostic" )
    end select
    call this%val%bin_pack( buffer, pos, comm )
    call assert( 999726950, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_pack

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

  !> Unpack the given object on the buffer, advancing position
  subroutine bin_unpack( this, buffer, pos, comm, aero_rep )
    use monarch_aerosol_representation,     only :                           &
                                            monarch_aerosol_representation_t
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                        only : mnrc_mpi_unpack_integer
    use monarch_util,                       only : assert, die_msg, to_string
#endif

    !> Pointer to an output diagnostic
    class(monarch_output_diagnostics_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
    !> Aerosol representation
    class(monarch_aerosol_representation_t), target, intent(in) :: aero_rep

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

    prev_position = pos
    call mnrc_mpi_unpack_integer( buffer, pos, diag_type, comm )
    select case( diag_type )
      case( DIAG_AERO_OPTICS )
        this%val => monarch_output_diag_aero_optics_t( )
      case( DIAG_DEBUG )
        this%val => monarch_output_diag_debug_t( )
      case( DIAG_PHYS_PROP )
        this%val => monarch_output_diag_phys_t( )
      case default
        call die_msg( 909879468, "Invalid type for output diagnostic: "//  &
                      to_string( diag_type ) )
    end select
    call this%val%bin_unpack( buffer, pos, comm, aero_rep )
    call assert( 695193529, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_unpack

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

  !> Finalize an output diagnostics pointer
  elemental subroutine ptr_finalize( this )

    !> Pointer to an output diagnostic
    type(monarch_output_diagnostics_ptr), intent(inout) :: this

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

  end subroutine ptr_finalize

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

end module monarch_output_diagnostics_pointer
