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	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...

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 174 of file SourceCommon.f90.

    ! -- modules
    use idmdfnselectormodule, only: idm_multi_package
    ! -- dummy
    character(len=*), intent(in) :: filename
    ! -- return
    character(len=LENPACKAGETYPE) :: ext
    ! -- local
    integer(I4B) :: idx
    !
    ! -- initialize
    ext = ''
    idx = 0
    !
    ! -- identify '.' character position from back of string
    idx = index(filename, '.', back=.true.)
    !
    !
    if (idx > 0) then
      ext = filename(idx + 1:len_trim(filename))
    end if
    !
    ! -- return
    return

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 446 of file SourceCommon.f90.

    use simmodule, only: store_error, store_error_filename
    use memorymanagermodule, only: mem_setptr, get_isize
    use characterstringmodule, only: characterstringtype
    character(len=*), intent(inout) :: filename
    character(len=*), intent(in) :: tagname
    character(len=*), intent(in) :: input_mempath
    character(len=*), intent(in) :: input_fname
    logical(LGP) :: found
    type(CharacterStringType), dimension(:), pointer, &
      contiguous :: fnames
    integer(I4B) :: isize
    !
    ! -- initialize
    found = .false.
    filename = ''
    !
    call get_isize(tagname, input_mempath, isize)
    !
    if (isize > 0) then
      !
      if (isize /= 1) then
        errmsg = 'Multiple FILEIN keywords detected for tag "'//trim(tagname)// &
                 '" in OPTIONS block. Only one entry allowed.'
        call store_error(errmsg)
        call store_error_filename(input_fname)
      end if
      !
      call mem_setptr(fnames, tagname, input_mempath)
      !
      filename = fnames(1)
      found = .true.
      !
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

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]

memorypath

memorypath to put loaded information

Definition at line 200 of file SourceCommon.f90.

    use inputoutputmodule, only: parseline
    use memorymanagermodule, only: mem_setptr
    character(len=*), intent(in) :: shape_string
    integer(I4B), dimension(:), allocatable, intent(inout) :: array_shape
    character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
    integer(I4B) :: ndim
    integer(I4B) :: i
    integer(I4B), pointer :: int_ptr
    character(len=16), dimension(:), allocatable :: array_shape_string
    character(len=:), allocatable :: shape_string_copy
    !
    ! -- parse the string into multiple words
    shape_string_copy = trim(shape_string)//' '
    call parseline(shape_string_copy, ndim, array_shape_string)
    allocate (array_shape(ndim))
    !
    ! -- find shape in memory manager and put into array_shape
    do i = 1, ndim
      call mem_setptr(int_ptr, array_shape_string(i), memorypath)
      array_shape(i) = int_ptr
    end do
    !
    ! -- return
    return

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 62 of file SourceCommon.f90.

    ! -- modules
    use idmdfnselectormodule, only: idm_component
    ! -- dummy
    character(len=*), intent(in) :: component
    ! -- return
    character(len=LENCOMPONENTNAME) :: component_type
    ! -- local
    integer(I4B) :: i, ilen, idx
    !
    ! -- initialize
    component_type = ''
    idx = 0
    !
    ilen = len_trim(component)
    do i = 1, ilen
      if (component(i:i) == '6' .or. component(i:i) == '-') then
      else
        idx = idx + 1
        component_type(idx:idx) = component(i:i)
      end if
    end do
    !
    if (.not. idm_component(component_type)) then
      write (errmsg, '(a)') &
        'IDP input error, unrecognized component: "'//trim(component)//'"'
      call store_error(errmsg, .true.)
    end if
    !
    ! -- return
    return

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 142 of file SourceCommon.f90.

    ! -- modules
    use idmdfnselectormodule, only: idm_multi_package
    ! -- dummy
    character(len=*), intent(in) :: component_type
    character(len=*), intent(in) :: subcomponent_type
    character(len=*), intent(in) :: sc_name
    ! -- return
    character(len=LENPACKAGENAME) :: subcomponent_name
    ! -- local
    !
    subcomponent_name = ''
    !
    if (idm_multi_package(component_type, subcomponent_type)) then
      !
      subcomponent_name = sc_name
    else
      !
      subcomponent_name = subcomponent_type
    end if
    !
    ! -- return
    return

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]	component	component, e.g. GWF6
[in]	subcomponent	subcomponent, e.g. CHD6

Definition at line 103 of file SourceCommon.f90.

    ! -- modules
    ! -- dummy
    character(len=*), intent(in) :: component !< component, e.g. GWF6
    character(len=*), intent(in) :: subcomponent !< subcomponent, e.g. CHD6
    ! -- return
    character(len=LENCOMPONENTNAME) :: subcomponent_type
    ! -- local
    character(len=LENCOMPONENTNAME) :: component_type
    integer(I4B) :: i, ilen, idx
    !
    ! -- initialize
    subcomponent_type = ''
    idx = 0
    !
    ! -- verify component
    component_type = idm_component_type(component)
    !
    ilen = len_trim(subcomponent)
    do i = 1, ilen
      if (subcomponent(i:i) == '6' .or. subcomponent(i:i) == '-') then
      else
        idx = idx + 1
        subcomponent_type(idx:idx) = subcomponent(i:i)
      end if
    end do
    !
    ! -- return
    return

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 407 of file SourceCommon.f90.

    use characterstringmodule, only: characterstringtype
    ! -- Find the first array element containing str
    ! -- Return -1 if not found.
    implicit none
    ! -- return
    integer(I4B) :: ifind_charstr
    ! -- dummy
    type(CharacterStringType), dimension(:), intent(in) :: array
    character(len=*) :: str
    character(len=LINELENGTH) :: compare_str
    ! -- local
    integer(I4B) :: i
    !
    ! -- initialize
    ifind_charstr = -1
    !
    findloop: do i = 1, size(array)
      compare_str = array(i)
      if (compare_str == str) then
        ifind_charstr = i
        exit findloop
      end if
    end do findloop
    !
    ! -- return
    return

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 33 of file SourceCommon.f90.

    ! -- modules
    use inputoutputmodule, only: upcase
    ! -- dummy
    character(len=*), intent(in) :: sourcename
    ! -- result
    character(len=LENPACKAGENAME) :: sourcetype
    ! -- local
    character(len=LENPACKAGENAME) :: ext
    !
    ext = file_ext(sourcename)
    !
    select case (ext)
    case default
      sourcetype = 'MF6FILE'
    end select
    !
    ! -- return
    return

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 234 of file SourceCommon.f90.

    use constantsmodule, only: disundef, dis, disv, disu, dis2d, disv1d
    use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
    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(:), pointer, contiguous, intent(inout) :: model_shape
    integer(I4B), pointer :: ndim1
    integer(I4B), pointer :: ndim2
    integer(I4B), pointer :: ndim3
    integer(I4B), pointer :: ncelldim
    integer(I4B), pointer :: distype
    integer(I4B) :: dim1_size, dim2_size, dim3_size, dis_type
    !
    ! -- initialize dis_type
    dis_type = disundef
    !
    ! -- allocate and set model shape in model input context
    select case (ftype)
    case ('DIS6')
      !
      ! -- set dis_type
      dis_type = dis
      !
      call get_isize('NLAY', dis_mempath, dim1_size)
      call get_isize('NROW', dis_mempath, dim2_size)
      call get_isize('NCOL', dis_mempath, dim3_size)
      !
      if (dim1_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NLAY" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim2_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NROW" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim3_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NCOL" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim1_size >= 1 .and. dim2_size >= 1 .and. dim3_size >= 1) then
        call mem_allocate(model_shape, 3, 'MODEL_SHAPE', model_mempath)
        call mem_setptr(ndim1, 'NLAY', dis_mempath)
        call mem_setptr(ndim2, 'NROW', dis_mempath)
        call mem_setptr(ndim3, 'NCOL', dis_mempath)
        model_shape = [ndim1, ndim2, ndim3]
      else
        call store_error_filename(fname)
      end if
      !
    case ('DIS2D6')
      !
      ! -- set dis_type
      dis_type = dis2d
      !
      call get_isize('NROW', dis_mempath, dim1_size)
      call get_isize('NCOL', dis_mempath, dim2_size)
      !
      if (dim1_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NROW" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim2_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NCOL" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim1_size >= 1 .and. dim2_size >= 1) then
        call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath)
        call mem_setptr(ndim1, 'NROW', dis_mempath)
        call mem_setptr(ndim2, 'NCOL', dis_mempath)
        model_shape = [ndim1, ndim2]
      else
        call store_error_filename(fname)
      end if
      !
    case ('DISV6')
      !
      ! -- set dis_type
      dis_type = disv
      !
      call get_isize('NLAY', dis_mempath, dim1_size)
      call get_isize('NCPL', dis_mempath, dim2_size)
      !
      if (dim1_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NLAY" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim2_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NCPL" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim1_size >= 1 .and. dim2_size >= 1) then
        call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath)
        call mem_setptr(ndim1, 'NLAY', dis_mempath)
        call mem_setptr(ndim2, 'NCPL', dis_mempath)
        model_shape = [ndim1, ndim2]
      else
        call store_error_filename(fname)
      end if
    case ('DISV2D6')
      !
      call get_isize('NODES', dis_mempath, dim1_size)
      !
      if (dim1_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NODES" not found.'
        call store_error(errmsg)
      end if
      !
      if (dim1_size >= 1) then
        call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath)
        call mem_setptr(ndim1, 'NODES', dis_mempath)
        model_shape = [ndim1]
      else
        call store_error_filename(fname)
      end if
    case ('DISU6', 'DISV1D6')
      !
      ! -- set dis_type
      if (ftype == 'DISU6') then
        dis_type = disu
      else if (ftype == 'DISV1D6') then
        dis_type = disv1d
      end if
      !
      call get_isize('NODES', dis_mempath, dim1_size)
      !
      if (dim1_size <= 0) then
        write (errmsg, '(a)') &
          'Required input dimension "NODES" not found.'
        call store_error(errmsg)
        call store_error_filename(fname)
      end if
      !
      call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath)
      call mem_setptr(ndim1, 'NODES', dis_mempath)
      model_shape = [ndim1]
    case default
      errmsg = 'Unknown discretization type.  IDM cannot set shape for "' &
               //trim(ftype)//"'"
      call store_error(errmsg)
      call store_error_filename(fname)
    end select
    !
    ! -- allocate and set ncelldim in model input context
    call mem_allocate(ncelldim, 'NCELLDIM', model_mempath)
    ncelldim = size(model_shape)
    !
    ! -- allocate and set distype in model input context
    ! TODO make sure this doesn't clash name GRIDTYPE, e.g.
    call mem_allocate(distype, 'DISENUM', model_mempath)
    distype = dis_type
    !
    ! -- return
    return

Here is the call graph for this function:

Here is the caller graph for this function: