MODFLOW 6  version 6.7.0.dev0
USGS Modular Hydrologic Model
mf6bmiUtil.f90
Go to the documentation of this file.
1 !> @brief This module contains helper routines and parameters for the MODFLOW 6 BMI
2 !!
3 !<
4 module mf6bmiutil
5  use mf6bmierror
6  use iso_c_binding, only: c_int, c_char, c_null_char
10  use kindmodule, only: dp, i4b, lgp
11  use messagemodule, only: write_message
12  use simvariablesmodule, only: istdout
14  implicit none
15 
16  ! the following exported parameters will trigger annoying warnings with
17  ! the Intel Fortran compiler (4049,4217). We know that these can be ignored:
18  !
19  ! https://community.intel.com/t5/Intel-Fortran-Compiler/suppress-linker-warnings/td-p/855137
20  ! https://community.intel.com/t5/Intel-Fortran-Compiler/Locally-Defined-Symbol-Imported/m-p/900805
21  !
22  ! and gfortran does so anyway. They have been disabled in the linker config.
23 
24  integer(I4B), parameter :: lengridtype = 16 !< max length for Fortran grid type string
25 
26  integer(c_int), bind(C, name="BMI_LENVARTYPE") :: bmi_lenvartype = &
27  lenmemtype + 1 !< max. length for variable type C-strings
28  !DIR$ ATTRIBUTES DLLEXPORT :: BMI_LENVARTYPE
29 
30  integer(c_int), bind(C, name="BMI_LENGRIDTYPE") :: bmi_lengridtype = &
31  lengridtype + 1 !< max. length for grid type C-strings
32  !DIR$ ATTRIBUTES DLLEXPORT :: BMI_LENGRIDTYPE
33 
34  integer(c_int), bind(C, name="BMI_LENVARADDRESS") :: bmi_lenvaraddress = &
35  lenmemaddress + 1 !< max. length for the variable's address C-string
36  !DIR$ ATTRIBUTES DLLEXPORT :: BMI_LENVARADDRESS
37 
38  integer(c_int), bind(C, name="BMI_LENCOMPONENTNAME") :: bmi_lencomponentname = &
39  256 !< component name length, i.e. 'MODFLOW 6'
40  !DIR$ ATTRIBUTES DLLEXPORT :: BMI_LENCOMPONENTNAME
41 
42  integer(c_int), bind(C, name="BMI_LENVERSION") :: bmi_lenversion = 256 !< length of version string, e.g. '6.3.1' or '6.4.1-dev'
43  !DIR$ ATTRIBUTES DLLEXPORT :: BMI_LENVERSION
44 
45 contains
46 
47  !> @brief Split the variable address string
48  !!
49  !! Splits the full address string into a memory path and variable name,
50  !! following the rules used by the memory manager. The error handling
51  !! is inside to avoid lots of duplication
52  !<
53  subroutine split_address(c_var_address, mem_path, var_name, success)
54  ! -- modules
56  ! -- dummy variables
57  character(kind=c_char), intent(in) :: c_var_address(*) !< full address of a variable
58  character(len=LENMEMPATH), intent(out) :: mem_path !< memory path used by the memory manager
59  character(len=LENVARNAME), intent(out) :: var_name !< name of the variable
60  logical(LGP), intent(out) :: success !< false when invalid
61  ! -- local variables
62  character(len=LENMEMADDRESS) :: var_address
63  logical(LGP) :: valid, found
64 
65  success = .false.
66 
67  ! try and split the address string:
68  var_address = char_array_to_string(c_var_address, &
69  strlen(c_var_address, lenmemaddress + 1))
70  call split_mem_address(var_address, mem_path, var_name, valid)
71  if (.not. valid) then
72  write (bmi_last_error, fmt_invalid_var) trim(var_address)
74  return
75  end if
76 
77  ! check if the variable even exists:
78  call check_mem_address(mem_path, var_name, found)
79  if (.not. found) then
80  write (bmi_last_error, fmt_unknown_var) trim(var_name), trim(mem_path)
82  return
83  end if
84 
85  success = .true.
86 
87  end subroutine split_address
88 
89  !> @brief Check if the variable exists in the memory manager
90  !<
91  subroutine check_mem_address(mem_path, var_name, found)
92  ! -- modules
94  use memorytypemodule, only: memorytype
95  ! -- dummy variables
96  character(len=LENMEMPATH), intent(in) :: mem_path !< memory path used by the memory manager
97  character(len=LENVARNAME), intent(in) :: var_name !< name of the variable
98  logical(LGP), intent(out) :: found !< true when found
99  ! -- local variables
100  type(memorytype), pointer :: mt
101 
102  found = .false.
103  mt => null()
104 
105  ! check = false: otherwise stop is called when the variable does not exist
106  call get_from_memorystore(var_name, mem_path, mt, found, check=.false.)
107 
108  end subroutine check_mem_address
109 
110  !> @brief Returns the string length without the trailing null character
111  !<
112  pure function strlen(char_array, max_len) result(string_length)
113  ! -- dummy variables
114  integer(I4B), intent(in) :: max_len
115  character(c_char), intent(in) :: char_array(max_len) !< C-style character string
116  integer(I4B) :: string_length !< Fortran string length
117  ! -- local variables
118  integer(I4B) :: i
119 
120  string_length = 0
121  do i = 1, size(char_array)
122  if (char_array(i) .eq. c_null_char) then
123  string_length = i - 1
124  exit
125  end if
126  end do
127 
128  end function strlen
129 
130  !> @brief Convert C-style string to Fortran character string
131  !<
132  pure function char_array_to_string(char_array, length) result(f_string)
133  ! -- dummy variables
134  integer(c_int), intent(in) :: length !< string length without terminating null character
135  character(c_char), intent(in) :: char_array(length) !< string to convert
136  character(len=length) :: f_string !< Fortran fixed length character string
137  ! -- local variables
138  integer(I4B) :: i
139 
140  do i = 1, length
141  f_string(i:i) = char_array(i)
142  end do
143 
144  end function char_array_to_string
145 
146  !> @brief Convert Fortran string to C-style character string
147  !<
148  pure function string_to_char_array(string, length) result(c_array)
149  ! -- dummy variables
150  integer(c_int), intent(in) :: length !< Fortran string length
151  character(len=length), intent(in) :: string !< string to convert
152  character(kind=c_char, len=1) :: c_array(length + 1) !< C-style character string
153  ! -- local variables
154  integer(I4B) :: i
155 
156  do i = 1, length
157  c_array(i) = string(i:i)
158  end do
159  c_array(length + 1) = c_null_char
160 
161  end function string_to_char_array
162 
163  !> @brief Extract the model name from a memory address string
164  !<
165  function extract_model_name(var_address, success) result(model_name)
166  ! -- dummy variables
167  character(len=*), intent(in) :: var_address !< the memory address for the variable
168  character(len=LENMODELNAME) :: model_name !< the extracted model name
169  logical(LGP), intent(out) :: success
170  ! -- local variables
171  character(len=LENMEMPATH) :: mem_path
172  character(len=LENCOMPONENTNAME) :: dummy_component
173  character(len=LENVARNAME) :: var_name
174  logical(LGP) :: split_succeeded
175 
176  success = .false.
177 
178  call split_mem_address(var_address, mem_path, var_name, split_succeeded)
179  if (.not. split_succeeded) then
180  return
181  end if
182 
183  call split_mem_path(mem_path, model_name, dummy_component)
184  success = .true.
185 
186  end function extract_model_name
187 
188  !> @brief Get the model name from the grid id
189  !<
190  function get_model_name(grid_id) result(model_name)
191  ! -- modules
192  use listsmodule, only: basemodellist
194  ! -- dummy variables
195  integer(kind=c_int), intent(in) :: grid_id !< grid id
196  character(len=LENMODELNAME) :: model_name !< model name
197  ! -- local variables
198  integer(I4B) :: i
199  class(basemodeltype), pointer :: basemodel
200  character(len=LINELENGTH) :: error_msg
201 
202  model_name = ''
203 
204  do i = 1, basemodellist%Count()
205  basemodel => getbasemodelfromlist(basemodellist, i)
206  if (basemodel%id == grid_id) then
207  model_name = basemodel%name
208  return
209  end if
210  end do
211 
212  write (error_msg, '(a,i0)') 'BMI error: no model for grid id ', grid_id
213  call write_message(error_msg, iunit=istdout, skipbefore=1, skipafter=1)
214  end function get_model_name
215 
216  !> @brief Get the solution object for this index
217  !<
218  function getsolution(subcomponent_idx) result(solution)
219  ! -- modules
223  ! -- dummy variables
224  integer(I4B), intent(in) :: subcomponent_idx !< index of solution
225  class(basesolutiontype), pointer :: solution !< Base Solution
226  ! -- local variables
227  class(solutiongrouptype), pointer :: sgp
228  integer(I4B) :: solutionidx
229 
230  ! this is equivalent to how it's done in sgp_ca
232  solutionidx = sgp%idsolutions(subcomponent_idx)
233  solution => getbasesolutionfromlist(basesolutionlist, solutionidx)
234  end function getsolution
235 
236  !> @brief Get the grid type for a named model as a fortran string
237  !<
238  subroutine get_grid_type_model(model_name, grid_type_f)
239  ! -- modules
240  use listsmodule, only: basemodellist
242  ! -- dummy variables
243  character(len=LENMODELNAME) :: model_name
244  character(len=LENGRIDTYPE) :: grid_type_f
245  ! -- local variables
246  integer(I4B) :: i
247  class(numericalmodeltype), pointer :: numericalModel
248 
249  do i = 1, basemodellist%Count()
250  numericalmodel => getnumericalmodelfromlist(basemodellist, i)
251  if (numericalmodel%name == model_name) then
252  call numericalmodel%dis%get_dis_type(grid_type_f)
253  end if
254  end do
255  end subroutine get_grid_type_model
256 
257  !> @brief Confirm that grid is of an expected type
258  !<
259  function confirm_grid_type(grid_id, expected_type) result(is_match)
260  ! -- dummy variables
261  integer(kind=c_int), intent(in) :: grid_id
262  character(len=*), intent(in) :: expected_type
263  logical :: is_match
264  ! -- local variables
265  character(len=LENMODELNAME) :: model_name
266  character(len=LENGRIDTYPE) :: grid_type
267 
268  is_match = .false.
269 
270  model_name = get_model_name(grid_id)
271  call get_grid_type_model(model_name, grid_type)
272  ! careful comparison:
273  if (expected_type == grid_type) is_match = .true.
274  end function confirm_grid_type
275 
276 end module mf6bmiutil
class(basemodeltype) function, pointer, public getbasemodelfromlist(list, idx)
Definition: BaseModel.f90:172
class(basesolutiontype) function, pointer, public getbasesolutionfromlist(list, idx)
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
integer(i4b), parameter lencomponentname
maximum length of a component name
Definition: Constants.f90:18
integer(i4b), parameter lenmemaddress
maximum length of the full memory address, including variable name
Definition: Constants.f90:31
integer(i4b), parameter lenmodelname
maximum length of the model name
Definition: Constants.f90:22
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter, public lenmemtype
maximum length of a memory manager type
Definition: Constants.f90:62
integer(i4b), parameter maxcharlen
maximum length of char string
Definition: Constants.f90:47
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
This module defines variable data types.
Definition: kind.f90:8
type(listtype), public basemodellist
Definition: mf6lists.f90:16
type(listtype), public solutiongrouplist
Definition: mf6lists.f90:22
type(listtype), public basesolutionlist
Definition: mf6lists.f90:19
character(len=lenmemseparator), parameter mempathseparator
used to build up the memory address for the stored variables
subroutine split_mem_address(mem_address, mem_path, var_name, success)
Split a memory address string into memory path and variable name.
subroutine split_mem_path(mem_path, component, subcomponent)
Split the memory path into component(s)
subroutine, public get_from_memorystore(name, mem_path, mt, found, check)
@ brief Get a memory type entry from the memory list
Store and issue logging messages to output units.
Definition: Message.f90:2
subroutine, public write_message(text, iunit, fmt, skipbefore, skipafter, advance)
Write a message to an output unit.
Definition: Message.f90:210
Detailed error information for the BMI.
Definition: mf6bmiError.f90:6
character(len= *), parameter fmt_invalid_var
Definition: mf6bmiError.f90:26
character(len= *), parameter fmt_unknown_var
Definition: mf6bmiError.f90:24
character(len=lenerrmessage) bmi_last_error
module variable containing the last error as a Fortran string
Definition: mf6bmiError.f90:20
subroutine report_bmi_error(err_msg)
Sets the last BMI error message and copies it to an exported C-string.
Definition: mf6bmiError.f90:47
This module contains helper routines and parameters for the MODFLOW 6 BMI.
Definition: mf6bmiUtil.f90:4
integer(c_int), bind(C, name="BMI_LENVARTYPE") bmi_lenvartype
max. length for variable type C-strings
Definition: mf6bmiUtil.f90:26
integer(c_int), bind(C, name="BMI_LENCOMPONENTNAME") bmi_lencomponentname
component name length, i.e. 'MODFLOW 6'
Definition: mf6bmiUtil.f90:38
character(len=lenmodelname) function get_model_name(grid_id)
Get the model name from the grid id.
Definition: mf6bmiUtil.f90:191
subroutine split_address(c_var_address, mem_path, var_name, success)
Split the variable address string.
Definition: mf6bmiUtil.f90:54
subroutine get_grid_type_model(model_name, grid_type_f)
Get the grid type for a named model as a fortran string.
Definition: mf6bmiUtil.f90:239
integer(c_int), bind(C, name="BMI_LENVERSION") bmi_lenversion
length of version string, e.g. '6.3.1' or '6.4.1-dev'
Definition: mf6bmiUtil.f90:42
integer(c_int), bind(C, name="BMI_LENGRIDTYPE") bmi_lengridtype
max. length for grid type C-strings
Definition: mf6bmiUtil.f90:30
class(basesolutiontype) function, pointer getsolution(subcomponent_idx)
Get the solution object for this index.
Definition: mf6bmiUtil.f90:219
integer(i4b), parameter lengridtype
max length for Fortran grid type string
Definition: mf6bmiUtil.f90:24
logical function confirm_grid_type(grid_id, expected_type)
Confirm that grid is of an expected type.
Definition: mf6bmiUtil.f90:260
subroutine check_mem_address(mem_path, var_name, found)
Check if the variable exists in the memory manager.
Definition: mf6bmiUtil.f90:92
pure character(kind=c_char, len=1) function, dimension(length+1) string_to_char_array(string, length)
Convert Fortran string to C-style character string.
Definition: mf6bmiUtil.f90:149
pure integer(i4b) function strlen(char_array, max_len)
Returns the string length without the trailing null character.
Definition: mf6bmiUtil.f90:113
pure character(len=length) function char_array_to_string(char_array, length)
Convert C-style string to Fortran character string.
Definition: mf6bmiUtil.f90:133
character(len=lenmodelname) function extract_model_name(var_address, success)
Extract the model name from a memory address string.
Definition: mf6bmiUtil.f90:166
integer(c_int), bind(C, name="BMI_LENVARADDRESS") bmi_lenvaraddress
max. length for the variable's address C-string
Definition: mf6bmiUtil.f90:34
class(numericalmodeltype) function, pointer, public getnumericalmodelfromlist(list, idx)
This module contains simulation variables.
Definition: SimVariables.f90:9
integer(i4b) istdout
unit number for stdout
class(solutiongrouptype) function, pointer, public getsolutiongroupfromlist(list, idx)
Highest level model type. All models extend this parent type.
Definition: BaseModel.f90:13