diff --git a/extern/iso_c_fortran_bmi/src/bmi.f90 b/extern/iso_c_fortran_bmi/src/bmi.f90 index 86ef6bb02b..f5abf00228 100644 --- a/extern/iso_c_fortran_bmi/src/bmi.f90 +++ b/extern/iso_c_fortran_bmi/src/bmi.f90 @@ -296,65 +296,65 @@ function bmif_get_value_double(this, name, dest) result(bmi_status) integer :: bmi_status end function bmif_get_value_double -! ! ! Get a reference to the given integer variable. -! ! function bmif_get_value_ptr_int(this, name, dest_ptr) result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(in) :: this -! ! character(len=*), intent(in) :: name -! ! integer, pointer, intent(inout) :: dest_ptr(:) -! ! integer :: bmi_status -! ! end function bmif_get_value_ptr_int -! ! -! ! ! Get a reference to the given real variable. -! ! function bmif_get_value_ptr_float(this, name, dest_ptr) result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(in) :: this -! ! character(len=*), intent(in) :: name -! ! real, pointer, intent(inout) :: dest_ptr(:) -! ! integer :: bmi_status -! ! end function bmif_get_value_ptr_float -! ! -! ! ! Get a reference to the given double variable. -! ! function bmif_get_value_ptr_double(this, name, dest_ptr) result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(in) :: this -! ! character(len=*), intent(in) :: name -! ! double precision, pointer, intent(inout) :: dest_ptr(:) -! ! integer :: bmi_status -! ! end function bmif_get_value_ptr_double -! ! -! ! ! Get integer values at particular (one-dimensional) indices. -! ! function bmif_get_value_at_indices_int(this, name, dest, inds) & -! ! result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(in) :: this -! ! character(len=*), intent(in) :: name -! ! integer, intent(inout) :: dest(:) -! ! integer, intent(in) :: inds(:) -! ! integer :: bmi_status -! ! end function bmif_get_value_at_indices_int -! ! -! ! ! Get real values at particular (one-dimensional) indices. -! ! function bmif_get_value_at_indices_float(this, name, dest, inds) & -! ! result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(in) :: this -! ! character(len=*), intent(in) :: name -! ! real, intent(inout) :: dest(:) -! ! integer, intent(in) :: inds(:) -! ! integer :: bmi_status -! ! end function bmif_get_value_at_indices_float -! ! -! ! ! Get double values at particular (one-dimensional) indices. -! ! function bmif_get_value_at_indices_double(this, name, dest, inds) & -! ! result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(in) :: this -! ! character(len=*), intent(in) :: name -! ! double precision, intent(inout) :: dest(:) -! ! integer, intent(in) :: inds(:) -! ! integer :: bmi_status -! ! end function bmif_get_value_at_indices_double + ! Get a reference to the given integer variable. + function bmif_get_value_ptr_int(this, name, dest_ptr) result(bmi_status) + import :: bmi + class(bmi), intent(in) :: this + character(len=*), intent(in) :: name + integer, pointer, intent(inout) :: dest_ptr(:) + integer :: bmi_status + end function bmif_get_value_ptr_int + + ! Get a reference to the given real variable. + function bmif_get_value_ptr_float(this, name, dest_ptr) result(bmi_status) + import :: bmi + class(bmi), intent(in) :: this + character(len=*), intent(in) :: name + real, pointer, intent(inout) :: dest_ptr(:) + integer :: bmi_status + end function bmif_get_value_ptr_float + + ! Get a reference to the given double variable. + function bmif_get_value_ptr_double(this, name, dest_ptr) result(bmi_status) + import :: bmi + class(bmi), intent(in) :: this + character(len=*), intent(in) :: name + double precision, pointer, intent(inout) :: dest_ptr(:) + integer :: bmi_status + end function bmif_get_value_ptr_double + + ! Get integer values at particular (one-dimensional) indices. + function bmif_get_value_at_indices_int(this, name, dest, inds) & + result(bmi_status) + import :: bmi + class(bmi), intent(in) :: this + character(len=*), intent(in) :: name + integer, intent(inout) :: dest(:) + integer, intent(in) :: inds(:) + integer :: bmi_status + end function bmif_get_value_at_indices_int + + ! Get real values at particular (one-dimensional) indices. + function bmif_get_value_at_indices_float(this, name, dest, inds) & + result(bmi_status) + import :: bmi + class(bmi), intent(in) :: this + character(len=*), intent(in) :: name + real, intent(inout) :: dest(:) + integer, intent(in) :: inds(:) + integer :: bmi_status + end function bmif_get_value_at_indices_float + + ! Get double values at particular (one-dimensional) indices. + function bmif_get_value_at_indices_double(this, name, dest, inds) & + result(bmi_status) + import :: bmi + class(bmi), intent(in) :: this + character(len=*), intent(in) :: name + double precision, intent(inout) :: dest(:) + integer, intent(in) :: inds(:) + integer :: bmi_status + end function bmif_get_value_at_indices_double ! Set new values for an integer model variable. function bmif_set_value_int(this, name, src) result(bmi_status) @@ -383,39 +383,39 @@ function bmif_set_value_double(this, name, src) result(bmi_status) integer :: bmi_status end function bmif_set_value_double -! ! ! Set integer values at particular (one-dimensional) indices. -! ! function bmif_set_value_at_indices_int(this, name, inds, src) & -! ! result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(inout) :: this -! ! character(len=*), intent(in) :: name -! ! integer, intent(in) :: inds(:) -! ! integer, intent(in) :: src(:) -! ! integer :: bmi_status -! ! end function bmif_set_value_at_indices_int -! ! -! ! ! Set real values at particular (one-dimensional) indices. -! ! function bmif_set_value_at_indices_float(this, name, inds, src) & -! ! result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(inout) :: this -! ! character(len=*), intent(in) :: name -! ! integer, intent(in) :: inds(:) -! ! real, intent(in) :: src(:) -! ! integer :: bmi_status -! ! end function bmif_set_value_at_indices_float -! ! -! ! ! Set double values at particular (one-dimensional) indices. -! ! function bmif_set_value_at_indices_double(this, name, inds, src) & -! ! result(bmi_status) -! ! import :: bmi -! ! class(bmi), intent(inout) :: this -! ! character(len=*), intent(in) :: name -! ! integer, intent(in) :: inds(:) -! ! double precision, intent(in) :: src(:) -! ! integer :: bmi_status -! ! end function bmif_set_value_at_indices_double -! ! + ! Set integer values at particular (one-dimensional) indices. + function bmif_set_value_at_indices_int(this, name, inds, src) & + result(bmi_status) + import :: bmi + class(bmi), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: inds(:) + integer, intent(in) :: src(:) + integer :: bmi_status + end function bmif_set_value_at_indices_int + + ! Set real values at particular (one-dimensional) indices. + function bmif_set_value_at_indices_float(this, name, inds, src) & + result(bmi_status) + import :: bmi + class(bmi), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: inds(:) + real, intent(in) :: src(:) + integer :: bmi_status + end function bmif_set_value_at_indices_float + + ! Set double values at particular (one-dimensional) indices. + function bmif_set_value_at_indices_double(this, name, inds, src) & + result(bmi_status) + import :: bmi + class(bmi), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: inds(:) + double precision, intent(in) :: src(:) + integer :: bmi_status + end function bmif_set_value_at_indices_double + ! Get number of dimensions of the computational grid. function bmif_get_grid_rank(this, grid, rank) result(bmi_status) import :: bmi diff --git a/extern/iso_c_fortran_bmi/src/iso_c_bmi.f90 b/extern/iso_c_fortran_bmi/src/iso_c_bmi.f90 index 9fc98439f9..9937a51e21 100644 --- a/extern/iso_c_fortran_bmi/src/iso_c_bmi.f90 +++ b/extern/iso_c_fortran_bmi/src/iso_c_bmi.f90 @@ -11,7 +11,7 @@ module iso_c_bmif_2_0 use bmif_2_0_iso - use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_f_pointer, c_char, c_null_char, c_int, c_double, c_float + use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_f_pointer, c_char, c_null_char, c_int, c_double, c_float, c_null_ptr implicit none type box @@ -440,6 +440,72 @@ function get_value_double(this, name, dest) result(bmi_status) bind(C, name="get deallocate(f_str) end function get_value_double + ! Get a reference to the given integer variable. + function get_value_ptr_int(this, name, dest_ptr) result(bmi_status) bind(C, name="get_value_ptr_int") + type(c_ptr) :: this + type(c_ptr) :: dest_ptr + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + integer(kind=c_int) :: bmi_status + + dest_ptr = c_null_ptr + bmi_status = BMI_FAILURE + end function get_value_ptr_int + + ! Get a reference to the given float variable. + function get_value_ptr_float(this, name, dest_ptr) result(bmi_status) bind(C, name="get_value_ptr_float") + type(c_ptr) :: this + type(c_ptr) :: dest_ptr + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + integer(kind=c_int) :: bmi_status + + dest_ptr = c_null_ptr + bmi_status = BMI_FAILURE + end function get_value_ptr_float + + ! Get a reference to the given double variable. + function get_value_ptr_double(this, name, dest_ptr) result(bmi_status) bind(C, name="get_value_ptr_double") + type(c_ptr) :: this + type(c_ptr) :: dest_ptr + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + integer(kind=c_int) :: bmi_status + + dest_ptr = c_null_ptr + bmi_status = BMI_FAILURE + end function get_value_ptr_double + + ! Get integer values at particular (one-dimensional) indices. + function get_value_at_indices_int(this, name, dest, inds) result(bmi_status) bind(C, name="get_value_at_indices_int") + type(c_ptr) :: this + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + integer(kind=c_int), intent(inout) :: dest(*) + integer(kind=c_int), intent(in) :: inds(*) + integer(kind=c_int) :: bmi_status + + bmi_status = BMI_FAILURE + end function get_value_at_indices_int + + ! Get real values at particular (one-dimensional) indices. + function get_value_at_indices_float(this, name, dest, inds) result(bmi_status) bind(C, name="get_value_at_indices_float") + type(c_ptr) :: this + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + real(kind=c_float), intent(inout) :: dest(*) + integer(kind=c_int), intent(in) :: inds(*) + integer(kind=c_int) :: bmi_status + + bmi_status = BMI_FAILURE + end function get_value_at_indices_float + + ! Get real values at particular (one-dimensional) indices. + function get_value_at_indices_double(this, name, dest, inds) result(bmi_status) bind(C, name="get_value_at_indices_double") + type(c_ptr) :: this + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + real(kind=c_double), intent(inout) :: dest(*) + integer(kind=c_int), intent(in) :: inds(*) + integer(kind=c_int) :: bmi_status + + bmi_status = BMI_FAILURE + end function get_value_at_indices_double + ! Set new values for an integer model variable. function set_value_int(this, name, src) result(bmi_status) bind(C, name="set_value_int") type(c_ptr) :: this @@ -505,6 +571,39 @@ function set_value_double(this, name, src) result(bmi_status) bind(C, name="set_ deallocate(f_str) end function set_value_double + ! Set integer values at particular (one-dimensional) indices. + function set_value_at_indices_int(this, name, inds, src) result(bmi_status) bind(C, name="set_value_at_indices_int") + type(c_ptr) :: this + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + integer(kind=c_int), intent(in) :: inds(*) + integer(kind=c_int), intent(in) :: src(*) + integer(kind=c_int) :: bmi_status + + bmi_status = BMI_FAILURE + end function set_value_at_indices_int + + ! Set real values at particular (one-dimensional) indices. + function set_value_at_indices_float(this, name, inds, src) result(bmi_status) bind(C, name="set_value_at_indices_float") + type(c_ptr) :: this + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + integer(kind=c_int), intent(in) :: inds(*) + real(kind=c_float), intent(in) :: src(*) + integer(kind=c_int) :: bmi_status + + bmi_status = BMI_FAILURE + end function set_value_at_indices_float + + ! Set double values at particular (one-dimensional) indices. + function set_value_at_indices_double(this, name, inds, src) result(bmi_status) bind(C, name="set_value_at_indices_double") + type(c_ptr) :: this + character(kind=c_char, len=1), dimension(BMI_MAX_COMPONENT_NAME), intent(in) :: name + integer(kind=c_int), intent(in) :: inds(*) + real(kind=c_double), intent(in) :: src(*) + integer(kind=c_int) :: bmi_status + + bmi_status = BMI_FAILURE + end function set_value_at_indices_double + ! Get number of dimensions of the computational grid. function get_grid_rank(this, grid, rank) result(bmi_status) bind(C, name="get_grid_rank") type(c_ptr) :: this diff --git a/extern/iso_c_fortran_bmi/test/test_iso_c.c b/extern/iso_c_fortran_bmi/test/test_iso_c.c index a6658dbf71..7dcf7dec8e 100644 --- a/extern/iso_c_fortran_bmi/test/test_iso_c.c +++ b/extern/iso_c_fortran_bmi/test/test_iso_c.c @@ -26,9 +26,18 @@ extern get_time_step(void*, double *); extern get_value_int(void*, char*, int*); extern get_value_float(void*, char*, float*); extern get_value_double(void*, char*, double*); +extern get_value_ptr_int(void*, char*, int*); +extern get_value_ptr_float(void*, char*, float*); +extern get_value_ptr_double(void*, char*, double*); +extern get_value_at_indices_int(void*, char*, int*, int*); +extern get_value_at_indices_float(void*, char*, float*, int*); +extern get_value_at_indices_double(void*, char*, double*, int*); extern set_value_int(void*, char*, int*); extern set_value_float(void*, char*, float*); extern set_value_double(void*, char*, double*); +extern set_value_at_indices_int(void*, char*, int*, int*); +extern set_value_at_indices_float(void*, char*, int*, float*); +extern set_value_at_indices_double(void*, char*, int*, double*); extern get_grid_rank(void*, int*, int*); extern get_grid_size(void*, int*, int*); extern get_grid_type(void*, int*, char*); @@ -47,6 +56,7 @@ extern get_grid_face_nodes(void*, int*, int*); extern get_grid_nodes_per_face(void*, int*, int*); int BMI_SUCCESS = 0; +int BMI_FAILURE = 1; int BMI_MAX_VAR_NAME = 2048; void check_status(int* status, char* name){ @@ -60,6 +70,17 @@ void check_status(int* status, char* name){ } } +void check_failure(int* status, char* name) { + printf("%s: ", name); + if( *status == BMI_FAILURE ){ + printf("EXPECTED FAILURE\n"); + } + else { + printf("FAILURE TO FAIL\n"); + exit(-1); + } +} + int main(int argc, char** argv) { void** bmi_handle; @@ -204,6 +225,42 @@ int main(int argc, char** argv) printf("get_value_double INPUT_VAR_1: %f\n", value_d); check_status(&status, "get_value_double"); + value = -2; + int *value_ptr = &value; + status = get_value_ptr_int(&bmi_handle, "INPUT_VAR_3", value_ptr); + printf("get_value_ptr_int: %d\n", value_ptr); + check_failure(&status, "get_value_ptr_int"); + + value_f = -2.0; + float *value_ptr_f = &value_f; + status = get_value_ptr_float(&bmi_handle, "INPUT_VAR_2", value_ptr_f); + printf("get_value_ptr_float: %d\n", value_ptr_f); + check_failure(&status, "get_value_ptr_float"); + + value_d = 2.0; + double *value_ptr_d = &value_d; + status = get_value_ptr_double(&bmi_handle, "INPUT_VAR_1", value_ptr_d); + printf("get_value_ptr_double: %d\n", value_ptr_d); + check_failure(&status, "get_value_ptr_double"); + + value = -2; + int indices = 10; + status = get_value_at_indices_int(&bmi_handle, "INPUT_VAR_3", &value, &indices); + printf("get_value_at_indices_int: %d, %d\n", value, indices); + check_failure(&status, "get_value_at_indices_int"); + + value_f = -2.0; + indices = 20; + status = get_value_at_indices_float(&bmi_handle, "INPUT_VAR_2", &value_f, &indices); + printf("get_value_at_indices_float: %f, %d\n", value_f, indices); + check_failure(&status, "get_value_at_indices_float"); + + value_d = 2.0; + indices = 30; + status = get_value_at_indices_double(&bmi_handle, "INPUT_VAR_1", &value_d, &indices); + printf("get_value_at_indices_double: %f, %d\n", value_d, indices); + check_failure(&status, "get_value_at_indices_double"); + value = 2; status = set_value_int(&bmi_handle, "INPUT_VAR_3", &value); printf("set_value_int: %d\n", value); @@ -223,6 +280,24 @@ int main(int argc, char** argv) printf("set_value_double INPUT_VAR_1: %f\n", value_d); check_status(&status, "set_value_double"); + value = -2; + indices = 10; + status = set_value_at_indices_int(&bmi_handle, "INPUT_VAR_3", &indices, &value); + printf("set_value_at_indices_int: %d, %d\n", value, indices); + check_failure(&status, "set_value_at_indices_int"); + + value_f = -2.0; + indices = 20; + status = set_value_at_indices_float(&bmi_handle, "INPUT_VAR_2", &indices, &value_f); + printf("set_value_at_indices_float: %f, %d\n", value_f, indices); + check_failure(&status, "set_value_at_indices_float"); + + value_d = 2.0; + indices = 30; + status = set_value_at_indices_double(&bmi_handle, "INPUT_VAR_1", &indices, &value_d); + printf("set_value_at_indices_double: %f, %d\n", value_d, indices); + check_failure(&status, "set_value_at_indices_double"); + int rank = -2; grid = 0; status = get_grid_rank(&bmi_handle, &grid, &rank); @@ -324,4 +399,4 @@ int main(int argc, char** argv) check_status(&status, "finalize"); -} \ No newline at end of file +}