Commit 569fbac8 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Add Fortran interface for configuration object.

parent de802f5d
......@@ -35,6 +35,7 @@
if FC_MOD_UPPERCASE
##UPPERCASE_MODULE_NAME_MARKER do not remove##
XT_CONFIG_F_MOD_NAME=XT_CONFIG_F
XT_SORT_MOD_NAME=XT_SORT
XT_REDIST_INT_I2_MOD_NAME=XT_REDIST_INT_I2
XT_REDIST_INT_I4_MOD_NAME=XT_REDIST_INT_I4
......@@ -57,6 +58,7 @@ XT_UT_MOD_NAME=XT_UT
YAXT_MOD_NAME=YAXT
else
##LOWERCASE_MODULE_NAME_MARKER do not remove##
XT_CONFIG_F_MOD_NAME=xt_config_f
XT_SORT_MOD_NAME=xt_sort
XT_REDIST_INT_I2_MOD_NAME=xt_redist_int_i2
XT_REDIST_INT_I4_MOD_NAME=xt_redist_int_i4
......@@ -139,10 +141,14 @@ $(XT_REDIST_INT_I2_MOD_NAME).$(FCMODEXT): ../../src/$(XT_REDIST_INT_I2_MOD_NAME)
$(XT_SORT_MOD_NAME).$(FCMODEXT): ../../src/$(XT_SORT_MOD_NAME).$(FCMODEXT)
$(AM_V_GEN)$(LN_S) ../../src/$(XT_SORT_MOD_NAME).$(FCMODEXT) .
$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT): ../../src/$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT)
$(LN_S) ../../src/$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT) .
##MODULE_RECIPE_MARKER do not remove ##
##INCLUDE_HEADER_MARKER do not remove ##
include_HEADERS= \
$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT) \
$(XT_SORT_MOD_NAME).$(FCMODEXT) \
$(XT_REDIST_INT_I2_MOD_NAME).$(FCMODEXT) \
$(XT_REDIST_INT_I4_MOD_NAME).$(FCMODEXT) \
......
......@@ -160,6 +160,7 @@ libyaxt_la_SOURCES = \
xt_slice_c_loc.inc \
xt_mpi_f.f90 \
xt_core_f.f90 \
xt_config_f.f90 \
xt_sort_f.f90 \
xt_idxlist_f.f90 \
xt_idxvec_f.f90 \
......
!>
!! @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://doc.redmine.dkrz.de/yaxt/html/
!
! 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.
!
MODULE xt_config_f
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr
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
PUBLIC :: xt_config_new, xt_config_delete
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
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:
!
......@@ -55,6 +55,7 @@ MODULE yaxt
char, xt_finalize, xt_initialized, xt_finalized, xt_slice_c_loc, &
xt_pos_ext, OPERATOR(/=), OPERATOR(==), &
xt_set_abort_handler => set_abort_handler, xt_restore_default_abort_hndl
USE xt_config_f, ONLY: xt_config, xt_config_new, xt_config_delete
USE xt_sort, ONLY: xt_sort_int, xt_sort_index, xt_sort_idxpos, &
xt_sort_permutation
USE xt_idxlist_abstract, ONLY: &
......@@ -172,6 +173,8 @@ MODULE yaxt
xt_request_wait, xt_request_test, xt_redist_a_exchange1, &
xt_redist_a_exchange
PUBLIC :: xt_config, xt_config_new, xt_config_delete
INTERFACE OPERATOR(==)
MODULE PROCEDURE xt_bounds_eq
END INTERFACE OPERATOR(==)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment