Add a geospatial extension

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)

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}
 )

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

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

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})

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