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

!> \page module_phlex_chem Chemistry Across Multiple Phases (CAMP)
!!
!! CAMP is a gas- and aerosol-phase chemistry software library.
!! The interface with CAMP is provided by the monarch_pmc_interface::monarch_pmc_interface_t type.
!!
!! Documentation for CAMP can be built from the CAMP source code.
!!
!!  1. Make sure that doxygen is installed:
!!     \code{.sh}
!!       doxygen --version
!!     \endcode
!!
!!  2. Download and navigate to the CAMP documentation folder:
!!     \code{.sh}
!!       cd nmmb-monarch/MODEL/SRC_LIBS/
!!       git clone https://github.com/open-atmos/camp.git
!!       cd camp/doc
!!     \endcode
!!
!!  3. Build the documentation:
!!     \code{.sh}
!!       doxygen Doxyfile
!!     \endcode
!!
!!  4. Open the generated documentation:
!!
!!    - Open the generated html version of the documentation
!!      \code{.sh}
!!        firefox build/html/index.html
!!      \endcode
!!
!!    or
!!
!!    - Build the pdf version of the documentation (requires LaTeX)
!!      \code{.sh}
!!        cd build/latex
!!        make
!!      \endcode

!> config_phlex_chem Configuration of the Phlex-Chem module
!!
!! <STRONG><I>Document me!</STRING></I>
!!

!> Interface for the MONACH model and PartMC-phlex
module monarch_pmc_interface

! MONARCH always has MPI
#define MONARCH_USE_MPI

  use monarch_column,                       only : monarch_column_t
  use monarch_constants,                    only : mint, mflt, mdbl

#ifdef DO_PARTMC
! Include solver statistical analysis
#define DO_SOLVER_STATS
! Print all solver data after a failure
! #define DO_SOLVER_DATA_FAILURE_OUTPUT
! PartMC always has JSON when used in MONARCH
#define PMC_USE_JSON

  use monarch_dry_deposition,               only : monarch_dry_deposition_t
  use monarch_emissions,                    only : monarch_emissions_t
  use monarch_fastJ_interface,              only : monarch_fastJ_interface_t
  use monarch_last_time_step,               only : monarch_last_time_step_t
  use monarch_species_map,                  only : monarch_species_map_t
  use monarch_wet_deposition,               only : monarch_wet_deposition_t
  use pmc_phlex_core,                       only : phlex_core_t
  use pmc_phlex_state,                      only : phlex_state_t
  use pmc_property,                         only : property_t
#ifdef DO_SOLVER_STATS
  use pmc_solver_stats,                     only : solver_stats_t
#endif
#endif

  implicit none
  private

  public :: monarch_pmc_interface_t

  !> PartMC <-> MONARCH interface
  !!
  !! Contains all data required to intialize and run PartMC from MONARCH data
  !! and map state variables between PartMC and MONARCH
  type :: monarch_pmc_interface_t
    private
#ifdef DO_PARTMC
    !> Phlex-chem core
    type(phlex_core_t), pointer :: phlex_core => null( )
    !> PartMC <-> SOLVER_INTERNAL_STATE map
    type(monarch_species_map_t), pointer :: species_map => null( )
    !> PartMC <-> Fast-J interface
    type(monarch_fastJ_interface_t), pointer :: fastJ_interface => null( )
    !> Dry deposition submodule
    type(monarch_dry_deposition_t), pointer :: dry_deposition => null( )
    !> Wet deposition submodule
    type(monarch_wet_deposition_t), pointer :: wet_deposition => null( )
    !> Emissions submodule
    type(monarch_emissions_t), pointer :: emissions => null( )
    !> Values associated with the last time step
    type(monarch_last_time_step_t), pointer :: last_time_step => null( )
    !> Configuration files for interfaces, etc.
    type(property_t), pointer :: config_files => null( )
    !> Interface input data
    type(property_t), pointer :: property_set => null( )
#ifdef DO_SOLVER_STATS
    !> Solver statistics
    type(solver_stats_t), allocatable :: solver_stats( :,:,: )
    !> Initial solver state
    type(phlex_state_t), pointer :: init_phlex_state => null( )
#endif
#endif
    !> Column state
    type(monarch_column_t), pointer :: column => null( )
  contains
    !> Set the boundaries for PartMC species on the TRACERS array
    procedure :: set_tracer_boundaries
    !> Integrate PartMC for the current MONARCH state over a specified time step
    procedure :: integrate
    !> Load output diagnostics
    procedure :: load_output_diagnostics
    !> Print the PartMC-phlex data
    procedure :: print => do_print
    !> Load interface data from a set of input files
    procedure, private :: load
    !> Collect and analyze solver statistics from all processes
    procedure, private :: analyze_solver_stats
    !> Check the flag returned by the solver and output conditions for fails
    procedure, private :: check_solver_flag
    !> Finalize the interface
    final :: finalize
  end type monarch_pmc_interface_t

  !> PartMC <-> MONARCH interface constructor
  interface monarch_pmc_interface_t
    procedure :: constructor
  end interface monarch_pmc_interface_t

contains

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

  !> Create and initialize a new monarch_pmc_interface_t object
  !!
  !! Create a monarch_pmc_interface_t object at the beginning of the model run
  !! for each process. The master process should pass a string containing the
  !! path to the PartMC confirguration file list, the path to the interface
  !! configuration file and the starting and ending indices for chemical
  !! species in the tracer array.
  function constructor( phlex_config_file, interface_config_file, diag,      &
                        state_changer ) result( new_obj )

    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_state_changer,              only : monarch_state_changer_t
    use monarch_util,                       only : assert_msg, string_t,     &
                                                   monarch_dimensions_t
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                        only : mnrc_mpi_bcast_integer,   &
                                                   mnrc_mpi_bcast_packed,    &
                                                   mnrc_mpi_rank
#endif
#ifdef DO_PARTMC
    use pmc_phlex_solver_data,              only : phlex_solver_data_t
#endif

    !> A new MONARCH interface
    type(monarch_pmc_interface_t), pointer :: new_obj
    !> Path to the PartMC-phlex configuration file list
    character(len=:), allocatable, optional :: phlex_config_file
    !> Path to the PartMC-phlex <-> MONARCH interface input file
    character(len=:), allocatable, optional :: interface_config_file
    !> Diagnostics object attached to the solver internal state
    type(monarch_diagnostics_t), intent(in) :: diag
    !> State changer attached to the solver internal state
    type(monarch_state_changer_t), intent(inout) :: state_changer

#ifdef DO_PARTMC
    type(phlex_solver_data_t), pointer :: phlex_solver_data
    character, allocatable :: buffer( : )
    integer(kind=mint) :: pos, pack_size
    integer(kind=mint) :: i_spec
    type(string_t), allocatable :: unique_names( : )
    character(len=:), allocatable :: key, str_val
#ifdef DO_SOLVER_STATS
    type(monarch_dimensions_t) :: task_dims
#endif

#ifdef MONARCH_USE_MPI
    integer :: comm

    comm = diag%mpi_computation_comm( )
#endif

    ! Create a new interface object
    allocate( new_obj )

    ! If PartMC is not being used for chemistry, there is nothing to set up
    if( .not. diag%use_partmc_for_chemistry( ) ) return

    ! If chemistry is not turned on, there is nothing to set up
    if( .not. diag%is_chemistry_on( ) ) return

    ! Check for an available solver
    phlex_solver_data => phlex_solver_data_t( )
    call assert_msg( 332298164, phlex_solver_data%is_solver_available( ),    &
            "No solver available" )
    deallocate( phlex_solver_data )

    ! Initialize the time-invariant model data on each process
#ifdef MONARCH_USE_MPI
    if( mnrc_mpi_rank( comm ) .eq. 0 ) then
#endif

      ! Check for the input arguments
      call assert_msg( 304676624, present( phlex_config_file ),              &
              "Missing PartMC-phlex configuration file list" )
      call assert_msg( 194027509, present( interface_config_file ),          &
              "Missing MartMC-phlex <-> MONARCH interface configuration"//   &
              " file" )

      ! Generate the PartMC-phlex <-> SOLVER_INTERNAL_STATE species map
      new_obj%species_map => diag%new_species_map( )

      ! Load the interface data
      call new_obj%load( interface_config_file )

      ! Initialize the phlex-chem core
      new_obj%phlex_core => phlex_core_t( phlex_config_file )
      call new_obj%phlex_core%initialize( )

      ! Initialize the PartMC-phlex <-> SOLVER_INTERNAL_STATE species map
      call new_obj%species_map%initialize( new_obj%phlex_core )

      ! Make sure there is only one mechanism loaded
      ! TODO Update module interfaces to work with multiple mechanisms
      call assert_msg( 667057611, size( new_obj%phlex_core%mechanism ).eq.1, &
                       "PartMC-phlex <-> MONARCH is only set up to work "//  &
                       "with one chemical mechanism." )

      ! Load a Fast-J interface, if indicated
      key = "FastJ config file"
      if( new_obj%config_files%get_string( key, str_val ) ) then
        new_obj%fastJ_interface =>                                           &
            monarch_fastJ_interface_t( new_obj%phlex_core, diag,             &
                                       state_changer, str_val )
      else
        new_obj%fastJ_interface =>                                           &
            monarch_fastJ_interface_t( new_obj%phlex_core )
      end if

      ! Load a dry deposition module
      key = "dry deposition config file"
      call assert_msg( 720818777,                                            &
                       new_obj%config_files%get_string( key, str_val ),      &
                       "Missing dry deposition configuration file" )
      new_obj%dry_deposition =>                                              &
            monarch_dry_deposition_t( new_obj%phlex_core, diag,              &
                                      state_changer, str_val )

      ! Load a wet deposition module
      key = "wet deposition config file"
      call assert_msg( 208894826,                                            &
                       new_obj%config_files%get_string( key, str_val ),      &
                       "Missing wet deposition configuration file" )
      new_obj%wet_deposition =>                                              &
            monarch_wet_deposition_t( new_obj%phlex_core, diag,              &
                                      state_changer, str_val )

      ! Load an emissions interface, if indicated
      key = "emissions config file"
      if( new_obj%config_files%get_string( key, str_val ) ) then
        new_obj%emissions =>                                                 &
            monarch_emissions_t( new_obj%phlex_core, new_obj%species_map,    &
                                 diag, str_val )
      else
        new_obj%emissions =>                                                 &
            monarch_emissions_t( new_obj%phlex_core, new_obj%species_map )
      end if

#ifdef MONARCH_USE_MPI
      pack_size = new_obj%phlex_core%pack_size(  comm ) + &
              new_obj%species_map%pack_size(     comm ) + &
              new_obj%fastJ_interface%pack_size( comm ) + &
              new_obj%dry_deposition%pack_size(  comm ) + &
              new_obj%wet_deposition%pack_size(  comm ) + &
              new_obj%emissions%pack_size(       comm )
      allocate( buffer( pack_size ) )
      pos = 0
      call new_obj%phlex_core%bin_pack(      buffer, pos, comm )
      call new_obj%species_map%bin_pack(     buffer, pos, comm )
      call new_obj%fastJ_interface%bin_pack( buffer, pos, comm )
      call new_obj%dry_deposition%bin_pack(  buffer, pos, comm )
      call new_obj%wet_deposition%bin_pack(  buffer, pos, comm )
      call new_obj%emissions%bin_pack(       buffer, pos, comm )
    endif

    ! broadcast the buffer size
    call mnrc_mpi_bcast_integer( pack_size, comm )

    if( mnrc_mpi_rank( comm ) .ne. 0 ) then
      ! allocate the buffer to receive data
      allocate( buffer( pack_size ) )
    end if

    ! boradcast the buffer
    call mnrc_mpi_bcast_packed( buffer, comm )

    if( mnrc_mpi_rank( comm ) .ne. 0 ) then
      ! unpack the data
      pos = 0
      new_obj%phlex_core => phlex_core_t( )
      call new_obj%phlex_core%bin_unpack(      buffer, pos, comm )
      new_obj%species_map => diag%new_species_map( )
      call new_obj%species_map%bin_unpack(     buffer, pos, comm )
      new_obj%fastJ_interface =>                                             &
          monarch_fastJ_interface_t( new_obj%phlex_core )
      call new_obj%fastJ_interface%bin_unpack( buffer, pos, comm,            &
                                               state_changer )
      new_obj%dry_deposition  =>                                             &
          monarch_dry_deposition_t( new_obj%phlex_core )
      call new_obj%dry_deposition%bin_unpack(  buffer, pos, comm,            &
                                               state_changer )
      new_obj%wet_deposition  =>                                             &
          monarch_wet_deposition_t( new_obj%phlex_core )
      call new_obj%wet_deposition%bin_unpack(  buffer, pos, comm, diag,      &
                                               state_changer )
      new_obj%emissions => monarch_emissions_t( new_obj%phlex_core,          &
                                                new_obj%species_map )
      call new_obj%emissions%bin_unpack(       buffer, pos, comm, diag )
    end if

    deallocate( buffer )
#endif

    ! Initialize the emissions models
    call new_obj%emissions%initialize( diag )

    ! Initialize the solver on all processs
    call new_obj%phlex_core%solver_initialize( )

    ! Create a column state variable on each process
    new_obj%column => monarch_column_t( new_obj%phlex_core,                  &
                                        new_obj%species_map,                 &
                                        diag )
#ifdef DO_SOLVER_STATS
    ! Set up an array of solver statistics objects for each grid cell on each
    ! process
    task_dims = diag%task_integration_dimensions( )
    allocate( new_obj%solver_stats(                                          &
         task_dims%lower%WE_idx( ) : task_dims%upper%WE_idx( ),              &
         task_dims%lower%SN_idx( ) : task_dims%upper%SN_idx( ),              &
         task_dims%lower%vertical_idx( ) : task_dims%upper%vertical_idx( ) ) )

    ! Get a phlex state to hold the initial solver state during solving
    new_obj%init_phlex_state => new_obj%phlex_core%new_state( )
#endif

#else
    ! Allocate space for a new interface
    allocate( new_obj )

    new_obj%column => monarch_column_t( diag )
#endif

  end function constructor

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

  !> Set the boundaries for PartMC species on the tracers array
  subroutine set_tracer_boundaries( this, diag )

    use monarch_diagnostics,                only : monarch_diagnostics_t
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                        only : mnrc_mpi_bcast_integer,   &
                                                   mnrc_mpi_bcast_packed,    &
                                                   mnrc_mpi_rank
#endif

    !> PartMC-phlex <-> MONARCH interface
    class(monarch_pmc_interface_t), intent(inout) :: this
    !> Diagnostics object attached to the solver internal state
    type(monarch_diagnostics_t), intent(in) :: diag

#ifdef DO_PARTMC
    character, allocatable :: buffer( : )
    integer(kind=mint) :: pos, pack_size

#ifdef MONARCH_USE_MPI
    integer :: comm

    ! Nothing to set if not using PartMC for chemistry
    if( .not. diag%use_partmc_for_chemistry( ) ) return

    ! Nothing to set if chemistry is not turned on
    if( .not. diag%is_chemistry_on( ) ) return

    comm = diag%mpi_computation_comm( )
    if( mnrc_mpi_rank( comm ) .eq. 0 ) then
#endif
      call this%species_map%set_tracer_boundaries(                           &
                                           diag%starting_chem_tracer_id( ),  &
                                           diag%ending_chem_tracer_id( ) )
#ifdef MONARCH_USE_MPI
      pack_size = this%species_map%pack_size( comm )
      allocate( buffer( pack_size ) )
      pos = 0
      call this%species_map%bin_pack( buffer, pos, comm )
    end if

    ! broadcast the buffer size
    call mnrc_mpi_bcast_integer( pack_size, comm )

    if( mnrc_mpi_rank( comm ) .ne. 0 ) then
      ! allocate the buffer to receive data
      allocate( buffer( pack_size ) )
    end if

    ! boradcast the buffer
    call mnrc_mpi_bcast_packed( buffer, comm )

    if( mnrc_mpi_rank( comm ) .ne. 0 ) then
      ! unpack the data
      pos = 0
      if( .not. associated( this%species_map ) ) then
        this%species_map => diag%new_species_map( )
      end if
      call this%species_map%bin_unpack( buffer, pos, comm )
    end if
#endif
#endif
  end subroutine set_tracer_boundaries

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

  !> Integrate the PartMC mechanism for a particular set of cells and timestep
  subroutine integrate( this, diag, state_changer )

    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_state_changer,              only : monarch_state_changer_t
    use monarch_util,                       only : monarch_point_t,          &
                                                   monarch_dimensions_t,     &
                                                   die_msg, assert_msg
#ifdef DO_PARTMC
    use pmc_phlex_state,                    only : phlex_state_t
#endif
    !> PartMC-phlex <-> MONARCH interface
    class(monarch_pmc_interface_t), intent(inout) :: this
    !> Diagnostics object attached to the solver internal state
    type(monarch_diagnostics_t), intent(in) :: diag
    !> State changer attached to the solver internal state
    type(monarch_state_changer_t), intent(inout) :: state_changer

#ifdef DO_PARTMC
    ! counters
    integer :: i_WE, i_SN, i_layer, n_fails
    ! task dimensions
    type(monarch_dimensions_t) :: task_dims
    ! current grid cell indices
    type(monarch_point_t) :: cell
    ! phlex state pointer
    type(phlex_state_t), pointer :: phlex_state
    ! water vapor id on the tracer array
    integer(kind=mint) :: tracer_water_vapor_id
    ! chemistry time step [s]
    real(kind=mdbl) :: chem_time_step

    call assert_msg( 409741852, diag%use_partmc_for_chemistry( ),            &
                     "Trying to use PartMC without it being turned on." )

    call assert_msg( 306435212, diag%is_chemistry_on( ),            &
                     "Unexpectedly trying to solve chemistry." )

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

    ! Set the state changer to use to PartMC<->MONARCH species map
    call state_changer%use_species_map( this%species_map )

    ! Initialize a last-time-step object, if necessary
    if( .not.associated( this%last_time_step ) ) &
      this%last_time_step => monarch_last_time_step_t( diag )

    ! Get the chemistry time step [s]
    chem_time_step = diag%chem_time_step__s( )

    ! Get the dimesions of the grid to solve on this task
    task_dims = diag%task_integration_dimensions( )

    ! Update the emissions for this time step
    call this%emissions%calc_rates( diag )

#ifdef DO_SOLVER_STATS
    ! Reset the failure counter for each process
    n_fails = 0
#endif

    ! Loop through the grid cells
    !( West -> East )
    do i_WE = task_dims%lower%WE_idx( ), task_dims%upper%WE_idx( )
      call cell%set_WE_idx( i_WE )

      !( South -> North )
      do i_SN = task_dims%lower%SN_idx( ), task_dims%upper%SN_idx( )
        call cell%set_SN_idx( i_SN )

        ! Update the column state
        call this%column%update( diag, cell )

        ! Call Fast-J to calculate photolysis rates for the column
        call this%fastJ_interface%calc_rates( this%column, state_changer )

        ! Calculate the wet deposition loss rates, and do vertical mixing
        call this%wet_deposition%calc_rates_and_mix( state_changer,          &
                                                     this%column,            &
                                                     this%last_time_step )

        !( Surface -> Upper layer for chemistry )
        ! TODO For now, just calculate chemistry in the troposphere
        do i_layer = 1, this%column%num_tropospheric_layers
          call cell%set_vertical_idx( i_layer )

          ! Get the grid cell phlex_state
          phlex_state => this%column%get_phlex_state( cell )

          ! Update the photolysis rates
          call this%fastJ_interface%update_rxn_rates( cell )

          ! Update the dry deposition rates
          call this%dry_deposition%update_rxn_rates( state_changer,          &
                  this%column, phlex_state, cell )

          ! Update the wet deposition rates
          call this%wet_deposition%update_rxn_rates( cell )

          ! Update the emission rates
          call this%emissions%update_rxn_rates( cell )

#ifdef DO_SOLVER_STATS
          ! Save the initial state for use in failure analysis
          this%init_phlex_state%state_var( : ) = phlex_state%state_var( : )

          ! Integrate the PMC mechanism
          call this%phlex_core%solve( phlex_state, chem_time_step,           &
                   solver_stats = this%solver_stats( i_WE, i_SN, i_layer ) )

          ! Handle failures - turn on for debugging solver failure conditions
          call this%check_solver_flag( this%column, cell, n_fails )
#else
          ! Integrate the PMC mechanism
          call this%phlex_core%solve( phlex_state, chem_time_step )
#endif

        end do

        ! Copy the solved column states to the SOLVER_INTERNAL_STATE
        call this%column%save_phlex_states( state_changer )

#ifdef DO_SOLVER_STATS
        do i_layer = this%column%num_tropospheric_layers + 1,                &
                     this%column%n_layers
          this%solver_stats( i_WE, i_SN, i_layer ) = 0
        end do
#endif
      end do
    end do

    ! Update the last time step object with the current values for next time
    call this%last_time_step%update( diag )

#ifdef DO_SOLVER_STATS
    ! Collect and analyze the solver statistics from all processes for this
    ! time step
    call this%analyze_solver_stats( diag )
#endif

#else
    call die_msg( 237459841, "PartMC not available" )
#endif

  end subroutine integrate

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

  !> Load output diagnostics
  !! (This should be called on the compute tasks before passing the
  !!  diagnostics writer to the write tasks.)
  subroutine load_output_diagnostics( this, diag_writer, diag, state_changer,&
      aero_rep )

    use monarch_aerosol_representation,     only :                           &
                                            monarch_aerosol_representation_t
    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_diagnostics_writer,         only :                           &
                                            monarch_diagnostics_writer_t
    use monarch_state_changer,              only : monarch_state_changer_t
#ifdef MONARCH_USE_MPI
    use monarch_mpi,                        only : mnrc_mpi_bcast_integer,   &
                                                   mnrc_mpi_bcast_packed,    &
                                                   mnrc_mpi_rank
#endif

    !> PartMC-phlex <-> MONARCH interface
    class(monarch_pmc_interface_t), intent(inout) :: this
    !> Diagnostics writer to load output diagnostics to
    type(monarch_diagnostics_writer_t), intent(inout) :: diag_writer
    !> Diagnsotics object
    type(monarch_diagnostics_t), intent(in) :: diag
    !> State changer
    type(monarch_state_changer_t), intent(inout) :: state_changer
    !> Aerosol representation
    class(monarch_aerosol_representation_t), target, intent(in) :: aero_rep


    ! After JSON support is available, load output diagnostics on the primary
    ! task...
#ifdef DO_PARTMC
    if( diag%use_partmc_for_chemistry( ) .and. diag%is_chemistry_on( ) ) then
      call diag_writer%load( this%phlex_core, this%species_map, diag,        &
                             aero_rep )
    else
#endif
      call diag_writer%load( diag, aero_rep )
#ifdef DO_PARTMC
    endif
#endif

    ! ... and register the state memory on each compute task
    call diag_writer%register( diag, state_changer )

  end subroutine load_output_diagnostics

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

  !> Load the MONARCH <-> PartMC-phlex interface input data
  subroutine load( this, config_file )

    use monarch_util,                       only : assert_msg, die_msg
#ifdef PMC_USE_JSON
    use json_module,                        only : json_core, json_file,     &
                                                   json_value, json_ck
#endif
#ifdef DO_PARTMC
    use pmc_property,                       only : property_t
#endif

    !> PartMC-phlex <-> MONARCH interface
    class(monarch_pmc_interface_t), intent(inout) :: this
    !> Interface configuration file path
    character(len=:), allocatable, intent(in) :: config_file

#ifdef DO_PARTMC
#ifdef PMC_USE_JSON
    type(json_core), pointer :: json
    type(json_file) :: j_file
    type(json_value), pointer :: j_obj, j_next, j_child
    character( kind=json_ck, len=: ), allocatable :: key, unicode_str_val

    character(len=:), allocatable :: str_val
    integer(kind=mint) :: var_type
    logical :: found
    type(property_t), pointer :: species_map_data, init_conc_data

    ! Initialize the property sets
    species_map_data  => property_t( )
    init_conc_data    => property_t( )
    this%config_files => property_t( )
    this%property_set => property_t( )

    ! Make sure there is a species map object to load data to
    call assert_msg( 463810124, associated( this%species_map ),              &
                     "Trying to load PartMC<->MONARCH interface data "//     &
                     "without a monarch_species_map_t object" )

    ! Get a new json core
    allocate( json )

    ! Initialize the json objects
    j_obj  => null( )
    j_next => null( )

    ! Initialize the json file
    call j_file%initialize( )
    call j_file%get_core( json )
    call assert_msg( 207035903, allocated( config_file ),                    &
              "Received non-allocated string for file path" )
    call assert_msg( 368569727, trim( config_file ) .ne. "",                 &
              "Received empty string for file path" )
    inquire( file=config_file, exist=found )
    call assert_msg( 134309013, found, "Cannot find file: "//                &
              config_file )
    call j_file%load_file( filename = config_file )

    ! Find the interface data
    call j_file%get( 'monarch-data( 1 ) ', j_obj )

    ! Load the data to the property_set
    do while( associated( j_obj ) )

      ! Find the object type
      call json%get( j_obj, 'type', unicode_str_val, found )
      call assert_msg( 236838162, found, "Missing type in json input file "//&
              config_file )
      str_val = unicode_str_val

      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !!! Load property sets according to type !!!
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      ! Species Map data
      if( str_val.eq."SPECIES_MAP" ) then
        call json%get_child( j_obj, j_child )
        do while( associated( j_child ) )
          call json%info( j_child, name = key, var_type = var_type )
          if( key .ne. "type" .and. key .ne. "name" ) then
            call species_map_data%load( json, j_child, .false., key,         &
                                             .true. )
          end if
          j_next => j_child
          call json%get_next( j_next, j_child )
        end do

      ! Initial concentration data
      else if( str_val .eq. "INIT_CONC" ) then
        call json%get_child( j_obj, j_child )
        do while( associated( j_child ) )
          call json%info( j_child, name = key, var_type = var_type )
          if( key .ne. "type" .and. key .ne. "name" ) then
            call init_conc_data%load( json, j_child, .false., key )
          end if
          j_next => j_child
          call json%get_next( j_next, j_child )
        end do

      ! Configuration files for interfaces, etc.
      else if( str_val .eq. "CONFIG_FILES" ) then
        call json%get_child( j_obj, j_child )
        do while( associated( j_child ) )
          call json%info( j_child, name = key, var_type = var_type )
          if( key .ne. "type" ) then
            call this%config_files%load( json, j_child, .false., key )
          end if
          j_next => j_child
          call json%get_next( j_next, j_child )
        end do

      ! Data of unknown type
      else
        call this%property_set%load( json, j_obj, .false., key )
      end if

      j_next => j_obj
      call json%get_next( j_next, j_obj )
    end do

    ! Clean up the json objects
    call j_file%destroy( )
    call json%destroy( )
    deallocate( json )

    ! Load the mapping and initial concentration data to the species map
    call this%species_map%load( species_map_data, init_conc_data )

#else
    call die_msg( 635417227, "PartMC-phlex <-> MONARCH interface requires "//&
                  "JSON file support." )
#endif

#else
    call die_msg( 552356704, "PartMC not available" )
#endif

  end subroutine load

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

  !> Collect and analyze solver statistics from all processes for the
  !! current time step
  subroutine analyze_solver_stats( this, diag )

    use monarch_diagnostics,                only : monarch_diagnostics_t
    use monarch_mpi,                        only : mnrc_mpi_rank,            &
                                            mnrc_mpi_allreduce_max_integer,  &
                                            mnrc_mpi_allreduce_sum_integer,  &
                                            mnrc_mpi_reduce_sum_integer,     &
                                            mnrc_mpi_barrier
    use monarch_util,                       only : monarch_dimensions_t,     &
                                            to_string

    !> PartMC-phlex <-> MONARCH interface
    class(monarch_pmc_interface_t), intent(in) :: this
    !> Diagnostics object
    class(monarch_diagnostics_t), intent(in) :: diag

#ifdef DO_PARTMC

    integer(kind=mint) :: file_unit
    integer(kind=mint), parameter :: NUM_STEP_BINS = 20
    integer(kind=mint), parameter :: GRAPH_HEIGHT = 10
    integer(kind=mint) :: i_bin, bin_size, i_stat, i_WE, i_SN, i_layer, i_line
    integer(kind=mint) :: max_steps, global_max_steps, bin_max
    integer(kind=mint) :: num_fail, global_num_fail
    integer(kind=mint), dimension( NUM_STEP_BINS ) :: steps_per_bin,         &
                                                      global_steps_per_bin
    character(len=NUM_STEP_BINS*3), dimension( 0:GRAPH_HEIGHT ) :: step_graph
    integer(kind=mint), dimension( 0:GRAPH_HEIGHT ) :: y_label
    character(len=50) :: fmt_graph, fmt_x_label, fmt_head
    type(monarch_dimensions_t) :: task_dims
    integer :: comm = 0
    real(kind=mflt) :: log_height_inc

#ifdef MONARCH_USE_MPI
    comm = diag%mpi_computation_comm( )
#endif

    ! Get the file unit to output to
    file_unit = diag%log_file_unit( )

    ! Get the dimesions of the grid to solve on this task
    task_dims = diag%task_integration_dimensions( )

    ! Determine the maxiumum number of steps and the total failures on each
    ! process
    max_steps = 0
    num_fail  = 0
    do i_WE = task_dims%lower%WE_idx( ), task_dims%upper%WE_idx( )
      do i_SN = task_dims%lower%SN_idx( ), task_dims%upper%SN_idx( )
        do i_layer = task_dims%lower%vertical_idx( ),                        &
                     task_dims%upper%vertical_idx( )
          max_steps = max( max_steps,                                        &
                          this%solver_stats( i_WE, i_SN, i_layer )%num_steps )
          if( this%solver_stats( i_WE, i_SN, i_layer )%status_code .ne. 0 )  &
              num_fail = num_fail + 1
        end do
      end do
    end do

    ! Get the global max steps and total failures
    call mnrc_mpi_allreduce_max_integer( max_steps, global_max_steps, comm )
    call mnrc_mpi_allreduce_sum_integer( num_fail,  global_num_fail,  comm )

    ! Only analyze when solver actually ran
    if( global_max_steps .eq. 0 ) return

    ! Get the size of each solver-steps bin
    bin_size = ceiling( ( real( global_max_steps ) + 1.0 ) /                 &
                        real( NUM_STEP_BINS ) )

    ! Distribute the solver runs into bins by the number of steps taken
    steps_per_bin( : ) = 0
    do i_WE = task_dims%lower%WE_idx( ), task_dims%upper%WE_idx( )
      do i_SN = task_dims%lower%SN_idx( ), task_dims%upper%SN_idx( )
        do i_layer = task_dims%lower%vertical_idx( ),                        &
                     task_dims%upper%vertical_idx( )
          i_bin = ( this%solver_stats( i_WE, i_SN, i_layer )%num_steps     / &
                    bin_size ) + 1
          steps_per_bin( i_bin ) = steps_per_bin( i_bin ) + 1
        end do
      end do
    end do

    ! Sum the steps per bin from all processes to the root process
    do i_bin = 1, NUM_STEP_BINS
      call mnrc_mpi_reduce_sum_integer( steps_per_bin( i_bin ),              &
                                        global_steps_per_bin( i_bin ),       &
                                        comm )
    end do

    ! Output on the primary task
    if( mnrc_mpi_rank( comm ) .eq. 0 ) then

      ! Get the range of steps per bin
      max_steps = 0
      do i_bin = 1, NUM_STEP_BINS
        max_steps = max( max_steps, global_steps_per_bin( i_bin ) )
      end do

      ! Use a log scale for the y axis
      max_steps = ceiling( log10( real( max_steps, kind=mflt ) ) )
      log_height_inc = real( max_steps, kind=mflt ) /                        &
                       real( GRAPH_HEIGHT, kind=mflt )
      do i_line = 0, GRAPH_HEIGHT
        y_label( i_line ) = 10**( i_line * log_height_inc )
      end do

      ! Fill in the graph
      step_graph(:)(:) = ' '
      do i_bin = 1, NUM_STEP_BINS
        step_graph( 0 )( i_bin*3-2:i_bin*3 ) = '---'
        if( global_steps_per_bin( i_bin ) .eq. 0 ) cycle
        bin_max = global_steps_per_bin( i_bin ) /                            &
                  ( max_steps / GRAPH_HEIGHT + 1 ) + 1
        do i_line = 1, GRAPH_HEIGHT
          if( global_steps_per_bin( i_bin ) .ge.                             &
              10**( ( i_line - 1 ) * log_height_inc ) ) then
            step_graph( i_line )( i_bin*3-2:i_bin*3 ) = ' X '
          end if
        end do
      end do

      ! Output the graph
      write(fmt_graph, '(a,i2,a)') "(' ',i7,' |',a", NUM_STEP_BINS*3, ")"
      write(fmt_x_label, '(a,i2,a)') "(' ',7x,' ',i4,", NUM_STEP_BINS*3-10,  &
                                     "x,i7)"
      write(fmt_head, '(a,i2,a)') "(10x,", NUM_STEP_BINS*3/2-16, "x,a)"

      write(file_unit,fmt_head) "     *** Solver Analysis ***     "
      if( global_num_fail .gt. 0 ) then
        write(file_unit,'()')
        write(file_unit,'(3x,a)') "!!! "//                                   &
                                  trim( to_string( global_num_fail ) )//     &
                                  " solver failures !!!"
        write(file_unit,'()')
      end if
      write(file_unit,fmt_head) "Internal Solver Step Distribution"
      do i_line = GRAPH_HEIGHT, 0, -1
        write(file_unit,fmt_graph) y_label( i_line ), step_graph( i_line )
      end do
      write(file_unit,fmt_x_label) bin_size, global_max_steps
      write(file_unit,fmt_head) "   *** End Solver Analysis ***   "
      write(file_unit,'()')

    end if

    ! Hold the compute processes to prevent overlapping output
    call mnrc_mpi_barrier( comm )

#endif

  end subroutine analyze_solver_stats

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

  !> Check the flag returned by the solver and output conditions for failures
  subroutine check_solver_flag( this, column, cell, n_fails )

    use monarch_util,                       only : monarch_point_t
    use, intrinsic :: iso_fortran_env,      only : stdout => output_unit

    !> PartMC-phlex <-> MONARCH interface
    class(monarch_pmc_interface_t), intent(in) :: this
    !> Column object
    type(monarch_column_t), intent(in) :: column
    !> Grid cell to check flag for
    type(monarch_point_t), intent(in) :: cell
    !> Number of failures on this process at the current timestep
    integer(kind=mint), intent(inout) :: n_fails

#ifdef DO_PARTMC

    integer(kind=mint) :: i_spec
    integer(kind=mint) :: file_unit
    integer(kind=mint), parameter :: MAX_FAILS = 0
    character(len=*), parameter :: fmt_blank_line = "('')"

    ! Do nothing for successful solver runs
    if( this%solver_stats( cell%WE_idx( ), cell%SN_idx( ),                   &
                           cell%vertical_idx( ) )%status_code .eq. 0 ) return

    n_fails = n_fails + 1

    ! Do nothing if the maximum failures on this process have been exceeded
    if( n_fails .gt. MAX_FAILS ) return

    diag_ptr : associate( diag => column%diag )

    ! Get the file unit to write to
    file_unit = stdout

    write(file_unit,fmt_blank_line)
    write(file_unit,*) "*********************************"
    write(file_unit,*) "***   Solver Failure Detail   ***"
    write(file_unit,*) "*********************************"
    write(file_unit,fmt_blank_line)

    write(file_unit,"('Process : ',i4,'; WE_idx: ',i4,' SN_idx: ',i4,"//     &
                    "' vert_idx: ',i4)") diag%mpi_process_id( ),             &
                    cell%WE_idx( ), cell%SN_idx( ), cell%vertical_idx( )
    write(file_unit,"('Lat: ',F12.7,' deg; Lon: ',F12.7,' deg')")            &
                    diag%latitude__deg( cell ), diag%longitude__deg( cell )
    write(file_unit,"('Temperature: ',ES12.5,' K; Pressure: ',ES12.5,' Pa')")&
                    column%temperature__K( cell%vertical_idx( ) ),           &
                    column%mid_layer_pressure__Pa( cell%vertical_idx( ) )
    write(file_unit,"('  * Initial Solver State *')")
    write(file_unit,"(' Species Id | Initial Conc. |')")
    do i_spec = 1, size( this%init_phlex_state%state_var )
      write(file_unit,"(1x,i10,' | ',ES13.6,' |')") i_spec,                  &
                      this%init_phlex_state%state_var( i_spec )
    end do
    write(file_unit,"('  * End Initial Solver State *')")
#ifdef DO_SOLVER_DATA_FAILURE_OUTPUT
    call this%phlex_core%print( file_unit, solver_data_only = .true. )
#endif
    write(file_unit,fmt_blank_line)
    write(file_unit,*) "*********************************"
    write(file_unit,*) "*** End Solver Failure Detail ***"
    write(file_unit,*) "*********************************"

    end associate diag_ptr

#endif

  end subroutine check_solver_flag

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

  !> Print the PartMC-phlex data
  subroutine do_print( this, file_unit )

    !> PartMC-phlex <-> MONARCH interface
    class(monarch_pmc_interface_t), intent(in) :: this
    !> File unit to print to
    integer(kind=mint), intent(in) :: file_unit

    integer(kind=mint) :: i_spec
    character(len=*), parameter :: fmt_blank_line = "('')"

#ifdef DO_PARTMC
    write(file_unit,fmt_blank_line)
    write(file_unit,*) "*******************************"
    write(file_unit,*) "** MONARCH <-> PMC Interface **"
    write(file_unit,*) "*******************************"
    write(file_unit,fmt_blank_line)
    if( associated( this%config_files ) ) then
      write(file_unit,*) "*** Configuration files input data ***"
      call this%config_files%print( file_unit )
      write(file_unit,fmt_blank_line)
    end if
    if( associated( this%property_set ) ) then
      write(file_unit,*) "*** Interface input data ***"
      call this%property_set%print( file_unit )
      write(file_unit,fmt_blank_line)
    end if
    if( associated( this%species_map     ) )                                 &
        call this%species_map%print(     file_unit )
    if( associated( this%fastJ_interface ) )                                 &
        call this%fastJ_interface%print( file_unit )
    if( associated( this%dry_deposition  ) )                                 &
        call this%dry_deposition%print( file_unit )
    if( associated( this%wet_deposition  ) )                                 &
        call this%wet_deposition%print( file_unit )
    if( associated( this%emissions       ) )                                 &
        call this%emissions%print(      file_unit )
    if( associated( this%phlex_core      ) )                                 &
        call this%phlex_core%print(     file_unit )
    write(file_unit,*) "***********************************"
    write(file_unit,*) "** End MONARCH <-> PMC Interface **"
    write(file_unit,*) "***********************************"
    write(file_unit,fmt_blank_line)
#else
    write(file_unit,fmt_blank_line)
    write(file_unit,*) "********************************************"
    write(file_unit,*) "** PartMC Not Available - Empty Interface **"
    write(file_unit,*) "********************************************"
    write(file_unit,fmt_blank_line)
#endif

  end subroutine do_print

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

  !> Finalize the interface
  elemental subroutine finalize( this )

    !> PartMC-phlex <-> MONARCH interface
    type(monarch_pmc_interface_t), intent(inout) :: this

#ifdef DO_PARTMC
    if( associated( this%phlex_core        ) ) &
            deallocate( this%phlex_core      )
    if( associated( this%species_map       ) ) &
            deallocate( this%species_map     )
    if( associated( this%fastJ_interface   ) ) &
            deallocate( this%fastJ_interface )
    if( associated( this%dry_deposition    ) ) &
            deallocate( this%dry_deposition  )
    if( associated( this%wet_deposition    ) ) &
            deallocate( this%wet_deposition  )
    if( associated( this%emissions         ) ) &
            deallocate( this%emissions       )
    if( associated( this%column            ) ) &
            deallocate( this%column          )
    if( associated( this%last_time_step    ) ) &
            deallocate( this%last_time_step  )
    if( associated( this%config_files      ) ) &
            deallocate( this%config_files    )
    if( associated( this%property_set      ) ) &
            deallocate( this%property_set    )
#endif

  end subroutine finalize

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

end module monarch_pmc_interface
