MODFLOW 6  version 6.7.0.dev0
USGS Modular Hydrologic Model
Functions/Subroutines
sourcecommonmodule Module Reference

This module contains the SourceCommonModule. More...

Functions/Subroutines

character(len=lenpackagename) function, public package_source_type (sourcename)
 source identifier from model namfile FNAME array More...
 
character(len=lencomponentname) function, public idm_component_type (component)
 component from package or model type More...
 
character(len=lencomponentname) function, public idm_subcomponent_type (component, subcomponent)
 component from package or model type More...
 
character(len=lenpackagename) function, public idm_subcomponent_name (component_type, subcomponent_type, sc_name)
 model package subcomponent name More...
 
character(len=lenpackagetype) function, public file_ext (filename)
 input file extension More...
 
subroutine, public get_shape_from_string (shape_string, array_shape, memoryPath)
 
subroutine, public get_layered_shape (mshape, nlay, layer_shape)
 
subroutine, public set_model_shape (ftype, fname, model_mempath, dis_mempath, model_shape)
 routine for setting the model shape More...
 
integer(i4b) function, public ifind_charstr (array, str)
 
logical(lgp) function, public filein_fname (filename, tagname, input_mempath, input_fname)
 enforce and set a single input filename provided via FILEIN keyword More...
 
subroutine, public inlen_check (input_name, mf6_name, maxlen, name_type)
 store an error for input exceeding internal name length More...
 

Detailed Description

This module contains source independent input processing helper routines.

Function/Subroutine Documentation

◆ file_ext()

character(len=lenpackagetype) function, public sourcecommonmodule::file_ext ( character(len=*), intent(in)  filename)

Return a file extension, or an empty string if not identified.

Definition at line 142 of file SourceCommon.f90.

143  use idmdfnselectormodule, only: idm_multi_package
144  character(len=*), intent(in) :: filename
145  character(len=LENPACKAGETYPE) :: ext
146  integer(I4B) :: idx
147  ! initialize
148  ext = ''
149  idx = 0
150  ! identify '.' character position from back of string
151  idx = index(filename, '.', back=.true.)
152  if (idx > 0) then
153  ext = filename(idx + 1:len_trim(filename))
154  end if
idmdfnselectormodule::idm_multi_package
logical function, public idm_multi_package(component, subcomponent)
Definition: IdmDfnSelector.f90:118
Here is the call graph for this function:
Here is the caller graph for this function:

◆ filein_fname()

logical(lgp) function, public sourcecommonmodule::filein_fname ( character(len=*), intent(inout)  filename,
character(len=*), intent(in)  tagname,
character(len=*), intent(in)  input_mempath,
character(len=*), intent(in)  input_fname 
)

Set a FILEIN filename provided via an OPTIONS block. Only use this function if a maximum of one FILEIN file name string is expected.

Return true if single FILEIN file name found and set, return false if FILEIN tag not found.

Definition at line 400 of file SourceCommon.f90.

402  use memorymanagermodule, only: mem_setptr, get_isize
403  use characterstringmodule, only: characterstringtype
404  character(len=*), intent(inout) :: filename
405  character(len=*), intent(in) :: tagname
406  character(len=*), intent(in) :: input_mempath
407  character(len=*), intent(in) :: input_fname
408  logical(LGP) :: found
409  type(CharacterStringType), dimension(:), pointer, &
410  contiguous :: fnames
411  integer(I4B) :: isize
412 
413  ! initialize
414  found = .false.
415  filename = ''
416 
417  call get_isize(tagname, input_mempath, isize)
418 
419  if (isize > 0) then
420  if (isize /= 1) then
421  errmsg = 'Multiple FILEIN keywords detected for tag "'//trim(tagname)// &
422  '" in OPTIONS block. Only one entry allowed.'
423  call store_error(errmsg)
424  call store_error_filename(input_fname)
425  end if
426 
427  call mem_setptr(fnames, tagname, input_mempath)
428  filename = fnames(1)
429  found = .true.
430  end if
memorymanagermodule::mem_setptr
Definition: MemoryManager.f90:89
memorymanagermodule::get_isize
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
Definition: MemoryManager.f90:265
characterstringmodule::characterstringtype
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
Here is the call graph for this function:
Here is the caller graph for this function:

◆ get_layered_shape()

subroutine, public sourcecommonmodule::get_layered_shape ( integer(i4b), dimension(:), intent(in)  mshape,
integer(i4b), intent(out)  nlay,
integer(i4b), dimension(:), intent(out), allocatable  layer_shape 
)

Definition at line 181 of file SourceCommon.f90.

182  integer(I4B), dimension(:), intent(in) :: mshape
183  integer(I4B), intent(out) :: nlay
184  integer(I4B), dimension(:), allocatable, intent(out) :: layer_shape
185  integer(I4B) :: ndim
186 
187  ndim = size(mshape)
188  nlay = 0
189 
190  if (ndim == 1) then ! disu
191  nlay = 1
192  allocate (layer_shape(1))
193  layer_shape(1) = mshape(1)
194  else if (ndim == 2) then ! disv
195  nlay = mshape(1)
196  allocate (layer_shape(1))
197  layer_shape(1) = mshape(2)
198  else if (ndim == 3) then ! disu
199  nlay = mshape(1)
200  allocate (layer_shape(2))
201  layer_shape(1) = mshape(3) ! ncol
202  layer_shape(2) = mshape(2) ! nrow
203  end if
Here is the caller graph for this function:

◆ get_shape_from_string()

subroutine, public sourcecommonmodule::get_shape_from_string ( character(len=*), intent(in)  shape_string,
integer(i4b), dimension(:), intent(inout), allocatable  array_shape,
character(len=*), intent(in)  memoryPath 
)
Parameters
[in]memorypathmemorypath to put loaded information

Definition at line 157 of file SourceCommon.f90.

158  use inputoutputmodule, only: parseline
159  use memorymanagermodule, only: mem_setptr
160  character(len=*), intent(in) :: shape_string
161  integer(I4B), dimension(:), allocatable, intent(inout) :: array_shape
162  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
163  integer(I4B) :: ndim
164  integer(I4B) :: i
165  integer(I4B), pointer :: int_ptr
166  character(len=16), dimension(:), allocatable :: array_shape_string
167  character(len=:), allocatable :: shape_string_copy
168 
169  ! parse the string into multiple words
170  shape_string_copy = trim(shape_string)//' '
171  call parseline(shape_string_copy, ndim, array_shape_string)
172  allocate (array_shape(ndim))
173 
174  ! find shape in memory manager and put into array_shape
175  do i = 1, ndim
176  call mem_setptr(int_ptr, array_shape_string(i), memorypath)
177  array_shape(i) = int_ptr
178  end do
inputoutputmodule::parseline
subroutine, public parseline(line, nwords, words, inunit, filename)
Parse a line into words.
Definition: InputOutput.f90:1132
Here is the call graph for this function:
Here is the caller graph for this function:

◆ idm_component_type()

character(len=lencomponentname) function, public sourcecommonmodule::idm_component_type ( character(len=*), intent(in)  component)

Return the component type typically derived from package file type, i.e. return GWF when input is GWF6. This function checks the resultant component type and throws a terminating error if not supported by IDM in some capacity.

Definition at line 55 of file SourceCommon.f90.

56  use idmdfnselectormodule, only: idm_component
57  character(len=*), intent(in) :: component
58  character(len=LENCOMPONENTNAME) :: component_type
59  integer(I4B) :: i, ilen, idx
60 
61  ! initialize
62  component_type = ''
63  idx = 0
64 
65  ilen = len_trim(component)
66  do i = 1, ilen
67  if (component(i:i) == '6' .or. component(i:i) == '-') then
68  else
69  idx = idx + 1
70  component_type(idx:idx) = component(i:i)
71  end if
72  end do
73 
74  if (.not. idm_component(component_type)) then
75  write (errmsg, '(a)') &
76  'IDP input error, unrecognized component: "'//trim(component)//'"'
77  call store_error(errmsg, .true.)
78  end if
idmdfnselectormodule::idm_component
logical function, public idm_component(component)
Definition: IdmDfnSelector.f90:209
Here is the call graph for this function:
Here is the caller graph for this function:

◆ idm_subcomponent_name()

character(len=lenpackagename) function, public sourcecommonmodule::idm_subcomponent_name ( character(len=*), intent(in)  component_type,
character(len=*), intent(in)  subcomponent_type,
character(len=*), intent(in)  sc_name 
)

Return the IDM component name, which is the package type for base packages and the package name for multi package (i.e. stress) types.

Definition at line 121 of file SourceCommon.f90.

123  use idmdfnselectormodule, only: idm_multi_package
124  character(len=*), intent(in) :: component_type
125  character(len=*), intent(in) :: subcomponent_type
126  character(len=*), intent(in) :: sc_name
127  character(len=LENPACKAGENAME) :: subcomponent_name
128  subcomponent_name = ''
129  if (idm_multi_package(component_type, subcomponent_type)) then
130  subcomponent_name = sc_name
131  else
132  subcomponent_name = subcomponent_type
133  end if
Here is the call graph for this function:
Here is the caller graph for this function:

◆ idm_subcomponent_type()

character(len=lencomponentname) function, public sourcecommonmodule::idm_subcomponent_type ( character(len=*), intent(in)  component,
character(len=*), intent(in)  subcomponent 
)

Return the subcomponent type typically derived from package file type, i.e. return CHD when input is CHD6. Note this function is called on file types that are both idm integrated and not and should not set an error based on this difference.

Parameters
[in]componentcomponent, e.g. GWF6
[in]subcomponentsubcomponent, e.g. CHD6

Definition at line 89 of file SourceCommon.f90.

91  character(len=*), intent(in) :: component !< component, e.g. GWF6
92  character(len=*), intent(in) :: subcomponent !< subcomponent, e.g. CHD6
93  character(len=LENCOMPONENTNAME) :: subcomponent_type
94  character(len=LENCOMPONENTNAME) :: component_type
95  integer(I4B) :: i, ilen, idx
96 
97  ! initialize
98  subcomponent_type = ''
99  idx = 0
100 
101  ! verify component
102  component_type = idm_component_type(component)
103 
104  ilen = len_trim(subcomponent)
105  do i = 1, ilen
106  if (subcomponent(i:i) == '6' .or. subcomponent(i:i) == '-') then
107  else
108  idx = idx + 1
109  subcomponent_type(idx:idx) = subcomponent(i:i)
110  end if
111  end do
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ifind_charstr()

integer(i4b) function, public sourcecommonmodule::ifind_charstr ( type(characterstringtype), dimension(:), intent(in)  array,
character(len=*)  str 
)

Definition at line 372 of file SourceCommon.f90.

373  use characterstringmodule, only: characterstringtype
374  implicit none
375  integer(I4B) :: ifind_charstr
376  type(CharacterStringType), dimension(:), intent(in) :: array
377  character(len=*) :: str
378  character(len=LINELENGTH) :: compare_str
379  integer(I4B) :: i
380  ifind_charstr = -1
381  findloop: do i = 1, size(array)
382  compare_str = array(i)
383  if (compare_str == str) then
384  ifind_charstr = i
385  exit findloop
386  end if
387  end do findloop
Here is the caller graph for this function:

◆ inlen_check()

subroutine, public sourcecommonmodule::inlen_check ( type(characterstringtype), intent(in)  input_name,
character(len=*), intent(inout)  mf6_name,
integer(i4b), intent(in)  maxlen,
character(len=*), intent(in)  name_type 
)

Definition at line 435 of file SourceCommon.f90.

436  use characterstringmodule, only: characterstringtype
437  type(CharacterStringType), intent(in) :: input_name
438  character(len=*), intent(inout) :: mf6_name
439  integer(I4B), intent(in) :: maxlen
440  character(len=*), intent(in) :: name_type
441  character(len=LINELENGTH) :: input_str
442  integer(I4B) :: ilen
443 
444  ! initialize
445  mf6_name = ''
446  input_str = input_name
447  ilen = len_trim(input_str)
448  if (ilen > maxlen) then
449  write (errmsg, '(a,i0,a)') &
450  'Input name "'//trim(input_str)//'" exceeds maximum allowed length (', &
451  maxlen, ') for '//trim(name_type)//'.'
452  call store_error(errmsg)
453  end if
454 
455  ! set truncated name
456  mf6_name = trim(input_str)
Here is the call graph for this function:
Here is the caller graph for this function:

◆ package_source_type()

character(len=lenpackagename) function, public sourcecommonmodule::package_source_type ( character(len=*), intent(in)  sourcename)

Return the source type for a package listed in the model nam file packages block FNAME field.

Definition at line 35 of file SourceCommon.f90.

36  use inputoutputmodule, only: upcase
37  character(len=*), intent(in) :: sourcename
38  character(len=LENPACKAGENAME) :: sourcetype
39  character(len=LENPACKAGENAME) :: ext
40  ext = file_ext(sourcename)
41  select case (ext)
42  case default
43  sourcetype = 'MF6FILE'
44  end select
inputoutputmodule::upcase
subroutine, public upcase(word)
Convert to upper case.
Definition: InputOutput.f90:206
Here is the call graph for this function:
Here is the caller graph for this function:

◆ set_model_shape()

subroutine, public sourcecommonmodule::set_model_shape ( character(len=*), intent(in)  ftype,
character(len=*), intent(in)  fname,
character(len=*), intent(in)  model_mempath,
character(len=*), intent(in)  dis_mempath,
integer(i4b), dimension(:), intent(inout), pointer, contiguous  model_shape 
)

The model shape must be set in the memory manager because individual packages need to know the shape of the arrays to read.

Definition at line 213 of file SourceCommon.f90.

215  use constantsmodule, only: disundef, dis, disv, disu, dis2d, disv1d
216  use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
217  character(len=*), intent(in) :: ftype
218  character(len=*), intent(in) :: fname
219  character(len=*), intent(in) :: model_mempath
220  character(len=*), intent(in) :: dis_mempath
221  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: model_shape
222  integer(I4B), pointer :: ndim1
223  integer(I4B), pointer :: ndim2
224  integer(I4B), pointer :: ndim3
225  integer(I4B), pointer :: ncelldim
226  integer(I4B), pointer :: distype
227  integer(I4B) :: dim1_size, dim2_size, dim3_size, dis_type
228 
229  ! initialize dis_type
230  dis_type = disundef
231 
232  ! allocate and set model shape in model input context
233  select case (ftype)
234  case ('DIS6')
235  ! set dis_type
236  dis_type = dis
237  call get_isize('NLAY', dis_mempath, dim1_size)
238  call get_isize('NROW', dis_mempath, dim2_size)
239  call get_isize('NCOL', dis_mempath, dim3_size)
240 
241  if (dim1_size <= 0) then
242  write (errmsg, '(a)') &
243  'Required input dimension "NLAY" not found.'
244  call store_error(errmsg)
245  end if
246 
247  if (dim2_size <= 0) then
248  write (errmsg, '(a)') &
249  'Required input dimension "NROW" not found.'
250  call store_error(errmsg)
251  end if
252 
253  if (dim3_size <= 0) then
254  write (errmsg, '(a)') &
255  'Required input dimension "NCOL" not found.'
256  call store_error(errmsg)
257  end if
258 
259  if (dim1_size >= 1 .and. dim2_size >= 1 .and. dim3_size >= 1) then
260  call mem_allocate(model_shape, 3, 'MODEL_SHAPE', model_mempath)
261  call mem_setptr(ndim1, 'NLAY', dis_mempath)
262  call mem_setptr(ndim2, 'NROW', dis_mempath)
263  call mem_setptr(ndim3, 'NCOL', dis_mempath)
264  model_shape = [ndim1, ndim2, ndim3]
265  else
266  call store_error_filename(fname)
267  end if
268  case ('DIS2D6')
269  ! set dis_type
270  dis_type = dis2d
271  call get_isize('NROW', dis_mempath, dim1_size)
272  call get_isize('NCOL', dis_mempath, dim2_size)
273 
274  if (dim1_size <= 0) then
275  write (errmsg, '(a)') &
276  'Required input dimension "NROW" not found.'
277  call store_error(errmsg)
278  end if
279 
280  if (dim2_size <= 0) then
281  write (errmsg, '(a)') &
282  'Required input dimension "NCOL" not found.'
283  call store_error(errmsg)
284  end if
285 
286  if (dim1_size >= 1 .and. dim2_size >= 1) then
287  call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath)
288  call mem_setptr(ndim1, 'NROW', dis_mempath)
289  call mem_setptr(ndim2, 'NCOL', dis_mempath)
290  model_shape = [ndim1, ndim2]
291  else
292  call store_error_filename(fname)
293  end if
294  case ('DISV6')
295  ! set dis_type
296  dis_type = disv
297  call get_isize('NLAY', dis_mempath, dim1_size)
298  call get_isize('NCPL', dis_mempath, dim2_size)
299 
300  if (dim1_size <= 0) then
301  write (errmsg, '(a)') &
302  'Required input dimension "NLAY" not found.'
303  call store_error(errmsg)
304  end if
305 
306  if (dim2_size <= 0) then
307  write (errmsg, '(a)') &
308  'Required input dimension "NCPL" not found.'
309  call store_error(errmsg)
310  end if
311 
312  if (dim1_size >= 1 .and. dim2_size >= 1) then
313  call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath)
314  call mem_setptr(ndim1, 'NLAY', dis_mempath)
315  call mem_setptr(ndim2, 'NCPL', dis_mempath)
316  model_shape = [ndim1, ndim2]
317  else
318  call store_error_filename(fname)
319  end if
320  case ('DISV2D6')
321  call get_isize('NODES', dis_mempath, dim1_size)
322 
323  if (dim1_size <= 0) then
324  write (errmsg, '(a)') &
325  'Required input dimension "NODES" not found.'
326  call store_error(errmsg)
327  end if
328 
329  if (dim1_size >= 1) then
330  call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath)
331  call mem_setptr(ndim1, 'NODES', dis_mempath)
332  model_shape = [ndim1]
333  else
334  call store_error_filename(fname)
335  end if
336  case ('DISU6', 'DISV1D6')
337  ! set dis_type
338  if (ftype == 'DISU6') then
339  dis_type = disu
340  else if (ftype == 'DISV1D6') then
341  dis_type = disv1d
342  end if
343 
344  call get_isize('NODES', dis_mempath, dim1_size)
345 
346  if (dim1_size <= 0) then
347  write (errmsg, '(a)') &
348  'Required input dimension "NODES" not found.'
349  call store_error(errmsg)
350  call store_error_filename(fname)
351  end if
352 
353  call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath)
354  call mem_setptr(ndim1, 'NODES', dis_mempath)
355  model_shape = [ndim1]
356  case default
357  errmsg = 'Unknown discretization type. IDM cannot set shape for "' &
358  //trim(ftype)//"'"
359  call store_error(errmsg)
360  call store_error_filename(fname)
361  end select
362 
363  ! allocate and set ncelldim in model input context
364  call mem_allocate(ncelldim, 'NCELLDIM', model_mempath)
365  ncelldim = size(model_shape)
366 
367  ! allocate and set distype in model input context
368  call mem_allocate(distype, 'DISENUM', model_mempath)
369  distype = dis_type
memorymanagermodule::mem_allocate
Definition: MemoryManager.f90:54
constantsmodule
This module contains simulation constants.
Definition: Constants.f90:9
constantsmodule::disu
@ disu
DISV6 discretization.
Definition: Constants.f90:157
constantsmodule::dis
@ dis
DIS6 discretization.
Definition: Constants.f90:155
constantsmodule::disv1d
@ disv1d
DISV1D6 discretization.
Definition: Constants.f90:160
constantsmodule::dis2d
@ dis2d
DIS2D6 discretization.
Definition: Constants.f90:163
constantsmodule::disv
@ disv
DISU6 discretization.
Definition: Constants.f90:156
constantsmodule::disundef
@ disundef
undefined discretization
Definition: Constants.f90:153
Here is the call graph for this function:
Here is the caller graph for this function: