!>
!! @file xt_config_f.f90
!! @brief Fortran interface to yaxt configuration object
!!
!! @copyright Copyright  (C)  2020 Jörg Behrens <behrens@dkrz.de>
!!                                 Moritz Hanke <hanke@dkrz.de>
!!                                 Thomas Jahns <jahns@dkrz.de>
!!
!! @author Jörg Behrens <behrens@dkrz.de>
!!         Moritz Hanke <hanke@dkrz.de>
!!         Thomas Jahns <jahns@dkrz.de>
!!

!
! Keywords:
! Maintainer: Jörg Behrens <behrens@dkrz.de>
!             Moritz Hanke <hanke@dkrz.de>
!             Thomas Jahns <jahns@dkrz.de>
! URL: https://dkrz-sw.gitlab-pages.dkrz.de/yaxt/
!
! Redistribution and use in source and binary forms, with or without
! modification, are  permitted provided that the following conditions are
! met:
!
! Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
!
! Neither the name of the DKRZ GmbH nor the names of its contributors
! may be used to endorse or promote products derived from this software
! without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
#include "fc_feature_defs.inc"
MODULE xt_config_f
  USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_int, &
       c_char, c_null_char
  USE xt_core, ONLY: xt_abort
  USE xt_xmap_dist_dir_bucket_gen, ONLY: xt_xmdd_bucket_gen, &
       xt_xmdd_bucket_gen_c2f, xt_xmdd_bucket_gen_f2c
  IMPLICIT NONE
  PRIVATE
  ! note: this type must not be extended to contain any other
  ! components, its memory pattern has to match void * exactly, which
  ! it does because of C constraints
  TYPE, BIND(C), PUBLIC :: xt_config
#ifndef __G95__
    PRIVATE
#endif
    TYPE(c_ptr) :: cptr = c_null_ptr
  END TYPE xt_config

  INTERFACE
    ! this function must not be implemented in Fortran because
    ! PGI 11.x chokes on that
    FUNCTION xt_config_f2c(config) BIND(c, name='xt_config_f2c') RESULT(p)
      IMPORT :: c_ptr, xt_config
      IMPLICIT NONE
      TYPE(xt_config), INTENT(in) :: config
      TYPE(c_ptr) :: p
    END FUNCTION xt_config_f2c
  END INTERFACE

  PUBLIC :: xt_config_new, xt_config_delete
  PUBLIC :: xt_config_f2c
  PUBLIC :: xt_exchanger_id_by_name
  PUBLIC :: xt_config_get_exchange_method, xt_config_set_exchange_method
  INTEGER, PUBLIC, PARAMETER :: &
       xt_exchanger_irecv_send = 0, &
       xt_exchanger_irecv_isend = 1, &
       xt_exchanger_irecv_isend_packed = 2, &
       xt_exchanger_mix_isend_irecv = 3, &
       xt_exchanger_neigh_alltoall = 4, &
       xt_exchanger_irecv_isend_ddt_packed = 5
  PUBLIC :: xt_config_get_idxvec_autoconvert_size, &
       xt_config_set_idxvec_autoconvert_size
  PUBLIC :: xt_config_get_redist_mthread_mode, &
       xt_config_set_redist_mthread_mode
  PUBLIC :: xt_config_get_sort_algorithm_id, &
       xt_config_set_sort_algorithm_by_id
  PUBLIC :: xt_config_set_mem_saving, &
       xt_config_get_mem_saving
  INTEGER, PUBLIC, PARAMETER :: &
       xt_mt_none = 0, &
       xt_mt_openmp = 1
  INTEGER, PUBLIC, PARAMETER :: &
       xt_quicksort = 0, &
       xt_mergesort = 1

  INTEGER, PUBLIC, PARAMETER :: &
       xt_exch_send_standard = 0, &
       xt_exch_send_buffered = 1, &
       xt_exch_send_synchronous = 2
  PUBLIC :: xt_config_set_exchange_send_comm_mode, &
       xt_config_get_exchange_send_comm_mode
  PUBLIC :: xt_config_get_xmdd_bucket_gen, &
       xt_config_set_xmdd_bucket_gen

  PUBLIC :: xt_config_get_xmap_stripe_align, &
       xt_config_set_xmap_stripe_align

  PUBLIC :: xt_config_get_ddt_cache_limit, &
       xt_config_set_ddt_cache_limit
  INTEGER, PUBLIC, PARAMETER :: &
       xt_config_ddt_cache_none = 0, &
       xt_config_ddt_cache_unlimited = -1, &
       xt_config_ddt_cache_no_parse = -2, &
       xt_config_ddt_cache_no_match = -3, &
       xt_config_ddt_no_cache_no_parse = -4

  CHARACTER(len=*), PARAMETER :: filename = 'xt_config_f.f90'

CONTAINS

  FUNCTION xt_config_new() RESULT(config)
    TYPE(xt_config) :: config
    INTERFACE
      FUNCTION xt_config_new_c() RESULT(config) &
           BIND(c, name='xt_config_new')
        IMPORT :: c_ptr
        IMPLICIT NONE
        TYPE(c_ptr) :: config
      END FUNCTION xt_config_new_c
    END INTERFACE
    config%cptr = xt_config_new_c()
  END FUNCTION xt_config_new

  SUBROUTINE xt_config_delete(config)
    TYPE(xt_config), INTENT(in) :: config
    INTERFACE
      SUBROUTINE xt_config_delete_c(config) BIND(c, name='xt_config_delete')
        IMPORT :: c_ptr
        IMPLICIT NONE
        TYPE(c_ptr), VALUE, INTENT(in) :: config
      END SUBROUTINE xt_config_delete_c
    END INTERFACE
    CALL xt_config_delete_c(config%cptr)
  END SUBROUTINE xt_config_delete

  SUBROUTINE xt_config_set_exchange_method(config, method)
    TYPE(xt_config), INTENT(inout) :: config
    INTEGER, INTENT(in) :: method
    INTEGER(c_int) :: method_c
    INTERFACE
      SUBROUTINE xt_config_set_exchange_method_c(config, method) &
           BIND(c, name='xt_config_set_exchange_method')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: method
      END SUBROUTINE xt_config_set_exchange_method_c
    END INTERFACE
    method_c = INT(method, c_int)
    CALL xt_config_set_exchange_method_c(config%cptr, method_c)
  END SUBROUTINE xt_config_set_exchange_method

  FUNCTION xt_config_get_exchange_method(config) RESULT(method)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: method
    INTERFACE
      FUNCTION xt_config_get_exchange_method_c(config) RESULT(method) &
           BIND(c, name='xt_config_get_exchange_method')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: method
      END FUNCTION xt_config_get_exchange_method_c
    END INTERFACE
    method = INT(xt_config_get_exchange_method_c(config%cptr))
  END FUNCTION xt_config_get_exchange_method

  FUNCTION xt_exchanger_id_by_name(name) RESULT(exchanger_id)
    CHARACTER(len=*), INTENT(in) :: name
    INTEGER :: exchanger_id
    INTERFACE
      FUNCTION xt_exchanger_id_by_name_c(name) RESULT(exchanger_id) &
           BIND(c, name='xt_exchanger_id_by_name')
        IMPORT :: c_char, c_int
        CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
        INTEGER(c_int) :: exchanger_id
      END FUNCTION xt_exchanger_id_by_name_c
    END INTERFACE
    INTEGER(c_int) :: c_id
    CHARACTER(len=1) :: name_c(LEN(name)+1)
    INTEGER :: i, nlen
    nlen = LEN(name)
    DO i = 1, nlen
      name_c(i) = name(i:i)
    END DO
    name_c(nlen+1) = c_null_char
    c_id = xt_exchanger_id_by_name_c(name_c)
    exchanger_id = INT(c_id)
  END FUNCTION xt_exchanger_id_by_name

  FUNCTION xt_config_get_idxvec_autoconvert_size(config) RESULT(cnvsize)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: cnvsize
    INTERFACE
      FUNCTION xt_config_get_idxvec_autoconvert_size_c(config) RESULT(cnvsize) &
           BIND(c, name='xt_config_get_idxvec_autoconvert_size')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: cnvsize
      END FUNCTION xt_config_get_idxvec_autoconvert_size_c
    END INTERFACE
    cnvsize = INT(xt_config_get_idxvec_autoconvert_size_c(config%cptr))
  END FUNCTION xt_config_get_idxvec_autoconvert_size

  SUBROUTINE xt_config_set_idxvec_autoconvert_size(config, cnvsize)
    TYPE(xt_config), INTENT(inout) :: config
    INTEGER, INTENT(in) :: cnvsize
    INTEGER(c_int) :: cnvsize_c
    INTERFACE
      SUBROUTINE xt_config_set_idxvec_autoconvert_size_c(config, cnvsize) &
           BIND(c, name='xt_config_set_idxvec_autoconvert_size')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: cnvsize
      END SUBROUTINE xt_config_set_idxvec_autoconvert_size_c
    END INTERFACE
    IF (cnvsize > HUGE(1_c_int) .OR. cnvsize < 1) &
      CALL xt_abort("invalid conversion size", filename, __LINE__)

    cnvsize_c = INT(cnvsize, c_int)
    CALL xt_config_set_idxvec_autoconvert_size_c(config%cptr, cnvsize_c)
  END SUBROUTINE xt_config_set_idxvec_autoconvert_size

  FUNCTION xt_config_get_redist_mthread_mode(config) RESULT(mt_mode)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: mt_mode
    INTERFACE
      FUNCTION xt_config_get_redist_mthread_mode_c(config) RESULT(mt_mode) &
           BIND(c, name='xt_config_get_redist_mthread_mode')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: mt_mode
      END FUNCTION xt_config_get_redist_mthread_mode_c
    END INTERFACE
    mt_mode = INT(xt_config_get_redist_mthread_mode_c(config%cptr))
  END FUNCTION xt_config_get_redist_mthread_mode

  SUBROUTINE xt_config_set_redist_mthread_mode(config, mt_mode)
    TYPE(xt_config), INTENT(inout) :: config
    INTEGER, INTENT(in) :: mt_mode
    INTEGER(c_int) :: mt_mode_c
    INTERFACE
      SUBROUTINE xt_config_set_redist_mthread_mode_c(config, mt_mode) &
           BIND(c, name='xt_config_set_redist_mthread_mode')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: mt_mode
      END SUBROUTINE xt_config_set_redist_mthread_mode_c
    END INTERFACE
    IF (mt_mode > HUGE(1_c_int) .OR. mt_mode < 0) &
      CALL xt_abort("invalid multi-threading mode", filename, __LINE__)

    mt_mode_c = INT(mt_mode, c_int)
    CALL xt_config_set_redist_mthread_mode_c(config%cptr, mt_mode_c)
  END SUBROUTINE xt_config_set_redist_mthread_mode

  FUNCTION xt_config_get_sort_algorithm_id(config) RESULT(sort_algo)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: sort_algo
    INTERFACE
      FUNCTION xt_config_get_sort_algorithm_id_c(config) RESULT(sort_algo) &
           BIND(c, name='xt_config_get_sort_algorithm_id')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: sort_algo
      END FUNCTION xt_config_get_sort_algorithm_id_c
    END INTERFACE
    sort_algo = INT(xt_config_get_sort_algorithm_id_c(config%cptr))
  END FUNCTION xt_config_get_sort_algorithm_id

  SUBROUTINE xt_config_set_sort_algorithm_by_id(config, sort_algo)
    TYPE(xt_config), INTENT(inout) :: config
    INTEGER, INTENT(in) :: sort_algo
    INTEGER(c_int) :: sort_algo_c
    INTERFACE
      SUBROUTINE xt_config_set_sort_algorithm_by_id_c(config, sort_algo) &
           BIND(c, name='xt_config_set_sort_algorithm_by_id')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: sort_algo
      END SUBROUTINE xt_config_set_sort_algorithm_by_id_c
    END INTERFACE
    IF (sort_algo > HUGE(1_c_int) .OR. sort_algo < 0) &
      CALL xt_abort("invalid algorithm selection", filename, __LINE__)

    sort_algo_c = INT(sort_algo, c_int)
    CALL xt_config_set_sort_algorithm_by_id_c(config%cptr, sort_algo_c)
  END SUBROUTINE xt_config_set_sort_algorithm_by_id

  !>
  !! Set memory conservation PARAMETER.
  !!
  !! @param[in]   config configuration object to modify
  !! @param       memconserve switch on methods of memory saving
  !!              currently supported values: 0 and 1
  !!
  !! When set to 1, operations parameterized by config will
  !! aggressively try to trade memory savings for higher computational
  !! cost.
  !!
  !! Currently, by not sorting index lists used in xmap construction.
  !!
  !! When set to 0, use default trade-offs for space vs. time complexity.
  !!
  SUBROUTINE xt_config_set_mem_saving(config, memconserve)
    TYPE(xt_config), INTENT(inout) :: config
    INTEGER, INTENT(in) :: memconserve
    INTERFACE
      SUBROUTINE xt_config_set_mem_saving_c(config, memconserve) &
           BIND(c, name="xt_config_set_mem_saving")
        IMPORT :: c_ptr, c_int
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: memconserve
      END SUBROUTINE xt_config_set_mem_saving_c
    END INTERFACE
    INTEGER(c_int) :: memconserve_c
    memconserve_c = INT(memconserve, c_int)
    CALL xt_config_set_mem_saving_c(config%cptr, memconserve_c)
  END SUBROUTINE xt_config_set_mem_saving

  !> Get memory conservation parameter.
  !! @param[in]   config configuration object to query
  !! @return memory conservation parameter as described
  !! at \a xt_config_set_mem_saving
  FUNCTION xt_config_get_mem_saving(config) RESULT(memconserve)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: memconserve
    INTERFACE
      FUNCTION xt_config_get_mem_saving_c(config) &
           BIND(c, name="xt_config_get_mem_saving") RESULT(memconserve)
        IMPORT :: c_ptr, c_int
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: memconserve
      END FUNCTION xt_config_get_mem_saving_c
    END INTERFACE
    INTEGER(c_int) :: memconserve_c
    memconserve_c = xt_config_get_mem_saving_c(config%cptr)
    memconserve = INT(memconserve_c)
  END FUNCTION xt_config_get_mem_saving

  !>
  !! Query configured bucket generator
  FUNCTION xt_config_get_xmdd_bucket_gen(config) RESULT(gen)
    TYPE(xt_config), INTENT(in) :: config
    TYPE(xt_xmdd_bucket_gen) :: gen
    INTERFACE
      FUNCTION xt_config_get_xmdd_bucket_gen_c(config) &
           BIND(c, name='xt_config_get_xmdd_bucket_gen') RESULT(gen)
        IMPORT :: c_ptr
        TYPE(c_ptr), VALUE :: config
        TYPE(c_ptr) :: gen
      END FUNCTION xt_config_get_xmdd_bucket_gen_c
    END INTERFACE
    TYPE(c_ptr) :: gen_c
    gen_c = xt_config_get_xmdd_bucket_gen_c(config%cptr)
    gen = xt_xmdd_bucket_gen_c2f(gen_c)
  END FUNCTION xt_config_get_xmdd_bucket_gen

  !> Change generator for buckets in distributed directory
  !! The default is a generator that tiles the range of indices of all
  !! index lists involved in xmap creation in 1D fashion with stripes.
  SUBROUTINE xt_config_set_xmdd_bucket_gen(config, gen)
    TYPE(xt_config), INTENT(inout) :: config
    TYPE(xt_xmdd_bucket_gen), INTENT(in) :: gen
    INTERFACE
      SUBROUTINE xt_config_set_xmdd_bucket_gen_c(config, gen) &
           BIND(c, name='xt_config_set_xmdd_bucket_gen')
        IMPORT :: c_ptr
        TYPE(c_ptr), VALUE :: config, gen
      END SUBROUTINE xt_config_set_xmdd_bucket_gen_c
    END INTERFACE
    CALL xt_config_set_xmdd_bucket_gen_c(config%cptr, &
         xt_xmdd_bucket_gen_f2c(gen))
  END SUBROUTINE xt_config_set_xmdd_bucket_gen

  SUBROUTINE xt_config_set_xmap_stripe_align(config, preference)
    TYPE(xt_config), INTENT(inout) :: config
    INTEGER, INTENT(in) :: preference
    INTEGER(c_int) :: preference_c
    INTERFACE
      SUBROUTINE xt_config_set_xmap_stripe_align_c(config, preference) &
           BIND(c, name='xt_config_set_xmap_stripe_align')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: preference
      END SUBROUTINE xt_config_set_xmap_stripe_align_c
    END INTERFACE
    preference_c = INT(preference, c_int)
    CALL xt_config_set_xmap_stripe_align_c(config%cptr, preference_c)
  END SUBROUTINE xt_config_set_xmap_stripe_align

  FUNCTION xt_config_get_xmap_stripe_align(config) RESULT(preference)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: preference
    INTERFACE
      FUNCTION xt_config_get_xmap_stripe_align_c(config) RESULT(preference) &
           BIND(c, name='xt_config_get_xmap_stripe_align')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: preference
      END FUNCTION xt_config_get_xmap_stripe_align_c
    END INTERFACE
    preference = INT(xt_config_get_xmap_stripe_align_c(config%cptr))
  END FUNCTION xt_config_get_xmap_stripe_align

  SUBROUTINE xt_config_set_exchange_send_comm_mode(config, &
       exch_send_comm_mode)
    TYPE(xt_config), INTENT(inout) :: config
    INTEGER, INTENT(in) :: exch_send_comm_mode
    INTEGER(c_int) :: exch_send_comm_mode_c
    INTERFACE
      SUBROUTINE xt_config_set_exchange_send_comm_mode_c(config, &
           exch_send_comm_mode) &
           BIND(c, name='xt_config_set_exchange_send_comm_mode')
        IMPORT :: c_ptr, c_int
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: exch_send_comm_mode
      END SUBROUTINE xt_config_set_exchange_send_comm_mode_c
    END INTERFACE
    exch_send_comm_mode_c = INT(exch_send_comm_mode, c_int)
    CALL xt_config_set_exchange_send_comm_mode_c(config%cptr, &
         exch_send_comm_mode_c)
  END SUBROUTINE xt_config_set_exchange_send_comm_mode

  FUNCTION xt_config_get_exchange_send_comm_mode(config) RESULT(send_mode)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: send_mode
    INTERFACE
      FUNCTION xt_config_get_exchange_send_comm_mode_c(config) &
           RESULT(send_mode) &
           BIND(c, name='xt_config_get_exchange_send_comm_mode')
        IMPORT :: c_int, c_ptr
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: send_mode
      END FUNCTION xt_config_get_exchange_send_comm_mode_c
    END INTERFACE
    send_mode = INT(xt_config_get_exchange_send_comm_mode_c(config%cptr))
  END FUNCTION xt_config_get_exchange_send_comm_mode

  SUBROUTINE xt_config_set_ddt_cache_limit(config, limit)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER, INTENT(in) :: limit
    INTEGER(c_int) :: limit_c
    INTERFACE
      SUBROUTINE xt_config_set_ddt_cache_limit_c(config, limit) &
           BIND(c, name='xt_config_set_ddt_cache_limit')
        IMPORT :: c_ptr, c_int
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int), VALUE :: limit
      END SUBROUTINE xt_config_set_ddt_cache_limit_c
    END INTERFACE

    limit_c = INT(limit, c_int)
    CALL xt_config_set_ddt_cache_limit_c(config%cptr, limit_c)
  END SUBROUTINE xt_config_set_ddt_cache_limit

  FUNCTION xt_config_get_ddt_cache_limit(config) RESULT(limit)
    TYPE(xt_config), INTENT(in) :: config
    INTEGER :: limit
    INTEGER(c_int) :: limit_c
    INTERFACE
      FUNCTION xt_config_get_ddt_cache_limit_c(config) &
           BIND(c, name='xt_config_get_ddt_cache_limit') RESULT(limit)
        IMPORT :: c_ptr, c_int
        TYPE(c_ptr), VALUE :: config
        INTEGER(c_int) :: limit
      END FUNCTION xt_config_get_ddt_cache_limit_c
    END INTERFACE

    limit_c = xt_config_get_ddt_cache_limit_c(config%cptr)
    limit = INT(limit_c)
  END FUNCTION xt_config_get_ddt_cache_limit

END MODULE xt_config_f
!
! Local Variables:
! f90-continuation-indent: 5
! coding: utf-8
! indent-tabs-mode: nil
! show-trailing-whitespace: t
! require-trailing-newline: t
! End:
!
