MODFLOW 6  version 6.8.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=lenpackagename) function, public idm_pkg_instance_name (pkg_type, inst)
 default name for a multi-package instance More...
 
logical(lgp) function, public idm_utl_type (component, subcomponent)
 is utility type 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 189 of file SourceCommon.f90.

190  use idmdfnselectormodule, only: idm_multi_package
191  character(len=*), intent(in) :: filename
192  character(len=LENPACKAGETYPE) :: ext
193  integer(I4B) :: idx
194  ! initialize
195  ext = ''
196  idx = 0
197  ! identify '.' character position from back of string
198  idx = index(filename, '.', back=.true.)
199  if (idx > 0) then
200  ext = filename(idx + 1:len_trim(filename))
201  end if
idmdfnselectormodule::idm_multi_package
logical function, public idm_multi_package(component, subcomponent)
Definition: IdmDfnSelector.f90:125
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 447 of file SourceCommon.f90.

449  use memorymanagermodule, only: mem_setptr, get_isize
450  use characterstringmodule, only: characterstringtype
451  character(len=*), intent(inout) :: filename
452  character(len=*), intent(in) :: tagname
453  character(len=*), intent(in) :: input_mempath
454  character(len=*), intent(in) :: input_fname
455  logical(LGP) :: found
456  type(CharacterStringType), dimension(:), pointer, &
457  contiguous :: fnames
458  integer(I4B) :: isize
459 
460  ! initialize
461  found = .false.
462  filename = ''
463 
464  call get_isize(tagname, input_mempath, isize)
465 
466  if (isize > 0) then
467  if (isize /= 1) then
468  errmsg = 'Multiple FILEIN keywords detected for tag "'//trim(tagname)// &
469  '" in OPTIONS block. Only one entry allowed.'
470  call store_error(errmsg)
471  call store_error_filename(input_fname)
472  end if
473 
474  call mem_setptr(fnames, tagname, input_mempath)
475  filename = fnames(1)
476  found = .true.
477  end if
memorymanagermodule::mem_setptr
Definition: MemoryManager.f90:92
memorymanagermodule::get_isize
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
Definition: MemoryManager.f90:274
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 228 of file SourceCommon.f90.

229  integer(I4B), dimension(:), intent(in) :: mshape
230  integer(I4B), intent(out) :: nlay
231  integer(I4B), dimension(:), allocatable, intent(out) :: layer_shape
232  integer(I4B) :: ndim
233 
234  ndim = size(mshape)
235  nlay = 0
236 
237  if (ndim == 1) then ! disu
238  nlay = 1
239  allocate (layer_shape(1))
240  layer_shape(1) = mshape(1)
241  else if (ndim == 2) then ! disv
242  nlay = mshape(1)
243  allocate (layer_shape(1))
244  layer_shape(1) = mshape(2)
245  else if (ndim == 3) then ! disu
246  nlay = mshape(1)
247  allocate (layer_shape(2))
248  layer_shape(1) = mshape(3) ! ncol
249  layer_shape(2) = mshape(2) ! nrow
250  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 204 of file SourceCommon.f90.

205  use inputoutputmodule, only: parseline
206  use memorymanagermodule, only: mem_setptr
207  character(len=*), intent(in) :: shape_string
208  integer(I4B), dimension(:), allocatable, intent(inout) :: array_shape
209  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
210  integer(I4B) :: ndim
211  integer(I4B) :: i
212  integer(I4B), pointer :: int_ptr
213  character(len=16), dimension(:), allocatable :: array_shape_string
214  character(len=:), allocatable :: shape_string_copy
215 
216  ! parse the string into multiple words
217  shape_string_copy = trim(shape_string)//' '
218  call parseline(shape_string_copy, ndim, array_shape_string)
219  allocate (array_shape(ndim))
220 
221  ! find shape in memory manager and put into array_shape
222  do i = 1, ndim
223  call mem_setptr(int_ptr, array_shape_string(i), memorypath)
224  array_shape(i) = int_ptr
225  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 57 of file SourceCommon.f90.

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

◆ idm_pkg_instance_name()

character(len=lenpackagename) function, public sourcecommonmodule::idm_pkg_instance_name ( character(len=*), intent(in)  pkg_type,
integer(i4b), intent(in)  inst 
)

Return the default '<TYPE>-<N>' name for the Nth instance of a multi-package type, where N is the 1-based count of packages of this type encountered in an in-order traversal of the model namefile packages block. This is the IDM internal package naming convention when user names are not provided.

Definition at line 148 of file SourceCommon.f90.

149  character(len=*), intent(in) :: pkg_type
150  integer(I4B), intent(in) :: inst
151  character(len=LENPACKAGENAME) :: sc_name
152  write (sc_name, '(a,i0)') trim(pkg_type)//'-', inst
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 123 of file SourceCommon.f90.

125  use idmdfnselectormodule, only: idm_multi_package
126  character(len=*), intent(in) :: component_type
127  character(len=*), intent(in) :: subcomponent_type
128  character(len=*), intent(in) :: sc_name
129  character(len=LENPACKAGENAME) :: subcomponent_name
130  subcomponent_name = ''
131  if (idm_utl_type(component_type, subcomponent_type) .or. &
132  idm_multi_package(component_type, subcomponent_type)) then
133  subcomponent_name = sc_name
134  else
135  subcomponent_name = subcomponent_type
136  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 91 of file SourceCommon.f90.

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

◆ idm_utl_type()

logical(lgp) function, public sourcecommonmodule::idm_utl_type ( character(len=*), intent(in)  component,
character(len=*), intent(in)  subcomponent 
)

Is this subcomponent type an idm integrated utility type.

Parameters
[in]subcomponentsubcomponent string, e.g. TVK, TVK6, or NPF-TVK1

Definition at line 160 of file SourceCommon.f90.

162  use idmdfnselectormodule, only: idm_integrated
163  character(len=*), intent(in) :: component
164  character(len=*), intent(in) :: subcomponent !< subcomponent string, e.g. TVK, TVK6, or NPF-TVK1
165  character(len=LENCOMPONENTNAME) :: subcomponent_type
166  logical(LGP) :: utl_type
167  integer(I4B) :: ilen, idx
168  ilen = len_trim(subcomponent)
169  subcomponent_type = ''
170  idx = index(subcomponent(1:ilen), '-')
171  if (idx > 0) then
172  ! strip '-N' instance suffix (e.g. NPF-TVK1 -> TVK1, further strip below)
173  subcomponent_type = subcomponent(1:idx - 1)
174  else if (ilen > 0 .and. subcomponent(ilen:ilen) == '6') then
175  ! strip trailing '6' package-type suffix (e.g. TVK6 -> TVK)
176  subcomponent_type = subcomponent(1:ilen - 1)
177  else
178  subcomponent_type = subcomponent(1:ilen)
179  end if
180  utl_type = idm_integrated('UTL', subcomponent_type)
idmdfnselectormodule::idm_integrated
logical function, public idm_integrated(component, subcomponent)
Definition: IdmDfnSelector.f90:191
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 419 of file SourceCommon.f90.

420  use characterstringmodule, only: characterstringtype
421  implicit none
422  integer(I4B) :: ifind_charstr
423  type(CharacterStringType), dimension(:), intent(in) :: array
424  character(len=*) :: str
425  character(len=LINELENGTH) :: compare_str
426  integer(I4B) :: i
427  ifind_charstr = -1
428  findloop: do i = 1, size(array)
429  compare_str = array(i)
430  if (compare_str == str) then
431  ifind_charstr = i
432  exit findloop
433  end if
434  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 482 of file SourceCommon.f90.

483  use characterstringmodule, only: characterstringtype
484  type(CharacterStringType), intent(in) :: input_name
485  character(len=*), intent(inout) :: mf6_name
486  integer(I4B), intent(in) :: maxlen
487  character(len=*), intent(in) :: name_type
488  character(len=LINELENGTH) :: input_str
489  integer(I4B) :: ilen
490 
491  ! initialize
492  mf6_name = ''
493  input_str = input_name
494  ilen = len_trim(input_str)
495  if (ilen > maxlen) then
496  write (errmsg, '(a,i0,a)') &
497  'Input name "'//trim(input_str)//'" exceeds maximum allowed length (', &
498  maxlen, ') for '//trim(name_type)//'.'
499  call store_error(errmsg)
500  end if
501 
502  ! set truncated name
503  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 37 of file SourceCommon.f90.

38  use inputoutputmodule, only: upcase
39  character(len=*), intent(in) :: sourcename
40  character(len=LENPACKAGENAME) :: sourcetype
41  character(len=LENPACKAGENAME) :: ext
42  ext = file_ext(sourcename)
43  select case (ext)
44  case default
45  sourcetype = 'MF6FILE'
46  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 260 of file SourceCommon.f90.

262  use constantsmodule, only: disundef, dis, disv, disu, dis2d, disv1d
263  use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
264  character(len=*), intent(in) :: ftype
265  character(len=*), intent(in) :: fname
266  character(len=*), intent(in) :: model_mempath
267  character(len=*), intent(in) :: dis_mempath
268  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: model_shape
269  integer(I4B), pointer :: ndim1
270  integer(I4B), pointer :: ndim2
271  integer(I4B), pointer :: ndim3
272  integer(I4B), pointer :: ncelldim
273  integer(I4B), pointer :: distype
274  integer(I4B) :: dim1_size, dim2_size, dim3_size, dis_type
275 
276  ! initialize dis_type
277  dis_type = disundef
278 
279  ! allocate and set model shape in model input context
280  select case (ftype)
281  case ('DIS6')
282  ! set dis_type
283  dis_type = dis
284  call get_isize('NLAY', dis_mempath, dim1_size)
285  call get_isize('NROW', dis_mempath, dim2_size)
286  call get_isize('NCOL', dis_mempath, dim3_size)
287 
288  if (dim1_size <= 0) then
289  write (errmsg, '(a)') &
290  'Required input dimension "NLAY" not found.'
291  call store_error(errmsg)
292  end if
293 
294  if (dim2_size <= 0) then
295  write (errmsg, '(a)') &
296  'Required input dimension "NROW" not found.'
297  call store_error(errmsg)
298  end if
299 
300  if (dim3_size <= 0) then
301  write (errmsg, '(a)') &
302  'Required input dimension "NCOL" not found.'
303  call store_error(errmsg)
304  end if
305 
306  if (dim1_size >= 1 .and. dim2_size >= 1 .and. dim3_size >= 1) then
307  call mem_allocate(model_shape, 3, 'MODEL_SHAPE', model_mempath)
308  call mem_setptr(ndim1, 'NLAY', dis_mempath)
309  call mem_setptr(ndim2, 'NROW', dis_mempath)
310  call mem_setptr(ndim3, 'NCOL', dis_mempath)
311  model_shape = [ndim1, ndim2, ndim3]
312  else
313  call store_error_filename(fname)
314  end if
315  case ('DIS2D6')
316  ! set dis_type
317  dis_type = dis2d
318  call get_isize('NROW', dis_mempath, dim1_size)
319  call get_isize('NCOL', dis_mempath, dim2_size)
320 
321  if (dim1_size <= 0) then
322  write (errmsg, '(a)') &
323  'Required input dimension "NROW" not found.'
324  call store_error(errmsg)
325  end if
326 
327  if (dim2_size <= 0) then
328  write (errmsg, '(a)') &
329  'Required input dimension "NCOL" not found.'
330  call store_error(errmsg)
331  end if
332 
333  if (dim1_size >= 1 .and. dim2_size >= 1) then
334  call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath)
335  call mem_setptr(ndim1, 'NROW', dis_mempath)
336  call mem_setptr(ndim2, 'NCOL', dis_mempath)
337  model_shape = [ndim1, ndim2]
338  else
339  call store_error_filename(fname)
340  end if
341  case ('DISV6')
342  ! set dis_type
343  dis_type = disv
344  call get_isize('NLAY', dis_mempath, dim1_size)
345  call get_isize('NCPL', dis_mempath, dim2_size)
346 
347  if (dim1_size <= 0) then
348  write (errmsg, '(a)') &
349  'Required input dimension "NLAY" not found.'
350  call store_error(errmsg)
351  end if
352 
353  if (dim2_size <= 0) then
354  write (errmsg, '(a)') &
355  'Required input dimension "NCPL" not found.'
356  call store_error(errmsg)
357  end if
358 
359  if (dim1_size >= 1 .and. dim2_size >= 1) then
360  call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath)
361  call mem_setptr(ndim1, 'NLAY', dis_mempath)
362  call mem_setptr(ndim2, 'NCPL', dis_mempath)
363  model_shape = [ndim1, ndim2]
364  else
365  call store_error_filename(fname)
366  end if
367  case ('DISV2D6')
368  call get_isize('NODES', dis_mempath, dim1_size)
369 
370  if (dim1_size <= 0) then
371  write (errmsg, '(a)') &
372  'Required input dimension "NODES" not found.'
373  call store_error(errmsg)
374  end if
375 
376  if (dim1_size >= 1) then
377  call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath)
378  call mem_setptr(ndim1, 'NODES', dis_mempath)
379  model_shape = [ndim1]
380  else
381  call store_error_filename(fname)
382  end if
383  case ('DISU6', 'DISV1D6')
384  ! set dis_type
385  if (ftype == 'DISU6') then
386  dis_type = disu
387  else if (ftype == 'DISV1D6') then
388  dis_type = disv1d
389  end if
390 
391  call get_isize('NODES', dis_mempath, dim1_size)
392 
393  if (dim1_size <= 0) then
394  write (errmsg, '(a)') &
395  'Required input dimension "NODES" not found.'
396  call store_error(errmsg)
397  call store_error_filename(fname)
398  end if
399 
400  call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath)
401  call mem_setptr(ndim1, 'NODES', dis_mempath)
402  model_shape = [ndim1]
403  case default
404  errmsg = 'Unknown discretization type. IDM cannot set shape for "' &
405  //trim(ftype)//"'"
406  call store_error(errmsg)
407  call store_error_filename(fname)
408  end select
409 
410  ! allocate and set ncelldim in model input context
411  call mem_allocate(ncelldim, 'NCELLDIM', model_mempath)
412  ncelldim = size(model_shape)
413 
414  ! allocate and set distype in model input context
415  call mem_allocate(distype, 'DISENUM', model_mempath)
416  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: