diff --git a/CMakeLists.txt b/CMakeLists.txt index 0cffe4c..8b7f43d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -11,6 +11,7 @@ include(GNUInstallDirs) set(model_name heatf) set(bmi_name bmi${model_name}) +set(extension_name bmigeo${model_name}) # Determine the Fortran BMI version. if(DEFINED ENV{BMIF_VERSION}) @@ -25,12 +26,14 @@ message("-- BMIF module version - ${bmif_module_version}") set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/mod) # Locate the installed Fortran BMI bindings (bmif library and module file) -# through CMAKE_PREFIX_PATH. +# as well as bmi_geospatial extension through CMAKE_PREFIX_PATH. find_library(bmif_lib bmif) +find_library(bmigeof_lib bmigeof) find_path(bmif_inc bmif_${bmif_module_version}.mod) include_directories(${bmif_inc}) message("-- bmif_lib - ${bmif_lib}") message("-- bmif_inc - ${bmif_inc}") +message("-- bmigeof_lib - ${bmigeof_lib}") add_subdirectory(heat) add_subdirectory(bmi_heat) diff --git a/bmi_heat/CMakeLists.txt b/bmi_heat/CMakeLists.txt index 8f86d3b..93c2864 100644 --- a/bmi_heat/CMakeLists.txt +++ b/bmi_heat/CMakeLists.txt @@ -3,10 +3,13 @@ # Create shared library, except on Windows. if(WIN32) add_library(${bmi_name} bmi_heat.f90) + add_library(${extension_name} bmi_geo_heat.f90) else() add_library(${bmi_name} SHARED bmi_heat.f90) + add_library(${extension_name} SHARED bmi_geo_heat.f90) endif() target_link_libraries(${bmi_name} ${model_name} ${bmif_lib}) +target_link_libraries(${extension_name} ${bmi_name} ${bmigeof_lib}) add_executable(run_${bmi_name} bmi_main.f90) target_link_libraries(run_${bmi_name} ${bmi_name}) @@ -16,12 +19,14 @@ install( RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} ) install( - TARGETS ${bmi_name} + TARGETS ${bmi_name} ${extension_name} LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} ) install( - FILES ${CMAKE_Fortran_MODULE_DIRECTORY}/${bmi_name}.mod + FILES + ${CMAKE_Fortran_MODULE_DIRECTORY}/${bmi_name}.mod + ${CMAKE_Fortran_MODULE_DIRECTORY}/${extension_name}.mod DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} ) diff --git a/bmi_heat/bmi_geo_heat.f90 b/bmi_heat/bmi_geo_heat.f90 new file mode 100644 index 0000000..8686ba3 --- /dev/null +++ b/bmi_heat/bmi_geo_heat.f90 @@ -0,0 +1,96 @@ +! Implement the bmi_geo type and use the bmi_heat type in a new type, bmi_geo_heat + +module bmigeoheatf + + use bmigeof + use bmiheatf + use bmif_2_0 + implicit none + + type, extends (bmi_geo) :: bmi_geo_heat + type (bmi_heat) :: bmi_base + contains + procedure :: initialize => heat_initialize + procedure :: get_grid_coordinate_names => heat_grid_coordinate_names + procedure :: get_grid_coordinate_units => heat_grid_coordinate_units + procedure :: get_grid_coordinate => heat_grid_coordinate + procedure :: get_grid_crs => heat_grid_crs + end type bmi_geo_heat + + public bmi_geo_heat + +contains + + function heat_initialize(this, config_file) result (bmi_status) + class (bmi_geo_heat), intent(out) :: this + character (len=*), intent(in) :: config_file + integer :: bmi_status + + bmi_status = BMI_SUCCESS + end function heat_initialize + + function heat_grid_coordinate_names(this, grid, names) result (bmi_status) + class (bmi_geo_heat), intent(in) :: this + integer, intent(in) :: grid + character (*), pointer, intent(out) :: names(:) + integer :: bmi_status + + names(1) = "y" + names(2) = "x" + + bmi_status = BMI_SUCCESS + end function heat_grid_coordinate_names + + function heat_grid_coordinate_units(this, grid, units) result (bmi_status) + class (bmi_geo_heat), intent(in) :: this + integer, intent(in) :: grid + character (*), pointer, intent(out) :: units(:) + integer :: bmi_status + + units(1) = "m" + units(2) = "m" + + bmi_status = BMI_SUCCESS + end function heat_grid_coordinate_units + + function heat_grid_coordinate(this, grid, coordinate, values) result (bmi_status) + class (bmi_geo_heat), intent(in) :: this + integer, intent(in) :: grid + character(len=*), intent(in) :: coordinate + double precision, dimension(:), intent(out) :: values + double precision, allocatable :: origin(:), spacing(:) + integer :: bmi_status, rank, dim, i + + bmi_status = this%bmi_base%get_grid_rank(grid, rank) + + allocate(origin(rank), spacing(rank)) + bmi_status = this%bmi_base%get_grid_origin(grid, origin) + bmi_status = this%bmi_base%get_grid_spacing(grid, spacing) + + select case(coordinate) + case("y") + dim = 1 + case("x") + dim = 2 + end select + + do i = 1, size(values) + values(i) = dble(i - 1) * spacing(dim) + origin(dim) + end do + + deallocate(origin, spacing) + + bmi_status = BMI_SUCCESS + end function heat_grid_coordinate + + function heat_grid_crs(this, grid, crs) result (bmi_status) + class (bmi_geo_heat), intent(in) :: this + integer, intent(in) :: grid + character (len=*), intent(out) :: crs + integer :: bmi_status + + crs = "none" + bmi_status = BMI_SUCCESS + end function heat_grid_crs + +end module bmigeoheatf diff --git a/bmi_heat/bmi_heat.f90 b/bmi_heat/bmi_heat.f90 index 1e22091..462f2ad 100644 --- a/bmi_heat/bmi_heat.f90 +++ b/bmi_heat/bmi_heat.f90 @@ -9,6 +9,7 @@ module bmiheatf private type (heat_model) :: model contains + procedure :: get_extensions procedure :: get_component_name => heat_component_name procedure :: get_input_item_count => heat_input_item_count procedure :: get_output_item_count => heat_output_item_count @@ -98,8 +99,23 @@ module bmiheatf dimension(output_item_count) :: & output_items = (/'plate_surface__temperature'/) + ! Extensions + integer, parameter :: extension_count = 1 + character (len=BMI_MAX_VAR_NAME), target, & + dimension(extension_count) :: & + extension_strings = (/'bmi_geospatial@bmigeoheatf:bmi_geo_heat'/) + contains + function get_extensions(this, extensions) result (bmi_status) + class (bmi_heat), intent(in) :: this + character (*), pointer, intent(out) :: extensions(:) + integer :: bmi_status + + extensions => extension_strings + bmi_status = BMI_SUCCESS + end function get_extensions + ! Get the name of the model. function heat_component_name(this, name) result (bmi_status) class (bmi_heat), intent(in) :: this diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index c9fabb6..ba78e7a 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -15,3 +15,9 @@ make_example(get_value_ex) make_example(set_value_ex) make_example(conflicting_instances_ex) make_example(change_diffusivity_ex) + +# Extension example +set(extension_example bmi_geospatial_ex) +add_test(NAME ${extension_example} COMMAND ${extension_example} ${CMAKE_CURRENT_SOURCE_DIR}) +add_executable(${extension_example} ${extension_example}.f90 testing_helpers.f90) +target_link_libraries(${extension_example} ${extension_name}) diff --git a/example/bmi_geospatial_ex.f90 b/example/bmi_geospatial_ex.f90 new file mode 100644 index 0000000..3b08bc0 --- /dev/null +++ b/example/bmi_geospatial_ex.f90 @@ -0,0 +1,64 @@ +! An example of using a BMI extension +program bmi_geospatial_ex + + use bmif_2_0 + use bmiheatf + use bmigeoheatf + implicit none + + type(bmi_heat) :: h + type(bmi_geo_heat) :: g + integer :: status, grid_id, grid_rank, i + character (len=BMI_MAX_COMPONENT_NAME), pointer :: component_name + integer, allocatable :: grid_shape(:) + character (len=BMI_MAX_VAR_NAME), pointer :: names(:), units(:) + double precision, allocatable :: xcoordinate(:), ycoordinate(:) + character (len=BMI_MAX_VAR_NAME) :: crs + + status = h%get_component_name(component_name) + write (*,"(a, a30)") "Component name: ", component_name + + status = h%initialize("") + + status = h%get_var_grid("plate_surface__temperature", grid_id) + write (*,"(a, i3)") "Grid id:", grid_id + + status = h%get_grid_rank(grid_id, grid_rank) + write (*,"(a, i3)") "Grid rank:", grid_rank + + allocate(grid_shape(grid_rank)) + status = h%get_grid_shape(grid_id, grid_shape) + write (*,"(a, *(x, i3))") "Grid shape:", grid_shape + + g = bmi_geo_heat(h) + + allocate(names(grid_rank)) + status = g%get_grid_coordinate_names(grid_id, names) + write (*,"(a)") "Coordinate names:" + do i = 1, size(names) + write (*,"(a)") "- " // trim(names(i)) + end do + + allocate(units(grid_rank)) + status = g%get_grid_coordinate_units(grid_id, units) + write (*,"(a)") "Coordinate units:" + do i = 1, size(units) + write (*,"(a)") "- " // trim(units(i)) + end do + + allocate(ycoordinate(grid_shape(1))) + status = g%get_grid_coordinate(grid_id, names(1), ycoordinate) + write (*,"(a, *(x, f4.1))") "Y-coordinate:", ycoordinate + + allocate(xcoordinate(grid_shape(2))) + status = g%get_grid_coordinate(grid_id, names(2), xcoordinate) + write (*,"(a, *(x, f4.1))") "X-coordinate:", xcoordinate + + status = g%get_grid_crs(grid_id, crs) + write (*,"(a, a30)") "CRS: ", crs + + deallocate(grid_shape, names, units, ycoordinate, xcoordinate) + + status = h%finalize() + +end program bmi_geospatial_ex