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

!> Functions to modify SOLVER_INTERNAL_STATE instances
module monarch_state_changer
!MONARCH always has MPI
#define MONARCH_USE_MPI

  use module_solver_internal_state,   only : solver_internal_state
  use monarch_aerosol_representation, only : monarch_aerosol_representation_t
  use monarch_constants,              only : mint, mflt, mdbl
  use monarch_util,                   only : string_t
#ifdef DO_PARTMC
  use monarch_species_map,            only : monarch_species_map_t
#endif

  implicit none
  private

  public :: monarch_state_changer_t, monarch_state_array_ptr

  ! Types of state arrays created by solver_state_changer_t
  integer(kind=mint), parameter :: VAR_TYPE_UNKNOWN                   = 0
  integer(kind=mint), parameter :: VAR_TYPE_PER_COLUMN_REAL           = 1
  integer(kind=mint), parameter :: VAR_TYPE_PER_COLUMN_REAL_ARRAY     = 2
  integer(kind=mint), parameter :: VAR_TYPE_PER_CELL_REAL             = 3
  integer(kind=mint), parameter :: VAR_TYPE_PER_CELL_REAL_ARRAY       = 4
  integer(kind=mint), parameter :: VAR_TYPE_PER_VERT_INT_REAL         = 5
  integer(kind=mint), parameter :: VAR_TYPE_PER_VERT_INT_REAL_ARRAY   = 6
  integer(kind=mint), parameter :: VAR_TYPE_TRACERS_LIKE              = 7

  !> Pointer to arrays in the solver internal state
  !!
  !! These pointer are for arrays allocated and maintained by
  !! monarch_state_changer_t
  type monarch_state_array_ptr
    private
    !> Index for the array in the set of solver state arrays
    integer(kind=mint) :: id = 0
    !> Index for the array in the solver state VARS array
    integer(kind=mint) :: vars_id = 0
    !> Flag indicating whether is the array is owned by the state changer
    logical :: is_owned = .true.
    !> Unique name for the array
    type(string_t) :: unique_name
    !> Array type
    integer(kind=mint) :: type_id = VAR_TYPE_UNKNOWN
    !> Number of properties per spatial location stored in the array
    integer(kind=mint) :: num_props = 1
    !> Name of each property
    type(string_t), allocatable :: prop_name( : )
    !> Map of array elements to include (when array is allocated elsewhere)
    integer(kind=mint), allocatable :: prop_map( : )
    !> Flag indicating whether array should be included in the history file
    logical :: to_hist_file = .false.
    !> NetCDF variable id
    integer(kind=mint), allocatable :: netcdf_var_id( : )
    !> NetCDF short name
    type(string_t) :: netcdf_short_name
    !> NetCDF long name
    type(string_t) :: netcdf_long_name
    !> NetCDF units
    type(string_t) :: netcdf_units
    !> NetCDF standard name
    type(string_t) :: netcdf_standard_name
    !> NetCDF missing real value
    real(kind=mflt) :: netcdf_missing_value_real = -999999.0
    !> NetCDF fill real value
    real(kind=mflt), public :: netcdf_fill_value_real = -32767.0
    !> Flag indicating whether to limit NetCDF output arrays to 4 dimensions
    !! maximum
    logical :: is_max_4D_output = .false.
    !> Flag indicating whether this array has been initialized in the netCDF
    !! FIXME Set this to false when a new netCDF file is opened for output
    logical :: is_netcdf_initialized = .false.
    !> Pointer to the next array
    type(monarch_state_array_ptr), pointer :: next_array => null( )
  contains
    !> Update the property map
    procedure :: update_property_map
    !> Output this array to the history file
    procedure :: output_to_netcdf
    !> Reset the array to the NetCDF fill values
    procedure :: reset_array
    !> Set up a NetCDF file to recieve this array
    procedure :: first_output
    !> Set the NetCDF short name
    procedure :: set_netcdf_short_name
    !> Set the NetCDF long name
    procedure :: set_netcdf_long_name
    !> Set the NetCDF standard name
    procedure :: set_netcdf_standard_name
    !> Set the NetCDF units
    procedure :: set_netcdf_units
    !> Set the NetCDF missing value
    generic :: set_netcdf_missing_value => set_netcdf_missing_value_real
    !> Set the NetCDF missing real value
    procedure :: set_netcdf_missing_value_real
    !> Set the NetCDF fill value
    generic :: set_netcdf_fill_value => set_netcdf_fill_value_real
    !> Set the NetCDF fill real value
    procedure :: set_netcdf_fill_value_real
    !> 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
    !> Check the status of a NetCDF operation
    procedure, private :: check_nf90 => check_nf90_state_array
  end type monarch_state_array_ptr

  !> SOLVER_INTERNAL_STATE modifier
  !!
  !! Instances of this type provide functions for updating instances of the
  !! SOLVER_INTERNAL_STATE type
  type monarch_state_changer_t
  private
    !> Instance of the SOLVER_INTERNAL_STATE to update
    type(solver_internal_state), pointer, public :: int_state => null( )
    !> MONARCH aerosol representation
    class(monarch_aerosol_representation_t), pointer :: aero_rep => null( )
    !> Number of vertical layers
    !! TODO Remove once always available from the solver internal state
    integer(kind=mint) :: num_vertical_layers
    !> MONARCH state arrays
    type(monarch_state_array_ptr), pointer :: state_arrays => null( )
#ifdef DO_PARTMC
    type(monarch_species_map_t), pointer :: species_map => null( )
#endif
  contains
    !> Attach to a new SOLVER_INTERNAL_STATE
    procedure :: attach
#ifdef DO_PARTMC
    !> Set the internal species map
    procedure :: use_species_map
#endif

    ! State variable registration
    !> Register a per-column set of properties
    procedure :: register_per_column_real
    !> Register a per-grid-cell set of properties
    procedure :: register_per_cell_real
    !> Register a set of properties for each vertical interface of each cell
    procedure :: register_per_vertical_interface_real
    !> Register an array shaped like the NMMB tracers array
    procedure :: register_tracers_like
    !> Determine whether the MONARCH arrays have been allocated
    procedure :: arrays_allocated
    !> Allocate the MONARCH arrays
    procedure :: allocate_arrays
    !> Initialize gas and aerosol species concentrations
    !! for the domain
    procedure :: initialize_domain_species_conc
    !> Update the MONARCH array pointers that are allocated elsewhere
    procedure :: update_array_pointers
    !> Initialize MONARCH state arrays
    procedure :: initialize_arrays
    !> Set the MONARCH array pointer in the solver internal state VARS array
    procedure, private :: set_array_pointers
    !> Add an array to the set of state arrays
    procedure, private :: add_state_array
    !> Find a state array by name
    procedure :: find_state_array
    !> Determine if NetCDF output arrays should be limited to 4 dimensions maximum
    procedure, private :: is_max_4D_output

    ! Cell modification function
#ifdef DO_PARTMC
    !> Save the phlex state to the SOLVER_INTERNAL_STATE
    procedure :: save_phlex_state
#endif
    !> Move air mass
    procedure :: move_air_mass
    !> Save a property to the solver state
    generic :: save_property => save_property_real,                          &
                                save_property_real_array
    !> Save a real value the solver state
    procedure :: save_property_real
    !> Save a real array element value to the solver state
    procedure :: save_property_real_array

    !> Check the status of a NetCDF operation
    procedure, private :: check_nf90 => check_nf90_state_changer
  end type monarch_state_changer_t

contains

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

  !> Attach to a SOLVER_INTERNAL_STATE instance
  !!
  !! Before performing modifications, instances of monarch_state_changer_t must
  !! attach to a SOLVER_INTERNAL_STATE object.
  subroutine attach( this, int_state, aero_rep, num_vertical_layers )

    use monarch_util,                       only : assert_msg

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> Solver internal state
    type(solver_internal_state), target, intent(in) :: int_state
    !> MONARCH aerosol representation
    class(monarch_aerosol_representation_t), target, intent(inout) :: aero_rep
    !> Number of vertical layers
    !! (During initialization, this may not be available from the solver
    !!  internal state, so it must be sent explicitly.)
    !! FIXME Can we set this earlier in the solver internal state?
    integer(kind=mint), optional, intent(in) :: num_vertical_layers

    this%int_state => int_state
    this%aero_rep => aero_rep

    if( present( num_vertical_layers ) ) then
      this%num_vertical_layers = num_vertical_layers
    else
      call assert_msg( 157963028, associated( int_state%LM ),                &
                       "If attaching a state changer to the solver "//       &
                       "internal state before the number of vertical "//     &
                       "layers has been set, this value must be passed "//   &
                       "explicitly." )
      this%num_vertical_layers = int_state%LM
    end if

  end subroutine attach

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#ifdef DO_PARTMC
  !> Set the internal PartMC<->MONARCH species map
  subroutine use_species_map( this, species_map )

    use monarch_util,                       only : assert_msg

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> Species map
    type(monarch_species_map_t), target, intent(in) :: species_map

    call assert_msg( 586164007, this%int_state%do_partmc,                    &
                     "Trying to use a species map without PartMC turned on." )

    this%species_map => species_map

  end subroutine use_species_map
#endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Register a per-column real variable
  !!
  !! Allocate an array in the solver state to hold a single real value for
  !! each column
  function register_per_column_real( this, unique_name, output_to_hist_file, &
      num_props, prop_names, is_owned, prop_map )  result( new_array )

    use monarch_util,                       only : assert_msg, die_msg,      &
                                                   to_string

    !> Pointer to newly allocated state array
    type(monarch_state_array_ptr) :: new_array
    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> Unique name for the array (will be used in the output file)
    character(len=*), intent(in) :: unique_name
    !> Flag to indicate whether to output this value to the history file
    logical, intent(in) :: output_to_hist_file
    !> Number of properties per column to store
    !! (Defaults to 1 if omitted)
    integer(kind=mint), optional, intent(in) :: num_props
    !> Name of each property
    type(string_t), optional, allocatable, intent(in) :: prop_names( : )
    !> Flag indicating whether the array is owned by the state changer
    !!
    !! Set to false to indicate the array is allocated elsewhere.
    !! (Defaults to true if omitted)
    logical, optional, intent(in) :: is_owned
    !> Property map
    !!
    !! When is_owned=false, this map can be included to specify individual
    !! properties from the state array to include in the output
    integer(kind=mint), optional, intent(in) :: prop_map( : )

    type(monarch_state_array_ptr), pointer :: local_array
    integer(kind=mint) :: i_prop

    call assert_msg( 314199283, .not. this%arrays_allocated( ),              &
                     "Trying to add a state array after they have been "//   &
                     "allocated." )

    local_array => this%add_state_array( )
    local_array%unique_name%string = unique_name
    local_array%to_hist_file = output_to_hist_file
    local_array%netcdf_units%string = "unknown"
    local_array%netcdf_short_name%string = unique_name
    local_array%netcdf_long_name%string = unique_name
    local_array%netcdf_standard_name%string = unique_name
    if( present( num_props ) ) local_array%num_props = num_props
    if( .not. present( num_props ) ) then
      local_array%type_id = VAR_TYPE_PER_COLUMN_REAL
    else
      local_array%type_id = VAR_TYPE_PER_COLUMN_REAL_ARRAY
      if( present( prop_names ) ) then
        local_array%prop_name = prop_names
      else
        call die_msg( 584376376, "Missing property names for state array." )
      end if
    end if
    allocate( local_array%netcdf_var_id( 1 ) )
    local_array%netcdf_var_id( : ) = 0
    call assert_msg( 417953407, local_array%num_props .ge. 1,                &
                     "State arrays must have at least one element." )
    if( present( is_owned ) ) then
      local_array%is_owned = is_owned
      if( present( prop_map ) ) then
        call assert_msg( 958756462,                                          &
                         size( prop_map ) .eq. local_array%num_props,        &
                         "Property map size ("//to_string( size( prop_map ) )&
                         //") must match number of properties ("//           &
                         to_string( local_array%num_props ) )
        ! Invert the map to hold output ids for each state var id up to the
        ! highest index used
        allocate( local_array%prop_map( maxval( prop_map ) ) )
        local_array%prop_map( : ) = 0
        do i_prop = 1, size( prop_map )
          local_array%prop_map( prop_map( i_prop ) ) = i_prop
        end do
      end if
    endif
    call assert_msg( 366935780, .not. allocated( local_array%prop_map ) .or. &
                                .not. local_array%is_owned,                  &
                       "Property map can be used with only unowned arrays" )
    new_array = local_array

  end function register_per_column_real

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

  !> Register a per-grid-cell real variable
  !!
  !! Allocate an array in the solver state to hold a single real value for
  !! each grid cell
  function register_per_cell_real( this, unique_name, output_to_hist_file,   &
      num_props, prop_names, is_owned, prop_map ) result( new_array )

    use monarch_util,                       only : assert_msg, die_msg,      &
                                                   to_string

    !> Pointer to newly allocated state array
    type(monarch_state_array_ptr) :: new_array
    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> Unique name for the array (will be used in the output file)
    character(len=*), intent(in) :: unique_name
    !> Flag to indicate whether to output this value to the history file
    logical, intent(in) :: output_to_hist_file
    !> Number of properties per grid cell to store
    !! (Defaults to 1 if omitted)
    integer(kind=mint), optional, intent(in) :: num_props
    !> Name of each property
    type(string_t), optional, allocatable, intent(in) :: prop_names( : )
    !> Flag indicating whether the array is owned by the state changer
    !!
    !! Set to false to indicate the array is allocated elsewhere.
    !! (Defaults to true if omitted)
    logical, optional, intent(in) :: is_owned
    !> Property map
    !!
    !! When is_owned=false, this map can be included to specify individual
    !! properties from the state array to include in the output
    integer(kind=mint), optional, intent(in) :: prop_map( : )

    type(monarch_state_array_ptr), pointer :: local_array
    integer(kind=mint) :: i_prop

    call assert_msg( 636965818, .not. this%arrays_allocated( ),              &
                     "Trying to add a state array after they have been "//   &
                     "allocated." )

    local_array => this%add_state_array( )
    local_array%unique_name%string = unique_name
    local_array%to_hist_file = output_to_hist_file
    local_array%netcdf_units%string = "unknown"
    local_array%netcdf_short_name%string = unique_name
    local_array%netcdf_long_name%string = unique_name
    local_array%netcdf_standard_name%string = unique_name
    if( present( num_props ) ) local_array%num_props = num_props
    if( .not. present( num_props ) ) then
      local_array%type_id = VAR_TYPE_PER_CELL_REAL
      allocate( local_array%netcdf_var_id( 1 ) )
    else
      local_array%type_id = VAR_TYPE_PER_CELL_REAL_ARRAY
      if( present( prop_names ) ) then
        local_array%prop_name = prop_names
      else
        call die_msg( 179506463, "Missing property names for state array." )
      end if
      if( this%is_max_4D_output( ) ) then
        allocate( local_array%netcdf_var_id( num_props ) )
      else
        allocate( local_array%netcdf_var_id( 1 ) )
      end if
    end if
    local_array%netcdf_var_id( : ) = 0
    call assert_msg( 377361008, local_array%num_props .ge. 1,                &
                     "State arrays must have at least one element." )
    if( present( is_owned ) ) then
      local_array%is_owned = is_owned
      if( present( prop_map ) ) then
        call assert_msg( 241182343,                                          &
                         size( prop_map ) .eq. local_array%num_props,        &
                         "Property map size ("//to_string( size( prop_map ) )&
                         //") must match number of properties ("//           &
                         to_string( local_array%num_props ) )
        ! Invert the map to hold output ids for each state var id up to the
        ! highest index used
        allocate( local_array%prop_map( maxval( prop_map ) ) )
        local_array%prop_map( : ) = 0
        do i_prop = 1, size( prop_map )
          local_array%prop_map( prop_map( i_prop ) ) = i_prop
        end do
      end if
    endif
    call assert_msg( 300926436, .not. allocated( local_array%prop_map ) .or. &
                                .not. local_array%is_owned,                  &
                     "Property map can only be used with unowned arrays" )
    new_array = local_array

  end function register_per_cell_real

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

  !> Register a per-grid-cell real variable
  !!
  !! Allocate an array in the solver state to hold a single real value for
  !! each vertical interface for each grid cell from the top of the domain to
  !! the surface
  function register_per_vertical_interface_real( this, unique_name,          &
      output_to_hist_file, num_props, prop_names, is_owned, prop_map )       &
      result( new_array )

    use monarch_util,                       only : assert_msg, die_msg,      &
                                                   to_string

    !> Pointer to newly allocated state array
    type(monarch_state_array_ptr) :: new_array
    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> Unique name for the array (will be used in the output file)
    character(len=*), intent(in) :: unique_name
    !> Flag to indicate whether to output this value to the history file
    logical, intent(in) :: output_to_hist_file
    !> Number of properties per grid cell to store
    !! (Defaults to 1 if omitted)
    integer(kind=mint), optional, intent(in) :: num_props
    !> Name of each property
    type(string_t), optional, allocatable, intent(in) :: prop_names( : )
    !> Flag indicating whether the array is owned by the state changer
    !!
    !! Set to false to indicate the array is allocated elsewhere.
    !! (Defaults to true if omitted)
    logical, optional, intent(in) :: is_owned
    !> Property map
    !!
    !! When is_owned=false, this map can be included to specify individual
    !! properties from the state array to include in the output
    integer(kind=mint), optional, intent(in) :: prop_map( : )

    type(monarch_state_array_ptr), pointer :: local_array
    integer(kind=mint) :: i_prop

    call assert_msg( 534620569, .not. this%arrays_allocated( ),              &
                     "Trying to add a state array after they have been "//   &
                     "allocated." )

    local_array => this%add_state_array( )
    local_array%unique_name%string = unique_name
    local_array%to_hist_file = output_to_hist_file
    local_array%netcdf_units%string = "unknown"
    local_array%netcdf_short_name%string = unique_name
    local_array%netcdf_long_name%string = unique_name
    local_array%netcdf_standard_name%string = unique_name
    if( present( num_props ) ) local_array%num_props = num_props
    if( .not. present( num_props ) ) then
      local_array%type_id = VAR_TYPE_PER_VERT_INT_REAL
      allocate( local_array%netcdf_var_id( 1 ) )
    else
      local_array%type_id = VAR_TYPE_PER_VERT_INT_REAL_ARRAY
      if( present( prop_names ) ) then
        local_array%prop_name = prop_names
      else
        call die_msg( 643580141, "Missing property names for state array." )
      end if
      if( this%is_max_4D_output( ) ) then
        allocate( local_array%netcdf_var_id( num_props ) )
      else
        allocate( local_array%netcdf_var_id( 1 ) )
      end if
    end if
    local_array%netcdf_var_id( : ) = 0
    call assert_msg( 141732509, local_array%num_props .ge. 1,                &
                     "State arrays must have at least one element." )
    if( present( is_owned ) ) then
      local_array%is_owned = is_owned
      if( present( prop_map ) ) then
        call assert_msg( 638315834,                                          &
                         size( prop_map ) .eq. local_array%num_props,        &
                         "Property map size ("//to_string( size( prop_map ) )&
                         //") must match number of properties ("//           &
                         to_string( local_array%num_props ) )
        ! Invert the map to hold output ids for each state var id up to the
        ! highest index used
        allocate( local_array%prop_map( maxval( prop_map ) ) )
        local_array%prop_map( : ) = 0
        do i_prop = 1, size( prop_map )
          local_array%prop_map( prop_map( i_prop ) ) = i_prop
        end do
      end if
    endif
    call assert_msg( 772715548, .not. allocated( local_array%prop_map ) .or. &
                                .not. local_array%is_owned,                  &
                     "Property map can only be used with unowned arrays" )
    new_array = local_array

  end function register_per_vertical_interface_real

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

  !> Register an array shaped like the NMMB tracers array
  !!
  !! Use this function to register arrays allocated and owned elsewhere that
  !! are shaped like the NMMB tracers array:
  !!   (West:East, South:North, suface:TOA, tracer_ids )
  function register_tracers_like( this, unique_name, output_to_hist_file,   &
      num_props, prop_names, prop_map ) result( new_array )

    use monarch_util,                       only : assert_msg, die_msg,      &
                                                   to_string

    !> Pointer to newly allocated state array
    type(monarch_state_array_ptr) :: new_array
    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> Unique name for the array (will be used in the output file)
    character(len=*), intent(in) :: unique_name
    !> Flag to indicate whether to output this value to the history file
    logical, intent(in) :: output_to_hist_file
    !> Number of properties per grid cell to store
    integer(kind=mint), intent(in) :: num_props
    !> Name of each property
    type(string_t), allocatable, intent(in) :: prop_names( : )
    !> Property map
    !!
    !! This map can be included to specify individual
    !! properties from the state array to include in the output
    integer(kind=mint), optional, intent(in) :: prop_map( : )

    type(monarch_state_array_ptr), pointer :: local_array
    integer(kind=mint) :: i_prop

    call assert_msg( 147538658, .not. this%arrays_allocated( ),              &
                     "Trying to add a state array after they have been "//   &
                     "allocated." )

    local_array => this%add_state_array( )
    local_array%unique_name%string = unique_name
    local_array%to_hist_file = output_to_hist_file
    local_array%netcdf_units%string = "unknown"
    local_array%netcdf_short_name%string = unique_name
    local_array%netcdf_long_name%string = unique_name
    local_array%netcdf_standard_name%string = unique_name
    local_array%num_props = num_props
    call assert_msg( 207282751, local_array%num_props .ge. 1,                &
                     "State arrays must have at least one element." )
    local_array%type_id = VAR_TYPE_TRACERS_LIKE
    local_array%prop_name = prop_names
    local_array%is_owned = .false.
    if( present( prop_map ) ) then
      call assert_msg( 537067945,                                            &
                       size( prop_map ) .eq. local_array%num_props,          &
                       "Property map size ("//to_string( size( prop_map ) )  &
                       //") must match number of properties ("//             &
                       to_string( local_array%num_props ) )
      ! Invert the map to hold output ids for each state var id up to the
      ! highest index used
      allocate( local_array%prop_map( maxval( prop_map ) ) )
      local_array%prop_map( : ) = 0
      do i_prop = 1, size( prop_map )
        local_array%prop_map( prop_map( i_prop ) ) = i_prop
      end do
    end if
    if( this%is_max_4D_output( ) ) then
      allocate( local_array%netcdf_var_id( num_props ) )
    else
      allocate( local_array%netcdf_var_id( 1 ) )
    end if
    local_array%netcdf_var_id( : ) = 0
    new_array = local_array

  end function register_tracers_like

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

  !> Add an array to the set of state arrays
  function add_state_array( this )

    !> Pointer to the new state array
    type(monarch_state_array_ptr), pointer :: add_state_array
    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this

    type(monarch_state_array_ptr), pointer :: last_array

    if( .not. associated( this%state_arrays ) ) then
      allocate( this%state_arrays )
      add_state_array => this%state_arrays
      add_state_array%id = 1
    else
      last_array => this%state_arrays
      do while( associated( last_array%next_array ) )
        last_array => last_array%next_array
      end do
      allocate( last_array%next_array )
      add_state_array => last_array%next_array
      add_state_array%id = last_array%id + 1
      add_state_array%is_max_4D_output = this%is_max_4D_output( )
    end if

  end function add_state_array

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

  !> Find a state array by name
  function find_state_array( this, array_name ) result( state_array )

    !> State array pointer
    type(monarch_state_array_ptr), pointer :: state_array
    !> State changer object
    class(monarch_state_changer_t), intent(in) :: this
    !> Name of the state array to find
    character(len=*), intent(in) :: array_name

    type(monarch_state_array_ptr), pointer :: curr_array

    state_array => null( )
    curr_array => this%state_arrays
    do while( associated( curr_array ) )
      if( curr_array%unique_name%string .eq. array_name ) then
        allocate( state_array )
        state_array = curr_array
        return
      end if
      curr_array => curr_array%next_array
    end do

  end function find_state_array

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

  !> Determine whether NetCDF arrays should be limited to 4 dimensions maximum
  pure function is_max_4D_output( this )

    !> Limit to 4D max?
    logical :: is_max_4D_output
    !> State changer
    class(monarch_state_changer_t), intent(in) :: this

    is_max_4D_output = this%int_state%NETCDF_4D_OUT

  end function is_max_4D_output

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

  !> Determine whether the monarch state arrays have been allocated
  function arrays_allocated( this )

    !> Flag indicating whether the MONARCH arrays have been allocated
    logical :: arrays_allocated
    !> State changer object
    class(monarch_state_changer_t), intent(in) :: this

    arrays_allocated = allocated( this%int_state%monarch_state_var )

  end function arrays_allocated

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

  !> Allocate the state arrays
  !!
  !! After the arrays are allocated, no more can be added to the solver state
  subroutine allocate_arrays( this )

    use monarch_util,                       only : assert_msg, assert,       &
                                                   die_msg, to_string

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this

    type(monarch_state_array_ptr), pointer :: curr_array
    integer(kind=mint) :: num_array, i_array

    call assert_msg( 281325374, .not. this%arrays_allocated( ),              &
                     "Trying to allocate state arrays more than once." )

    ! Count the arrays to allocate
    num_array = 0
    curr_array => this%state_arrays
    do while( associated( curr_array ) )
      num_array = num_array + 1
      curr_array => curr_array%next_array
    end do

    ! Allocate the set of arrays
    allocate( this%int_state%monarch_state_var( num_array ) )

    ! Register the new arrays with the solver internal state. This allocates
    ! memory for the arrays that are owned by the monarch_state_changer_t
    ! obejct and sets the state array pointers.
    call this%set_array_pointers( )

  end subroutine allocate_arrays

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

  !> Initialize gas- and aerosol-phase species concentrations for the domain
  !!
  !! When a file path is included, species concentrations are read in,
  !! otherwise they are set to default values
  subroutine initialize_domain_species_conc( this, input_file_path )

    use module_dm_parallel,                      only : dstrb
    use module_exchange,                         only : halo_exch
    use netcdf,                                  only : nf90_open,           &
                                                        NF90_NOWRITE,        &
                                                        nf90_inq_varid,      &
                                                        nf90_get_var,        &
                                                        nf90_close

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> NetCDF input file path
    character(len=*), optional, intent(in) :: input_file_path

    integer(kind=mint) :: start_tracer_id, end_tracer_id, file_id
    integer(kind=mint) :: i_spec, i_layer, n_layers
    integer(kind=mint) :: IDS, IDE, JDS, JDE
    integer(kind=mint) :: IMS, IME, JMS, JME
    real(kind=mflt), allocatable :: spec_conc( :,: )
    integer(kind=mint) :: variable_id
    character(len=3)  :: variable_num
    character(len=11) :: variable_name

    associate( int_state => this%int_state )

    ! Get range of indices for gas and aerosol species in TRACERS
    if( int_state%INDX_AERO_START .gt. 0 ) then
      start_tracer_id = int_state%INDX_AERO_START
    else if( int_state%INDX_GAS_START .gt. 0 ) then
      start_tracer_id = int_state%INDX_GAS_START
    else
      return
    end if
    end_tracer_id = start_tracer_id +                                        &
                    int_state%NUM_AERO + int_state%NUM_GAS_TOTAL - 1

    ! Reset concentrations
    if( int_state%NUM_AERO .gt. 0 )                                          &
      int_state%TRACERS( :, :, :, int_state%INDX_AERO_START :                &
                                  int_state%INDX_AERO_END      ) = 0.0
    if( int_state%NUM_GAS .gt. 0 )                                           &
      int_state%TRACERS( :, :, :, int_state%INDX_GAS_START :                 &
                                  int_state%INDX_GAS_END       ) = 1.0e-30

    ! Initialize from an input file
    if( present( input_file_path ) ) then

      IDS = int_state%IDS
      IDE = int_state%IDE
      JDS = int_state%JDS
      JDE = int_state%JDE
      IMS = int_state%IMS
      IME = int_state%IME
      JMS = int_state%JMS
      JME = int_state%JME
      n_layers = int_state%LM

      allocate( spec_conc( IDS:IDE, JDS:JDE ) )

      ! Open the input file on the primary task
      if( int_state%MYPE .eq. 0 ) then
        write(0,*) "Opening file "//trim( input_file_path )//                &
                   " for initialization of gas and aerosol species"
        call this%check_nf90( nf90_open( input_file_path, NF90_NOWRITE,      &
                                         file_id ) )
      end if

      ! Read in each species for each vertical level across the domain
      do i_spec = start_tracer_id, end_tracer_id
        do i_layer = 1, n_layers

          ! Read a variable on the primary process
          if( int_state%MYPE .eq. 0 ) then
            write( variable_num, '(I3.3)' ) i_spec
            variable_name = "TRACERS_"//variable_num
            call this%check_nf90( nf90_inq_varid( file_id, variable_name,    &
                                           variable_id ) )
            call this%check_nf90( nf90_get_var(                              &
                                           file_id, variable_id, spec_conc,  &
                                           start = (/ 1, 1, i_layer /),      &
                                           count = (/ IDE, JDE, 1 /) ) )
          end if

          ! Distribute to all the compute processes
          call dstrb(                                                        &
              spec_conc,                                                     &
              int_state%TRACERS( :, :, :, start_tracer_id:end_tracer_id ),   &
              1, 1, 1, n_layers, i_layer,                                    &
              int_state%MYPE, int_state%MPI_COMM_COMP )
        end do

        ! Do halo exchange
        call halo_exch(                                                      &
            int_state%TRACERS( IMS:IME, JMS:JME, 1:n_layers, i_spec ),       &
            n_layers, 2, 2 )
      end do

      ! Close the netCDF file
      if( int_state%MYPE .eq. 0 ) then
        write(0,*) "Closing file "//trim( input_file_path )//                &
                   " after initialization of gas and aerosol species"
        call this%check_nf90( nf90_close( file_id ) )
      end if

    ! Initialize to default values
    else
      ! TODO FINISH
    endif

    end associate

  end subroutine initialize_domain_species_conc

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

  !> Allocates memory and sets pointers in the SOLVER_INTERNAL_STATE%VARS
  !! array for all the state arrays owned by the state_changer_t object
  subroutine set_array_pointers( this )

    use monarch_util,                       only : assert_msg, die_msg,      &
                                                   to_string

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this

    type(monarch_state_array_ptr), pointer :: curr_array
    character(len=:), allocatable :: unique_name
    integer(kind=mint) :: IMS, IME, JMS, JME, LM, n_prop
    integer(kind=mint) :: last_used_id, num_to_alloc

    ! Get the last-used index in VARS to know where to start adding arrays
    last_used_id = this%int_state%NUM_VARS

    ! Count the arrays to be allocated (as opposed to those allocated by nmmb)
    num_to_alloc = 0
    curr_array => this%state_arrays
    do while( associated( curr_array ) )
      if( curr_array%is_owned ) num_to_alloc = num_to_alloc + 1
      curr_array => curr_array%next_array
    end do

    ! Update the number of solver internal state variables
    this%int_state%NUM_VARS = this%int_state%NUM_VARS + num_to_alloc

    ! Set dimensionsion variables
    IMS = this%int_state%IMS
    IME = this%int_state%IME
    JMS = this%int_state%JMS
    JME = this%int_state%JME
    LM  = this%num_vertical_layers

    ! Register each allocated array
    associate( int_state => this%int_state )
    curr_array => this%state_arrays
    do while( associated( curr_array ) )
      if( curr_array%is_owned ) then
        unique_name = "MNRC~"//curr_array%unique_name%string//'~'
        n_prop      = curr_array%num_props

        ! Set this index of this array in the internal state VARS array
        last_used_id       = last_used_id + 1
        curr_array%vars_id = last_used_id

        ! Make sure the variable names will fit
        call assert_msg( 620895839, len( unique_name ) .le. 32,             &
                         "State array name too long: "//unique_name )

        ! Set the variable properties
        int_state%VARS( curr_array%vars_id )%VBL_NAME = unique_name
        int_state%VARS( curr_array%vars_id )%HISTORY  = .true.
        int_state%VARS( curr_array%vars_id )%OWNED    = .true.

        select case( curr_array%type_id )
          case( VAR_TYPE_PER_COLUMN_REAL )
            call this%int_state%monarch_state_var( curr_array%id             &
                     )%set_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS /),                     &
                                         (/ IME, JME /) )
          case( VAR_TYPE_PER_COLUMN_REAL_ARRAY )
            call this%int_state%monarch_state_var( curr_array%id             &
                     )%set_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,      1 /),             &
                                         (/ IME, JME, n_prop /) )
          case( VAR_TYPE_PER_CELL_REAL )
            call this%int_state%monarch_state_var( curr_array%id             &
                     )%set_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1 /),                 &
                                         (/ IME, JME, LM /) )
          case( VAR_TYPE_PER_CELL_REAL_ARRAY )
            call this%int_state%monarch_state_var( curr_array%id             &
                     )%set_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1,      1 /),         &
                                         (/ IME, JME, LM, n_prop /) )
          case( VAR_TYPE_PER_VERT_INT_REAL )
            call this%int_state%monarch_state_var( curr_array%id             &
                     )%set_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1 /),                 &
                                         (/ IME, JME, LM + 1 /) )
          case( VAR_TYPE_PER_VERT_INT_REAL_ARRAY )
            call this%int_state%monarch_state_var( curr_array%id             &
                     )%set_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1,      1 /),         &
                                         (/ IME, JME, LM + 1, n_prop /) )
          case( VAR_TYPE_TRACERS_LIKE )
            call die_msg( 265809534, "Cannot allocate a tracers-like "//     &
                          "array. This type is only used to attach to "//    &
                          "arrays allocated elsewhere." )
          case default
            call die_msg( 207355594, "Unknown state array type: "//          &
                          to_string( curr_array%type_id ) )
        end select

      end if
      curr_array => curr_array%next_array
    end do
    end associate

  end subroutine set_array_pointers

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

  !> Update array pointers
  !!
  !! When an array pointer is flagged to point to an array allocated elsewhere
  !! this subroutine finds the allocated array in solver_internal_state%VARS
  !! and points to it.
  subroutine update_array_pointers( this )

    use monarch_util,                       only : assert_msg, die_msg,      &
                                                   to_string, assert

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this

    type(monarch_state_array_ptr), pointer :: curr_array
    character(len=:), allocatable :: unique_name
    integer(kind=mint) :: IMS, IME, JMS, JME, LM, n_prop
    integer(kind=mint) :: last_used_id, num_to_alloc

    ! Set dimensionsion variables
    IMS = this%int_state%IMS
    IME = this%int_state%IME
    JMS = this%int_state%JMS
    JME = this%int_state%JME
    LM  = this%num_vertical_layers

    ! Find each allocated array and set the pointers
    associate( int_state => this%int_state )
    curr_array => this%state_arrays
    do while( associated( curr_array ) )
      if( .not.curr_array%is_owned ) then
        unique_name = curr_array%unique_name%string
        n_prop      = curr_array%num_props

        ! Make sure the variable names will fit
        call assert_msg( 620895839, len( unique_name ) .le. 32,             &
                         "State array name too long: "//unique_name )

        ! Find and attach to the allocated array
        select case( curr_array%type_id )
          case( VAR_TYPE_PER_COLUMN_REAL )
            curr_array%vars_id = int_state%monarch_state_var( curr_array%id  &
                  )%attach_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS /),                     &
                                         (/ IME, JME /) )
          case( VAR_TYPE_PER_COLUMN_REAL_ARRAY )
            curr_array%vars_id = int_state%monarch_state_var( curr_array%id  &
                  )%attach_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,      1 /),             &
                                         (/ IME, JME, n_prop /) )
          case( VAR_TYPE_PER_CELL_REAL )
            curr_array%vars_id = int_state%monarch_state_var( curr_array%id  &
                  )%attach_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1 /),                 &
                                         (/ IME, JME, LM /) )
          case( VAR_TYPE_PER_CELL_REAL_ARRAY )
            curr_array%vars_id = int_state%monarch_state_var( curr_array%id  &
                  )%attach_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1,      1 /),         &
                                         (/ IME, JME, LM, n_prop /) )
          case( VAR_TYPE_PER_VERT_INT_REAL )
            curr_array%vars_id = int_state%monarch_state_var( curr_array%id  &
                  )%attach_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1 /),                 &
                                         (/ IME, JME, LM + 1 /) )
          case( VAR_TYPE_PER_VERT_INT_REAL_ARRAY )
            curr_array%vars_id = int_state%monarch_state_var( curr_array%id  &
                  )%attach_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1,      1 /),         &
                                         (/ IME, JME, LM + 1, n_prop /) )
          case( VAR_TYPE_TRACERS_LIKE )
            curr_array%vars_id = int_state%monarch_state_var( curr_array%id  &
                  )%attach_variable_ptr( int_state%VARS,                     &
                                         int_state%NUM_VARS,                 &
                                         unique_name,                        &
                                         (/ IMS, JMS,  1,      1 /),         &
                                         (/ IME, JME, LM, n_prop /) )
          case default
            call die_msg( 221298414, "Unknown state array type: "//          &
                          to_string( curr_array%type_id ) )
        end select
      end if
      curr_array => curr_array%next_array
    end do
    end associate

    ! Do a final check (all arrays should now be allocated)
    curr_array => this%state_arrays
    do while( associated( curr_array ) )
      call assert( 498222233, curr_array%vars_id .gt. 0 )
      call assert( 382585728,                                                &
                this%int_state%monarch_state_var( curr_array%id              &
                                                  )%is_allocated( ) )
      curr_array => curr_array%next_array
    end do

  end subroutine update_array_pointers

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

  !> Initialize MONARCH state arrays
  !!
  !! This should be called before the state arrays are first passed to the
  !! write tasks for output. It will initialize all the state arrays owned
  !! by the monarch_state_changer_t object to intitial values (for now this is
  !! the netCDF fill value)
  subroutine initialize_arrays( this )

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this

    type(monarch_state_array_ptr), pointer :: curr_array

    curr_array => this%state_arrays
    do while( associated( curr_array ) )
      if( curr_array%is_owned ) call curr_array%reset_array( this )
      curr_array => curr_array%next_array
    end do

  end subroutine initialize_arrays

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

  !> Move air mass
  !!
  !! This function removes a specified fraction of the mass in one grid cell
  !! and moves it to another. TODO Only gas-phase species are moved. See if
  !! we should add a function to move aerosol species
  subroutine move_air_mass( this, from_cell, to_cell, frac )

    use monarch_util,                       only : monarch_point_t

    !> State changer object
    class(monarch_state_changer_t), intent(inout) :: this
    !> Indices of cell to remove mass from
    type(monarch_point_t), intent(in) :: from_cell
    !> Indices of cell to move mass to
    type(monarch_point_t), intent(in) :: to_cell
    !> Fraction of mass from source cell to move( 0.0...1.0 )
    real(kind=mdbl), intent(in) :: frac

    integer(kind=mint) :: f_WE, f_SN, f_lyr, t_WE, t_SN, t_lyr
    integer(kind=mint) :: spec_start, spec_end

    f_WE       = from_cell%WE_idx( )
    f_SN       = from_cell%SN_idx( )
    f_lyr      = from_cell%vertical_idx( )
    t_WE       = to_cell%WE_idx( )
    t_SN       = to_cell%SN_idx( )
    t_lyr      = to_cell%vertical_idx( )
    spec_start = this%int_state%INDX_GAS_START
    spec_end   = this%int_state%INDX_GAS_END

    associate( conc => this%int_state%TRACERS )

      conc( t_WE, t_SN, t_lyr, spec_start : spec_end ) =                     &
          conc( t_WE, t_SN, t_lyr, spec_start : spec_end ) +                 &
          frac * conc( f_WE, f_SN, f_lyr, spec_start : spec_end )

      conc( f_WE, f_SN, f_lyr, spec_start : spec_end ) =                     &
          ( 1.0 - frac ) * conc( f_WE, f_SN, f_lyr, spec_start : spec_end )

    end associate

  end subroutine move_air_mass

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#ifdef DO_PARTMC
  !> Save a phlex state to the solver internal state
  !!
  !! This function uses a species map to update the SOLVER_INTERNAL_STATE for
  !! one grid cell based on a phlex_state_t object
  subroutine save_phlex_state( this, cell, phlex_state,                      &
      number_density_air__molm3 )

    use monarch_util,                       only : monarch_point_t, assert_msg
    use pmc_phlex_state,                    only : phlex_state_t

    !> State changer
    class(monarch_state_changer_t), intent(inout) :: this
    !> Grid cell indices
    type(monarch_point_t), intent(in) :: cell
    !> Phlex-state
    type(phlex_state_t), intent(in) :: phlex_state
    !> Number density of air [mol m-3] for species that flip phase in
    !! conversion
    real(kind=mdbl), intent(in) :: number_density_air__molm3

    integer(kind=mint) :: i_WE, i_SN, i_vert_flip, i_spec

    call assert_msg( 601504633, this%int_state%do_partmc,                    &
                     "Trying to save a phlex_state_t object without "//      &
                     "PartMC turned on." )

    i_WE        = cell%WE_idx( )
    i_SN        = cell%SN_idx( )
    i_vert_flip = cell%flipped_vertical_idx( )

    ! Update the tracers array using the species map
    call this%species_map%update_tracers( phlex_state,                       &
        this%int_state%TRACERS( i_WE, i_SN, i_vert_flip, : ),                &
        number_density_air__molm3 )

  end subroutine save_phlex_state
#endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !> Save a diagnostic property to the solver state
  subroutine save_property_real( this, state_array_ptr, indices, prop_value )

    use monarch_util,                       only : monarch_point_t, die_msg, &
                                                   to_string, assert_msg

    !> State changer
    class(monarch_state_changer_t), intent(inout) :: this
    !> State array pointer
    type(monarch_state_array_ptr), intent(in) :: state_array_ptr
    !> Indices to use for update
    type(monarch_point_t), intent(in) :: indices
    !> Property value
    real(kind=mflt), intent(in) :: prop_value

    call assert_msg( 720218412, state_array_ptr%is_owned,                    &
                     "Attempting to set an unowned state array value." )

    select case( state_array_ptr%type_id )
      case( VAR_TYPE_PER_COLUMN_REAL )
        call this%int_state%monarch_state_var( state_array_ptr%id            &
                           )%set_variable( indices%WE_idx( ),                &
                                           indices%SN_idx( ),                &
                                           prop_value )
      case( VAR_TYPE_PER_CELL_REAL )
        call this%int_state%monarch_state_var( state_array_ptr%id            &
                           )%set_variable( indices%WE_idx( ),                &
                                           indices%SN_idx( ),                &
                                           indices%flipped_vertical_idx( ),  &
                                           prop_value )
      case( VAR_TYPE_PER_VERT_INT_REAL )
        call this%int_state%monarch_state_var( state_array_ptr%id            &
                 )%set_variable( indices%WE_idx( ),                          &
                                 indices%SN_idx( ),                          &
                                 indices%flipped_vertical_interface_idx( ),  &
                                 prop_value )
      case default
        call die_msg( 913752462, "Trying to set real value for state "//     &
                                 "array type: "//to_string(          &
                                                   state_array_ptr%type_id ) )
    end select

  end subroutine save_property_real

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

  !> Save a diagnostic property to the solver state
  subroutine save_property_real_array( this, state_array_ptr, indices,       &
      prop_id, prop_value )

    use monarch_util,                       only : monarch_point_t, die_msg, &
                                                   to_string, assert_msg

    !> State changer
    class(monarch_state_changer_t), intent(inout) :: this
    !> State array pointer
    type(monarch_state_array_ptr), intent(in) :: state_array_ptr
    !> Indices to use for update
    type(monarch_point_t), intent(in) :: indices
    !> Property id
    integer(kind=mint), intent(in) :: prop_id
    !> Property value
    real(kind=mflt), intent(in) :: prop_value

    call assert_msg( 208294461, state_array_ptr%is_owned,                    &
                     "Attempting to set an unowned state array value." )

    select case( state_array_ptr%type_id )
      case( VAR_TYPE_PER_COLUMN_REAL_ARRAY )
        call this%int_state%monarch_state_var( state_array_ptr%id            &
                           )%set_variable( indices%WE_idx( ),                &
                                           indices%SN_idx( ),                &
                                           prop_id,                          &
                                           prop_value )
      case( VAR_TYPE_PER_CELL_REAL_ARRAY )
        call this%int_state%monarch_state_var( state_array_ptr%id            &
                           )%set_variable( indices%WE_idx( ),                &
                                           indices%SN_idx( ),                &
                                           indices%flipped_vertical_idx( ),  &
                                           prop_id,                          &
                                           prop_value )
      case( VAR_TYPE_PER_VERT_INT_REAL_ARRAY )
        call this%int_state%monarch_state_var( state_array_ptr%id            &
                 )%set_variable( indices%WE_idx( ),                          &
                                 indices%SN_idx( ),                          &
                                 indices%flipped_vertical_interface_idx( ),  &
                                 prop_id,                                    &
                                 prop_value )
      case default
        call die_msg( 522779132, "Trying to set real array  value for "//    &
                                 "state array type: "//to_string(    &
                                                   state_array_ptr%type_id ) )
    end select

  end subroutine save_property_real_array

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

  !> Set the NetCDF short name
  subroutine set_netcdf_short_name( this, short_name )

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Short name
    character(len=*), intent(in) :: short_name

    this%netcdf_short_name%string = short_name

  end subroutine set_netcdf_short_name

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

  !> Set the NetCDF long name
  subroutine set_netcdf_long_name( this, long_name )

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Long name
    character(len=*), intent(in) :: long_name

    this%netcdf_long_name%string = long_name

  end subroutine set_netcdf_long_name

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

  !> Set the NetCDF standard name
  subroutine set_netcdf_standard_name( this, std_name )

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Standard name
    character(len=*), intent(in) :: std_name

    this%netcdf_standard_name%string = std_name

  end subroutine set_netcdf_standard_name

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

  !> Set the NetCDF units
  subroutine set_netcdf_units( this, units )

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Units
    character(len=*), intent(in) :: units

    this%netcdf_units%string = units

  end subroutine set_netcdf_units

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

  !> Set the NetCDF missing real
  subroutine set_netcdf_missing_value_real( this, val )

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Missing value
    real(kind=mflt), intent(in) :: val

    this%netcdf_missing_value_real = val

  end subroutine set_netcdf_missing_value_real

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

  !> Set the NetCDF fill value
  subroutine set_netcdf_fill_value_real( this, val )

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Fill value
    real(kind=mflt), intent(in) :: val

    this%netcdf_fill_value_real = val

  end subroutine set_netcdf_fill_value_real

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

  !> Update the property map
  !!
  !! Update the indices and names of a property map. This can be used to set
  !! the number, names and indices of properties that were not available
  !! when the arrays were registered.
  subroutine update_property_map( this, prop_names, prop_map )

    use monarch_util,                            only : assert, assert_msg

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Property names
    type(string_t), allocatable, intent(in) :: prop_names( : )
    !> Property indices in state array
    integer(kind=mint), allocatable, intent(in) :: prop_map( : )

    integer(kind=mint) :: i_prop

    call assert( 295110721, allocated( prop_names ) )
    call assert( 746289635, allocated( prop_map   ) )
    call assert_msg( 288393175, size( prop_names ) .eq. size( prop_map ),    &
                     "Received mismatched property map and name arrays." )

    this%num_props = size( prop_names )
    if( allocated( this%prop_name ) ) deallocate( this%prop_name )
    if( allocated( this%prop_map  ) ) deallocate( this%prop_map  )
    this%prop_name = prop_names
    allocate( this%prop_map( maxval( prop_map ) ) )
    this%prop_map( : ) = 0
    do i_prop = 1, size( prop_map )
      this%prop_map( prop_map( i_prop ) ) = i_prop
    end do

  end subroutine update_property_map

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

  !> Reset the array to the netCDF fill values
  subroutine reset_array( this, state_changer )

    use monarch_util,                            only : die_msg

    !> State array pointer
    class(monarch_state_array_ptr), intent(in) :: this
    !> State changer
    type(monarch_state_changer_t), intent(inout) :: state_changer

    if( this%is_owned ) then
      call state_changer%int_state%monarch_state_var( this%id                 &
                            )%reset_array( this%netcdf_fill_value_real )
    else
      call die_msg( 278097115, "Trying to reset an array that is not "//      &
                               "owned by the monarch_state_array_ptr" )
    end if

  end subroutine reset_array

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

  !> Output the array to a netcdf file
  subroutine output_to_netcdf( this, write_int_state, array_name,            &
      first_output )

    use module_WRITE_INTERNAL_STATE,        only : write_internal_state
    use monarch_util,                       only : assert, assert_msg,       &
                                                   die_msg, to_string
    use NETCDF,                             only : nf90_put_var


    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Write internal state
    type(write_internal_state), intent(in) :: write_int_state
    !> Name of array ready for output
    character(len=*), intent(in) :: array_name
    ! Flag indicating whether the NetCDF file needs redfined for this array
    logical, intent(in) :: first_output

    ! Array dimensions and indices
    integer(kind=mint) :: num_WE, num_SN, num_vert, dim3, dim4
    ! String sizes
    integer(kind=mint) :: arr_name_size, in_name_start, in_name_end
    ! NetCDF status indicator
    integer(kind=mint) :: netcdf_status

    ! Check if this array is flagged for output
    if( .not. this%to_hist_file ) return

    ! Arrays owned by a monarch_state_var_t are named
    ! 'MNRC~UNIQUE_NAME~_123_456_2D' where _123 and _456 are the 3rd and 4th
    ! dimensionsion indices, when present. Otherwise the names are as set
    ! elsewhere in the model with '_123_456_2D' at the end for 3 and 4
    ! dimensional arrays
    arr_name_size = len( array_name )
    if( index( array_name, '~' ) .gt. 0 ) then
      in_name_start = index( array_name, '~' ) + 1
      in_name_end   = index( array_name( in_name_start: ), '~' ) - 2 +       &
                    in_name_start
    else
      in_name_start = 1
      select case( this%type_id )
        case( VAR_TYPE_TRACERS_LIKE )
          in_name_end = arr_name_size - 11
        case default
          return
      end select
      if( in_name_end .lt. in_name_start ) return
    end if

    ! Get the dimensions of the grid
    ! (These are stored in 1D array for some reason)
    num_WE   = write_int_state%IM( 1 )
    num_SN   = write_int_state%JM( 1 )
    num_vert = write_int_state%LM( 1 )

    call assert( 749095811, in_name_end .gt. 0 )

    ! Check if the array being read in is this one
    if( this%unique_name%string .ne.                                         &
        array_name( in_name_start:in_name_end ) ) return

    ! Get the third and fourth dimension indices
    dim3 = 1
    dim4 = 1
    select case( this%type_id )
      case( VAR_TYPE_PER_COLUMN_REAL_ARRAY )
          call assert_msg( 650374629,                                        &
                     arr_name_size .eq. in_name_end + 8 .and.                &
                     array_name( arr_name_size-2:arr_name_size ) .eq. '_2D', &
                     "Malformed state array name: '"//array_name//"'" )
          read( array_name( in_name_end+3:in_name_end+5 ), '(I3)') dim3
      case( VAR_TYPE_PER_CELL_REAL )
          call assert_msg( 873558080,                                        &
                     arr_name_size .eq. in_name_end + 8 .and.                &
                     array_name( arr_name_size-2:arr_name_size ) .eq. '_2D', &
                     "Malformed state array name: '"//array_name//"'" )
          read( array_name( in_name_end+3:in_name_end+5 ), '(I3)') dim3
      case( VAR_TYPE_PER_CELL_REAL_ARRAY )
          call assert_msg( 363087368,                                        &
                     arr_name_size .eq. in_name_end + 12 .and.               &
                     array_name( arr_name_size-2:arr_name_size ) .eq. '_2D', &
                     "Malformed state array name: '"//array_name//"'" )
          read( array_name( in_name_end+3:in_name_end+5 ), '(I3)') dim4
          read( array_name( in_name_end+7:in_name_end+9 ), '(I3)') dim3
      case( VAR_TYPE_PER_VERT_INT_REAL )
          call assert_msg( 308817763,                                        &
                     arr_name_size .eq. in_name_end + 8 .and.                &
                     array_name( arr_name_size-2:arr_name_size ) .eq. '_2D', &
                     "Malformed state array name: '"//array_name//"'" )
          read( array_name( in_name_end+3:in_name_end+5 ), '(I3)') dim3
      case( VAR_TYPE_PER_VERT_INT_REAL_ARRAY )
          call assert_msg( 261507818,                                        &
                     arr_name_size .eq. in_name_end + 12 .and.               &
                     array_name( arr_name_size-2:arr_name_size ) .eq. '_2D', &
                     "Malformed state array name: '"//array_name//"'" )
          read( array_name( in_name_end+3:in_name_end+5 ), '(I3)') dim4
          read( array_name( in_name_end+7:in_name_end+9 ), '(I3)') dim3
      case( VAR_TYPE_TRACERS_LIKE )
          call assert_msg( 183745743,                                        &
                     arr_name_size .eq. in_name_end + 11 .and.               &
                     array_name( arr_name_size-2:arr_name_size ) .eq. '_2D', &
                     "Malformed state array name: '"//array_name//"'" )
          read( array_name( in_name_end+2:in_name_end+4 ), '(I3)') dim4
          read( array_name( in_name_end+6:in_name_end+8 ), '(I3)') dim3
    end select

    ! Check whether to output the variable meta data
    if( .not. this%is_netcdf_initialized )                                   &
      call this%first_output( write_int_state )

    select case( this%type_id )

      case( VAR_TYPE_PER_COLUMN_REAL )

        ! Output the data
        call this%check_nf90( nf90_put_var(                                  &
            write_int_state%IO_HST_UNIT,                                     & !<-- NetCDF file unit
            this%netcdf_var_id( 1 ),                                         & !<-- NetCDF variable id for this array
            write_int_state%OUTPUT_ARRAY_R2D,                                & !<-- The data
            start=(/ 1, 1, write_int_state%WRITE_TIMESTEP /),                & !<-- Starting indices FIXME Why start at 1?
            count=(/ num_WE, num_SN, 1 /) ) )                                  !<-- Array dimensions

      case( VAR_TYPE_PER_COLUMN_REAL_ARRAY )

        ! If there is a map to the underlying data, update dim3
        if( allocated( this%prop_map ) ) then
          if( dim3 .gt. size( this%prop_map ) ) return
          dim3 = this%prop_map( dim3 )
          if( dim3 .le. 0 ) return
        end if

        ! Output the data
        call this%check_nf90( nf90_put_var(                                  &
            write_int_state%IO_HST_UNIT,                                     & !<-- NetCDF file unit
            this%netcdf_var_id( 1 ),                                         & !<-- NetCDF variable id for this array
            write_int_state%OUTPUT_ARRAY_R2D,                                & !<-- The data
            start=(/ 1, 1, dim3, write_int_state%WRITE_TIMESTEP /),          & !<-- Starting indices FIXME Why start at 1?
            count=(/ num_WE, num_SN, 1, 1 /) ) )                               !<-- Array dimensions

      case( VAR_TYPE_PER_CELL_REAL )

        ! Output the data
        call this%check_nf90( nf90_put_var(                                  &
            write_int_state%IO_HST_UNIT,                                     & !<-- NetCDF file unit
            this%netcdf_var_id( 1 ),                                         & !<-- NetCDF variable id for this array
            write_int_state%OUTPUT_ARRAY_R2D,                                & !<-- The data
            start=(/ 1, 1, dim3, write_int_state%WRITE_TIMESTEP /),          & !<-- Starting indices FIXME Why start at 1?
            count=(/ num_WE, num_SN, 1, 1 /) ) )                               !<-- Array dimensions

      case( VAR_TYPE_PER_CELL_REAL_ARRAY )

        ! If there is a map to the underlying data, update dim4
        if( allocated( this%prop_map ) ) then
          if( dim4 .gt. size( this%prop_map ) ) return
          dim4 = this%prop_map( dim4 )
          if( dim4 .le. 0 ) return
        end if

        ! Output the data
        if( this%is_max_4D_output ) then
          call this%check_nf90( nf90_put_var(                                  &
              write_int_state%IO_HST_UNIT,                                     & !<-- NetCDF file unit
              this%netcdf_var_id( dim4 ),                                      & !<-- NetCDF variable id for this array
              write_int_state%OUTPUT_ARRAY_R2D,                                & !<-- The data
              start=(/ 1, 1, dim3, write_int_state%WRITE_TIMESTEP /),          & !<-- Starting indices FIXME Why start at 1?
              count=(/ num_WE, num_SN, 1, 1 /) ) )                               !<-- Array dimensions
        else
          call this%check_nf90( nf90_put_var(                                  &
              write_int_state%IO_HST_UNIT,                                     & !<-- NetCDF file unit
              this%netcdf_var_id( 1 ),                                         & !<-- NetCDF variable id for this array
              write_int_state%OUTPUT_ARRAY_R2D,                                & !<-- The data
              start=(/ 1, 1, dim3, dim4, write_int_state%WRITE_TIMESTEP /),    & !<-- Starting indices FIXME Why start at 1?
              count=(/ num_WE, num_SN, 1, 1, 1 /) ) )                            !<-- Array dimensions
        end if
      case( VAR_TYPE_PER_VERT_INT_REAL )

        ! Output the data
        call this%check_nf90( nf90_put_var(                                  &
            write_int_state%IO_HST_UNIT,                                     & !<-- NetCDF file unit
            this%netcdf_var_id( 1 ),                                         & !<-- NetCDF variable id for this array
            write_int_state%OUTPUT_ARRAY_R2D,                                & !<-- The data
            start=(/ 1, 1, dim3, write_int_state%WRITE_TIMESTEP /),          & !<-- Starting indices FIXME Why start at 1?
            count=(/ num_WE, num_SN, 1, 1 /) ) )                               !<-- Array dimensions

      case( VAR_TYPE_PER_VERT_INT_REAL_ARRAY )

        ! If there is a map to the underlying data, update dim4
        if( allocated( this%prop_map ) ) then
          if( dim4 .gt. size( this%prop_map ) ) return
          dim4 = this%prop_map( dim4 )
          if( dim4 .le. 0 ) return
        end if

        ! Output the data
        if( this%is_max_4D_output ) then
          call this%check_nf90( nf90_put_var(                                &
              write_int_state%IO_HST_UNIT,                                   & !<-- NetCDF file unit
              this%netcdf_var_id( dim4 ),                                    & !<-- NetCDF variable id for this array
              write_int_state%OUTPUT_ARRAY_R2D,                              & !<-- The data
              start=(/ 1, 1, dim3, write_int_state%WRITE_TIMESTEP /),        & !<-- Starting indices FIXME Why start at 1?
              count=(/ num_WE, num_SN, 1, 1 /) ) )                             !<-- Array dimensions
        else
          call this%check_nf90( nf90_put_var(                                &
              write_int_state%IO_HST_UNIT,                                   & !<-- NetCDF file unit
              this%netcdf_var_id( 1 ),                                       & !<-- NetCDF variable id for this array
              write_int_state%OUTPUT_ARRAY_R2D,                              & !<-- The data
              start=(/ 1, 1, dim3, dim4, write_int_state%WRITE_TIMESTEP /),  & !<-- Starting indices FIXME Why start at 1?
              count=(/ num_WE, num_SN, 1, 1, 1 /) ) )                          !<-- Array dimensions
        end if
      case( VAR_TYPE_TRACERS_LIKE )

        ! If there is a map to the underlying data, update dim4
        if( allocated( this%prop_map ) ) then
          if( dim4 .gt. size( this%prop_map ) ) return
          dim4 = this%prop_map( dim4 )
          if( dim4 .le. 0 ) return
        end if

        ! Output the data
        if( this%is_max_4D_output ) then
          call this%check_nf90( nf90_put_var(                                &
              write_int_state%IO_HST_UNIT,                                   & !<-- NetCDF file unit
              this%netcdf_var_id( dim4 ),                                    & !<-- NetCDF variable id for this array
              write_int_state%OUTPUT_ARRAY_R2D,                              & !<-- The data
              start=(/ 1, 1, dim3, write_int_state%WRITE_TIMESTEP /),        & !<-- Starting indices FIXME Why start at 1?
              count=(/ num_WE, num_SN, 1, 1 /) ) )                             !<-- Array dimensions
        else
          call this%check_nf90( nf90_put_var(                                &
              write_int_state%IO_HST_UNIT,                                   & !<-- NetCDF file unit
              this%netcdf_var_id( 1 ),                                       & !<-- NetCDF variable id for this array
              write_int_state%OUTPUT_ARRAY_R2D,                              & !<-- The data
              start=(/ 1, 1, dim3, dim4, write_int_state%WRITE_TIMESTEP /),  & !<-- Starting indices FIXME Why start at 1?
              count=(/ num_WE, num_SN, 1, 1, 1 /) ) )                          !<-- Array dimensions
        end if
      case default
        call die_msg( 826623123, "Invalid array type: "//                    &
                      to_string( this%type_id ) )
    end select

  end subroutine output_to_netcdf

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

  !> Set up a netcdf for this array and get the var id
  subroutine first_output( this, write_int_state )

    use module_WRITE_INTERNAL_STATE,        only : write_internal_state
    use module_WRITE_ROUTINES,              only : NETCDF_LABEL_MAX_LENGTH
    use monarch_util,                       only : die_msg, to_string
    use NETCDF,                             only : nf90_def_dim,             &
                                                   nf90_redef,               &
                                                   nf90_def_var,             &
                                                   nf90_put_att,             &
                                                   nf90_put_var,             &
                                                   nf90_enddef,              &
                                                   NF90_FLOAT, NF90_CHAR

    !> State array pointer
    class(monarch_state_array_ptr), intent(inout) :: this
    !> Write internal state
    type(write_internal_state), intent(in) :: write_int_state

    integer(kind=mint) :: netcdf_status, f_unit, i_prop, i_var
    integer(kind=mint) :: dim_id_WE, dim_id_SN, dim_id_vert, dim_id_vert_int,&
                          dim_id_time, dim_id_props, var_id_props,           &
                          dim_id_label
    character(len=:), allocatable :: dim_name, var_name
    character(len=NETCDF_LABEL_MAX_LENGTH) :: dim_label

    ! Get NetCDF ids
    f_unit           = write_int_state%IO_HST_UNIT
    dim_id_WE        = write_int_state%i_dimid      !<-- WE coordinate dimesion
    dim_id_SN        = write_int_state%j_dimid      !<-- SN coordinate dimension
    dim_id_vert      = write_int_state%lm_dimid     !<-- Vertical coordinate dimension
    dim_id_vert_int  = write_int_state%lmp_dimid    !<-- Vertical interface coordinate dimension
    dim_id_time      = write_int_state%time_dimid   !<-- Time dimension
    dim_id_label     = write_int_state%label_dimid  !<-- Label size dimension

    ! Define NetCDF properties
    call this%check_nf90( nf90_redef( f_unit ) )

    ! Define a dimension for array properties
    if( allocated( this%prop_name ) ) then
      dim_name = this%netcdf_short_name%string//"_dim"
      call this%check_nf90( nf90_def_dim( f_unit, dim_name, this%num_props,  &
                                    dim_id_props ) )
      call this%check_nf90( nf90_def_var( f_unit, dim_name, NF90_CHAR,       &
                                    (/ dim_id_label, dim_id_props /),        &
                                    var_id_props ) )

      ! Add dimension labels
      do i_prop = 1, this%num_props
        dim_label = this%prop_name( i_prop )%string
        call this%check_nf90( nf90_put_var( f_unit, var_id_props,            &
                                 dim_label, start = (/ 1, i_prop /),         &
                                 count = (/ NETCDF_LABEL_MAX_LENGTH, 1 /) ) )
      end do
    end if
      
    ! Define the data variable
    select case( this%type_id )
      case( VAR_TYPE_PER_COLUMN_REAL )
        call this%check_nf90(                                                &
                 nf90_def_var( f_unit, this%netcdf_short_name%string,        &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_time /),      &
                               this%netcdf_var_id( 1 ) ) )
      case( VAR_TYPE_PER_COLUMN_REAL_ARRAY )
        call this%check_nf90(                                                &
                 nf90_def_var( f_unit, this%netcdf_short_name%string,        &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_props,        &
                                  dim_id_time /),                            &
                               this%netcdf_var_id( 1 ) ) )
      case( VAR_TYPE_PER_CELL_REAL )
        call this%check_nf90(                                                &
                 nf90_def_var( f_unit, this%netcdf_short_name%string,        &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert,         &
                                  dim_id_time /),                            &
                               this%netcdf_var_id( 1 ) ) )
      case( VAR_TYPE_PER_CELL_REAL_ARRAY )
        if( this%is_max_4D_output ) then
          do i_var = 1, size( this%netcdf_var_id )
            var_name = this%netcdf_short_name%string//"_"//                 &
                       this%prop_name( i_var )%string
            call this%check_nf90(                                            &
                 nf90_def_var( f_unit, var_name,                             &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert,         &
                                  dim_id_time /),                            &
                               this%netcdf_var_id( i_var ) ) )
          end do
        else
          call this%check_nf90(                                              &
                 nf90_def_var( f_unit, this%netcdf_short_name%string,        &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert,         &
                                  dim_id_props, dim_id_time /),              &
                               this%netcdf_var_id( 1 ) ) )
        end if
      case( VAR_TYPE_PER_VERT_INT_REAL )
        call this%check_nf90(                                                &
                 nf90_def_var( f_unit, this%netcdf_short_name%string,        &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert_int,     &
                                  dim_id_time /),                            &
                               this%netcdf_var_id( 1 ) ) )
      case( VAR_TYPE_PER_VERT_INT_REAL_ARRAY )
        if( this%is_max_4D_output ) then
          do i_var = 1, size( this%netcdf_var_id )
            var_name = this%netcdf_short_name%string//"_"//                 &
                       this%prop_name( i_var )%string
            call this%check_nf90(                                            &
                 nf90_def_var( f_unit, var_name,                             &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert_int,     &
                                  dim_id_time /),                            &
                               this%netcdf_var_id( i_var ) ) )
          end do
        else
          call this%check_nf90(                                              &
                 nf90_def_var( f_unit, this%netcdf_short_name%string,        &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert_int,     &
                                  dim_id_props, dim_id_time /),              &
                               this%netcdf_var_id( 1 ) ) )
        end if
      case( VAR_TYPE_TRACERS_LIKE )
        if( this%is_max_4D_output ) then
          do i_var = 1, size( this%netcdf_var_id )
            var_name = this%netcdf_short_name%string//"_"//                 &
                       this%prop_name( i_var )%string
            call this%check_nf90(                                            &
                 nf90_def_var( f_unit, var_name,                             &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert,         &
                                  dim_id_time /),                            &
                               this%netcdf_var_id( i_var ) ) )
          end do
        else
          call this%check_nf90(                                              &
                 nf90_def_var( f_unit, this%netcdf_short_name%string,        &
                               NF90_FLOAT,                                   &
                               (/ dim_id_WE, dim_id_SN, dim_id_vert,         &
                                  dim_id_props, dim_id_time /),              &
                               this%netcdf_var_id( 1 ) ) )
        end if
      case default
        call die_msg( 157977360, "Invalid array type: "//                    &
                      to_string( this%type_id ) )
    end select

    do i_var = 1, size( this%netcdf_var_id )
      if( size( this%netcdf_var_id ) .gt. 1 ) then
        var_name = this%netcdf_long_name%string//"_"//                      &
                       this%prop_name( i_var )%string
      else
        var_name = this%netcdf_long_name%string
      end if
      call this%check_nf90( nf90_put_att( f_unit,                            &
                       this%netcdf_var_id( i_var ),                          &
                       'long_name',     var_name     ) )
      call this%check_nf90( nf90_put_att( f_unit,                            &
                       this%netcdf_var_id( i_var ),                          &
                       'standard_name', this%netcdf_standard_name%string ) )
      call this%check_nf90( nf90_put_att( f_unit,                            &
                       this%netcdf_var_id( i_var ),                          &
                       'units',         this%netcdf_units%string         ) )
      call this%check_nf90( nf90_put_att( f_unit,                            &
                       this%netcdf_var_id( i_var ),                          &
                       'missing_value', this%netcdf_missing_value_real ) )
      call this%check_nf90( nf90_put_att( f_unit,                            &
                       this%netcdf_var_id( i_var ),                          &
                       '_FillValue',    this%netcdf_fill_value_real    ) )
      if( .not. write_int_state%GLOBAL_NC ) then
        call this%check_nf90( nf90_put_att( f_unit,                          &
                                           this%netcdf_var_id( i_var ),      &
                                           'coordinates', 'lon lat'       ) )
        call this%check_nf90( nf90_put_att( f_unit,                          &
                                            this%netcdf_var_id( i_var ),     &
                                            'grid_mapping', 'rotated_pole') )
      end if
    end do

    ! Leave NetCDF definition mode
    call this%check_nf90( nf90_enddef( f_unit ) )

    ! Flag the array as initialized in the netCDF file
    this%is_netcdf_initialized = .true.

  end subroutine first_output

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

  !> Determine the number of bytes required to pack the given object
  integer(kind=mint) recursive function pack_size( this, comm )
    use monarch_mpi,               only : mnrc_mpi_pack_size_integer,        &
                                          mnrc_mpi_pack_size_integer_array,  &
                                          mnrc_mpi_pack_size_string_t_array, &
                                          mnrc_mpi_pack_size_logical,        &
                                          mnrc_mpi_pack_size_string_t,       &
                                          mnrc_mpi_pack_size_float

    !> State array pointer
    class(monarch_state_array_ptr), intent(in) :: this
    !> MPI communicator
    integer(kind=mint), intent(in) :: comm

    pack_size =                                                              &
        mnrc_mpi_pack_size_integer( this%id                       , comm ) + &
        mnrc_mpi_pack_size_integer( this%vars_id                  , comm ) + &
        mnrc_mpi_pack_size_logical( this%is_owned                 , comm ) + &
        mnrc_mpi_pack_size_integer( this%type_id                  , comm ) + &
        mnrc_mpi_pack_size_integer( this%num_props                , comm ) + &
        mnrc_mpi_pack_size_integer_array( this%netcdf_var_id      , comm ) + &
        mnrc_mpi_pack_size_float(   this%netcdf_missing_value_real, comm ) + &
        mnrc_mpi_pack_size_float(   this%netcdf_fill_value_real   , comm ) + &
        mnrc_mpi_pack_size_logical( this%to_hist_file             , comm ) + &
        mnrc_mpi_pack_size_string_t(this%unique_name              , comm ) + &
        mnrc_mpi_pack_size_string_t(this%netcdf_short_name        , comm ) + &
        mnrc_mpi_pack_size_string_t(this%netcdf_long_name         , comm ) + &
        mnrc_mpi_pack_size_string_t(this%netcdf_units             , comm ) + &
        mnrc_mpi_pack_size_string_t(this%netcdf_standard_name     , comm ) + &
        mnrc_mpi_pack_size_logical( this%is_max_4D_output         , comm ) + &
        mnrc_mpi_pack_size_string_t_array( this%prop_name         , comm ) + &
        mnrc_mpi_pack_size_integer_array(  this%prop_map          , comm ) + &
        mnrc_mpi_pack_size_logical(      .true.                   , comm )
    if( associated( this%next_array ) ) then
      pack_size = pack_size + this%next_array%pack_size( comm )
    end if

  end function pack_size

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

  !> Pack the given object to the buffer, advancing position
  recursive 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_string_t_array, &
                                               mnrc_mpi_pack_logical,        &
                                               mnrc_mpi_pack_string_t,       &
                                               mnrc_mpi_pack_float
    use monarch_util,                   only : assert
#endif

    !> State array pointer
    class(monarch_state_array_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
    call mnrc_mpi_pack_integer( buffer, pos, this%id                  , comm )
    call mnrc_mpi_pack_integer( buffer, pos, this%vars_id             , comm )
    call mnrc_mpi_pack_logical( buffer, pos, this%is_owned            , comm )
    call mnrc_mpi_pack_integer( buffer, pos, this%type_id             , comm )
    call mnrc_mpi_pack_integer( buffer, pos, this%num_props           , comm )
    call mnrc_mpi_pack_integer_array( buffer, pos, this%netcdf_var_id , comm )
    call mnrc_mpi_pack_float(   buffer, pos, this%netcdf_missing_value_real, &
                                comm )
    call mnrc_mpi_pack_float(   buffer, pos, this%netcdf_fill_value_real,    &
                                comm )
    call mnrc_mpi_pack_logical( buffer, pos, this%to_hist_file        , comm )
    call mnrc_mpi_pack_string_t(buffer, pos, this%unique_name         , comm )
    call mnrc_mpi_pack_string_t(buffer, pos, this%netcdf_short_name   , comm )
    call mnrc_mpi_pack_string_t(buffer, pos, this%netcdf_long_name    , comm )
    call mnrc_mpi_pack_string_t(buffer, pos, this%netcdf_units        , comm )
    call mnrc_mpi_pack_string_t(buffer, pos, this%netcdf_standard_name, comm )
    call mnrc_mpi_pack_logical( buffer, pos, this%is_max_4D_output    , comm )
    call mnrc_mpi_pack_string_t_array( buffer, pos, this%prop_name    , comm )
    call mnrc_mpi_pack_integer_array(  buffer, pos, this%prop_map     , comm )
    if( associated( this%next_array ) ) then
      call mnrc_mpi_pack_logical( buffer, pos, .true., comm )
      call this%next_array%bin_pack( buffer, pos, comm )
    else
      call mnrc_mpi_pack_logical( buffer, pos, .false., comm )
    end if
    call assert( 856286682, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_pack

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

  !> Unpack the given object from the buffer, advancing position
  recursive 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_string_t_array, &
                                             mnrc_mpi_unpack_logical,        &
                                             mnrc_mpi_unpack_string_t,       &
                                             mnrc_mpi_unpack_float
    use monarch_util,                 only : assert
#endif

    !> State array pointer
    class(monarch_state_array_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

#ifdef MONARCH_USE_MPI
    integer(kind=mint) :: prev_position
    logical :: has_next

    prev_position = pos
    call mnrc_mpi_unpack_integer( buffer, pos, this%id                , comm )
    call mnrc_mpi_unpack_integer( buffer, pos, this%vars_id           , comm )
    call mnrc_mpi_unpack_logical( buffer, pos, this%is_owned          , comm )
    call mnrc_mpi_unpack_integer( buffer, pos, this%type_id           , comm )
    call mnrc_mpi_unpack_integer( buffer, pos, this%num_props         , comm )
    call mnrc_mpi_unpack_integer_array( buffer, pos, this%netcdf_var_id,     &
                                  comm )
    call mnrc_mpi_unpack_float(   buffer, pos,                               &
                                  this%netcdf_missing_value_real, comm)
    call mnrc_mpi_unpack_float(   buffer, pos, this%netcdf_fill_value_real,  &
                                  comm )
    call mnrc_mpi_unpack_logical( buffer, pos, this%to_hist_file      , comm )
    call mnrc_mpi_unpack_string_t(buffer, pos, this%unique_name       , comm )
    call mnrc_mpi_unpack_string_t(buffer, pos, this%netcdf_short_name , comm )
    call mnrc_mpi_unpack_string_t(buffer, pos, this%netcdf_long_name  , comm )
    call mnrc_mpi_unpack_string_t(buffer, pos, this%netcdf_units      , comm )
    call mnrc_mpi_unpack_string_t(buffer, pos, this%netcdf_standard_name,    &
                                  comm )
    call mnrc_mpi_unpack_logical( buffer, pos, this%is_max_4D_output  , comm )
    call mnrc_mpi_unpack_string_t_array( buffer, pos, this%prop_name  , comm )
    call mnrc_mpi_unpack_integer_array(  buffer, pos, this%prop_map   , comm )
    call mnrc_mpi_unpack_logical( buffer, pos, has_next               , comm )
    if( has_next ) then
      allocate( this%next_array )
      call this%next_array%bin_unpack( buffer, pos, comm )
    end if
    call assert( 157411962, &
         pos - prev_position <= this%pack_size( comm ) )
#endif

  end subroutine bin_unpack

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

  !> Check the status of a NetCDF operation
  subroutine check_nf90_state_array( this, netcdf_status )

    use monarch_util,                       only : die_msg
    use NETCDF,                             only : nf90_strerror, NF90_NOERR

    !> State array pointer
    class(monarch_state_array_ptr), intent(in) :: this
    !> NetCDF status code
    integer(kind=mint), intent(in) :: netcdf_status

    if( netcdf_status .ne. NF90_NOERR ) then
      call die_msg( 842512415, "NetCDF error for state array: '"//           &
                    this%unique_name%string//"': "//                         &
                    trim( nf90_strerror( netcdf_status ) ) )
    end if

  end subroutine check_nf90_state_array

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

  !> Check the status of a NetCDF operation
  subroutine check_nf90_state_changer( this, netcdf_status )

    use monarch_util,                       only : die_msg
    use NETCDF,                             only : nf90_strerror, NF90_NOERR

    !> State changer
    class(monarch_state_changer_t), intent(in) :: this
    !> NetCDF status code
    integer(kind=mint), intent(in) :: netcdf_status

    if( netcdf_status .ne. NF90_NOERR ) then
      call die_msg( 493271504, "NetCDF error: "//                            &
                    trim( nf90_strerror( netcdf_status ) ) )
    end if

  end subroutine check_nf90_state_changer

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

end module monarch_state_changer
