MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
MemorySetHandler.f90
Go to the documentation of this file.
2  use kindmodule, only: i4b, lgp
3  use listmodule, only: listtype
7 
8  implicit none
9  private
10 
11  public :: set_handler_iface
12  public :: mem_register_handler
13  public :: on_memory_set
14 
16  procedure(set_handler_iface), nopass, pointer :: handler => null()
17  class(*), pointer :: handlercontext => null()
18  end type
19 
21 
22  abstract interface
23  subroutine set_handler_iface(owner, status)
24  import i4b
25  class(*), pointer, intent(inout) :: owner
26  integer(I4B), intent(out) :: status
27  end subroutine
28  end interface
29 
30 contains
31 
32  !> @brief Register the event handler and context for this variable
33  !!
34  !! The event handler and its ctx are called whenever the trigger
35  !! is given by calling @p on_set_memory(). This allows to handle
36  !! side effects, e.g. when a variable is from outside a class
37  !! (the context) such as happens with the BMI.
38  !<
39  subroutine mem_register_handler(var_name, mem_path, handler, ctx)
40  character(len=*), intent(in) :: var_name !< the variable name
41  character(len=*), intent(in) :: mem_path !< the memory path
42  procedure(set_handler_iface), pointer :: handler !< called after memory is set
43  class(*), pointer :: ctx !< the context with which the handler should be called
44  ! local
45  integer(I4B) :: handler_idx
46  class(eventhandlerdatatype), pointer :: handler_data => null()
47  class(*), pointer :: handler_data_genptr
48  type(memorytype), pointer :: mt
49  logical(LGP) :: found
50 
51  ! first store the handler data
52  allocate (handler_data)
53  handler_data%handler => handler
54  handler_data%handlerContext => ctx
55 
56  handler_data_genptr => handler_data
57  call handler_list%Add(handler_data_genptr)
58 
59  ! this is the index for the current handler
60  handler_idx = handler_list%Count()
61 
62  ! now set it to the memory item
63  mt => null()
64  found = .false.
65  call get_from_memorystore(var_name, mem_path, mt, found)
66  mt%set_handler_idx = handler_idx
67 
68  end subroutine
69 
70  !> @brief Triggers the calling of the side effect handler for this variable
71  !!
72  !! The handler can be set by calling @p mem_register_handler(). When
73  !! the status contains an error code, the program should be stopped
74  !! because the data in memory is no longer consistent...
75  !<
76  subroutine on_memory_set(var_name, mem_path, status)
77  character(len=*), intent(in) :: var_name !< the variable name
78  character(len=*), intent(in) :: mem_path !< the memory path
79  integer(I4B), intent(out) :: status !< status: 0 for success, -1 when failed
80  ! local
81  type(memorytype), pointer :: mt
82  logical(LGP) :: found
83  class(*), pointer :: handler_data_genptr => null()
84  class(eventhandlerdatatype), pointer :: evt_handler_data => null()
85 
86  ! get the handler data and cast
87  mt => null()
88  found = .false.
89  call get_from_memorystore(var_name, mem_path, mt, found)
90  if (mt%set_handler_idx == 0) then
91  ! nothing to be done
92  status = 0
93  return
94  end if
95 
96  handler_data_genptr => handler_list%GetItem(mt%set_handler_idx)
97  select type (handler_data_genptr)
98  class is (eventhandlerdatatype)
99  evt_handler_data => handler_data_genptr
100  end select
101 
102  ! call the function
103  call evt_handler_data%handler(evt_handler_data%handlerContext, status)
104  end subroutine
105 
106 end module
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
This module defines variable data types.
Definition: kind.f90:8
subroutine, public get_from_memorystore(name, mem_path, mt, found, check)
@ brief Get a memory type entry from the memory list
subroutine, public mem_register_handler(var_name, mem_path, handler, ctx)
Register the event handler and context for this variable.
subroutine, public on_memory_set(var_name, mem_path, status)
Triggers the calling of the side effect handler for this variable.
A generic heterogeneous doubly-linked list.
Definition: List.f90:14