wip: add readonly and output attrs to memory variables

Author: wpbonelli

src/Utilities/Memory/Memory.F90

@@ -25,6 +25,8 @@ module MemoryTypeModule
     integer(I4B) :: element_size = 0 !< byte size of an element; string length
     integer(I4B) :: set_handler_idx = 0 !< index of side effect handler for external access
     logical(LGP) :: master = .true. !< master copy, others point to this one
+    logical(LGP) :: readonly = .false. !< when true, API consumers may not write this variable
+    logical(LGP) :: output = .false. !< when true, this variable is user-facing simulation output
     character(len=:), pointer :: strsclr => null() !< pointer to the character string
     logical(LGP), pointer :: logicalsclr => null() !< pointer to the logical
     integer(I4B), pointer :: intsclr => null() !< pointer to the integer

src/Utilities/Memory/MemoryManager.f90

@@ -31,6 +31,7 @@ module MemoryManagerModule
   public :: mem_write_usage
   public :: mem_da
   public :: mem_set_print_option
+  public :: mem_set_attributes
   public :: get_from_memorystore
 
   public :: get_mem_type
@@ -328,6 +329,27 @@ subroutine get_from_memorystore(name, mem_path, mt, found, check)
     end if
   end subroutine get_from_memorystore
 
+  !> @brief Set the readonly and/or output attributes on an existing memory entry
+  !!
+  !! Mutates attributes on an already-allocated MemoryType entry, looked up by name and
+  !! memory path. Omitted attributes are left unchanged. Intended to be called once, after
+  !! a variable has been allocated, to annotate it per the DFN memory catalog; it does not
+  !! itself allocate anything.
+  !<
+  subroutine mem_set_attributes(name, mem_path, readonly, output)
+    character(len=*), intent(in) :: name !< variable name
+    character(len=*), intent(in) :: mem_path !< path where the variable is stored
+    logical(LGP), intent(in), optional :: readonly !< when true, mark the variable read-only
+    logical(LGP), intent(in), optional :: output !< when true, mark the variable as output
+    ! -- local
+    type(MemoryType), pointer :: mt => null()
+    logical(LGP) :: found
+    ! -- code
+    call get_from_memorystore(name, mem_path, mt, found)
+    if (present(readonly)) mt%readonly = readonly
+    if (present(output)) mt%output = output
+  end subroutine mem_set_attributes
+
   !> @brief Issue allocation error message and stop program execution
   !<
   subroutine allocate_error(varname, mem_path, istat, isize)

srcbmi/mf6bmi.f90

@@ -27,7 +27,7 @@ module mf6bmi
   use CharacterStringModule
   use MemoryManagerModule, only: mem_setptr, get_mem_elem_size, get_isize, &
                                  get_mem_rank, get_mem_shape, get_mem_type, &
-                                 memorystore
+                                 get_from_memorystore, memorystore
   use MemoryContainerIteratorModule, only: MemoryContainerIteratorType
   use MemoryTypeModule, only: MemoryType
   use MemoryHelperModule, only: create_mem_address
@@ -199,42 +199,63 @@ end function get_time_step
 
   !> @brief Get the number of input variables in the simulation
   !!
-  !! This concerns all variables stored in the memory manager
+  !! Counts variables stored in the memory manager that are not marked
+  !! read-only, i.e. those an API consumer may write.
   !<
   function get_input_item_count(count) result(bmi_status) &
     bind(C, name="get_input_item_count")
     !DIR$ ATTRIBUTES DLLEXPORT :: get_input_item_count
     ! -- dummy variables
     integer(kind=c_int), intent(out) :: count !< the number of input variables
     integer(kind=c_int) :: bmi_status !< BMI status code
+    ! -- local variables
+    type(MemoryContainerIteratorType), allocatable :: itr
+    type(MemoryType), pointer :: mt => null()
 
-    count = memorystore%count()
+    count = 0
+    itr = memorystore%iterator()
+    do while (itr%has_next())
+      call itr%next()
+      mt => itr%value()
+      if (.not. mt%readonly) count = count + 1
+    end do
 
     bmi_status = BMI_SUCCESS
 
   end function get_input_item_count
 
   !> @brief Get the number of output variables in the simulation
   !!
-  !! This concerns all variables stored in the memory manager
+  !! Counts variables stored in the memory manager that are marked
+  !! as output.
   !<
   function get_output_item_count(count) result(bmi_status) &
     bind(C, name="get_output_item_count")
     !DIR$ ATTRIBUTES DLLEXPORT :: get_output_item_count
     ! -- dummy variables
     integer(kind=c_int), intent(out) :: count !< the number of output variables
     integer(kind=c_int) :: bmi_status !< BMI status code
+    ! -- local variables
+    type(MemoryContainerIteratorType), allocatable :: itr
+    type(MemoryType), pointer :: mt => null()
 
-    count = memorystore%count()
+    count = 0
+    itr = memorystore%iterator()
+    do while (itr%has_next())
+      call itr%next()
+      mt => itr%value()
+      if (mt%output) count = count + 1
+    end do
 
     bmi_status = BMI_SUCCESS
 
   end function get_output_item_count
 
   !> @brief Returns all input variables in the simulation
   !!
-  !! This functions returns the full address for all variables in the
-  !! memory manager
+  !! This function returns the full address for every variable in the
+  !! memory manager that is not marked read-only, i.e. those an API
+  !! consumer may write.
   !!
   !! The array @p c_names should be pre-allocated of proper size:
   !!
@@ -262,6 +283,7 @@ function get_input_var_names(c_names) result(bmi_status) &
     do while (itr%has_next())
       call itr%next()
       mt => itr%value()
+      if (mt%readonly) cycle
       var_address = create_mem_address(mt%path, mt%name)
       do i = 1, len(trim(var_address))
         c_names(start + i - 1) = var_address(i:i)
@@ -276,9 +298,9 @@ end function get_input_var_names
 
   !> @brief Returns all output variables in the simulation
   !!
-  !! This function works analogously to get_input_var_names(),
-  !! and currently returns the same set of memory variables,
-  !! which is all of them!
+  !! This function works analogously to get_input_var_names(), but returns
+  !! the full address for every variable in the memory manager that is
+  !! marked as output.
   !<
   function get_output_var_names(c_names) result(bmi_status) &
     bind(C, name="get_output_var_names")
@@ -297,6 +319,7 @@ function get_output_var_names(c_names) result(bmi_status) &
     do while (itr%has_next())
       call itr%next()
       mt => itr%value()
+      if (.not. mt%output) cycle
       var_address = create_mem_address(mt%path, mt%name)
       do i = 1, len(trim(var_address))
         c_names(start + i - 1) = var_address(i:i)
@@ -913,6 +936,8 @@ function set_value(c_var_address, c_arr_ptr) result(bmi_status) &
     character(len=LENMEMTYPE) :: mem_type
     character(len=LENVARNAME) :: var_name
     logical(LGP) :: valid
+    logical(LGP) :: found
+    type(MemoryType), pointer :: mt => null()
 
     bmi_status = BMI_SUCCESS
 
@@ -922,6 +947,16 @@ function set_value(c_var_address, c_arr_ptr) result(bmi_status) &
       return
     end if
 
+    call get_from_memorystore(var_name, mem_path, mt, found, check=.false.)
+    if (found) then
+      if (mt%readonly) then
+        write (bmi_last_error, fmt_readonly_var) trim(var_name)
+        call report_bmi_error(bmi_last_error)
+        bmi_status = BMI_FAILURE
+        return
+      end if
+    end if
+
     call get_mem_type(var_name, mem_path, mem_type)
 
     if (index(mem_type, "DOUBLE") /= 0) then

srcbmi/mf6bmiError.f90

@@ -34,6 +34,8 @@ module mf6bmiError
   character(len=*), parameter :: fmt_invalid_mem_access = & !< Invalid memory access, args: variable name
                                  "('Fatal BMI Error, invalid access of memory &
                                  &for variable: ', a)"
+  character(len=*), parameter :: fmt_readonly_var = & !< Write to read-only variable, args: variable name
+                                 "('BMI Error, variable is read-only: ', a)"
   character(len=*), parameter :: fmt_fail_cvg_sol = & !< Solution failed to converge, args: detail
                                  "('BMI Error, Numerical Solution ', i3, &
                                  &' failed to converge')"