modelpackageinputsmodule Module Reference

This module contains the ModelPackageInputsModule. More...

Data Types
type	loadablepackagetype
	derived type for loadable package type More...
type	modelpackageinputstype
	derived type for model package inputs type More...

Functions/Subroutines
logical(lgp) function	multi_pkg_type (mtype_component, ptype_component, pkgtype)
	does model support multiple instances of this package type More...
logical(lgp) function, public	supported_model (ctype)
	is this a supported MODFLOW 6 model type More...
subroutine	pkgtype_create (this, modeltype, modelname, pkgtype)
	create a new package type More...
subroutine	pkgtype_add (this, modelname, mtype_component, filetype, filename, pkgname, iout)
	add a new package instance to this package type More...
subroutine	pkgtype_destroy (this)
	deallocate object More...
subroutine	modelpkgs_init (this, modeltype, modelfname, modelname, iout)
	initialize model package inputs object More...
subroutine	modelpkgs_create (this, ftypes)
	create the package type list More...
subroutine	modelpkgs_add (this, pkgtype, filename, pkgname)
	add a model package instance to package type list More...
subroutine	modelpkgs_addpkgs (this)
	build the type list with all model package instances More...
integer(i4b) function	modelpkgs_pkgcount (this)
	get package instance count and verify base or multi of each More...
subroutine	modelpkgs_memload (this)
	load package descriptors to managed memory More...
subroutine	modelpkgs_destroy (this)
	deallocate object More...

Detailed Description

This module contains the high-level routines for assembling model package information and loading to the input context

Function/Subroutine Documentation

modelpkgs_add()

subroutine modelpackageinputsmodule::modelpkgs_add	(	class(modelpackageinputstype)	this,
		character(len=*), intent(in)	pkgtype,
		character(len=*), intent(in)	filename,
		character(len=*), intent(in)	pkgname
	)

Definition at line 353 of file ModelPackageInputs.f90.

    class(ModelPackageInputsType) :: this
    character(len=*), intent(in) :: pkgtype
    character(len=*), intent(in) :: filename
    character(len=*), intent(in) :: pkgname
    type(LoadablePackageType) :: pkg
    integer(I4B) :: n
    ! locate index of pkgtype in pkglist
    do n = 1, size(this%pkglist)
      pkg = this%pkglist(n)
      if (pkg%pkgtype == pkgtype) then
        call this%pkglist(n)%add(this%modelname, this%component_type, &
                                 pkgtype, filename, pkgname, this%iout)
        exit
      end if
    end do

modelpkgs_addpkgs()

subroutine modelpackageinputsmodule::modelpkgs_addpkgs ( class(modelpackageinputstype)  this )

private

Definition at line 373 of file ModelPackageInputs.f90.

    use memorymanagermodule, only: mem_setptr
    use sourcecommonmodule, only: inlen_check
    class(ModelPackageInputsType) :: this
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: ftypes !< file types
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: fnames !< file names
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: pnames !< package names
    character(len=LINELENGTH) :: ftype, fname, pname
    integer(I4B) :: n
 
    ! set pointers to input context model package attribute arrays
    call mem_setptr(ftypes, 'FTYPE', this%input_mempath)
    call mem_setptr(fnames, 'FNAME', this%input_mempath)
    call mem_setptr(pnames, 'PNAME', this%input_mempath)
 
    ! create the package list
    call this%create(ftypes)
 
    ! load model packages
    do n = 1, size(ftypes)
      ! attributes for this package
      ftype = ftypes(n)
      fname = fnames(n)
      call inlen_check(pnames(n), pname, lenpackagename, 'PACKAGENAME')
 
      ! add this instance to package list
      call this%add(ftype, fname, pname)
    end do
 
    ! terminate if errors were detected
    if (count_errors() > 0) then
      call store_error_filename(this%modelfname)
    end if

Here is the call graph for this function:

modelpkgs_create()

subroutine modelpackageinputsmodule::modelpkgs_create	(	class(modelpackageinputstype)	this,
		type(characterstringtype), dimension(:), pointer, contiguous	ftypes
	)

Definition at line 272 of file ModelPackageInputs.f90.

    use sortmodule, only: qsort
    class(ModelPackageInputsType) :: this
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: ftypes
    integer(I4B), dimension(:), allocatable :: cunit_idxs, indx
    character(len=LENPACKAGETYPE) :: ftype
    integer(I4B) :: n, m
    logical(LGP) :: found, has_dis
 
    ! allocate
    allocate (cunit_idxs(0))
    has_dis = .false.
 
    ! identify input packages and check that each is supported
    do n = 1, size(ftypes)
      ! type from model nam file packages block
      ftype = ftypes(n)
      found = .false.
 
      ! check for discretization package (any type starting with 'DIS')
      if (ftype(1:3) == 'DIS') has_dis = .true.
 
      ! search supported types for this filetype
      do m = 1, this%niunit
        if (this%cunit(m) == ftype) then
          ! set found
          found = .true.
 
          ! add to cunit list if first instance of this type
          if (any(cunit_idxs == m)) then
            ! no-op
          else
            call expandarray(cunit_idxs)
            cunit_idxs(size(cunit_idxs)) = m
          end if
 
          ! exit search
          exit
        end if
      end do
 
      ! set error if namfile pkg filetype is not supported
      if (.not. found) then
        write (errmsg, '(a,a,a,a,a)') 'Model package type not supported &
          &[model=', trim(this%modelname), ', type=', &
          trim(ftype), '].'
        call store_error(errmsg)
        call store_error_filename(this%modelfname)
      end if
    end do
 
    ! check that a discretization package is specified
    if (.not. has_dis) then
      write (errmsg, '(3a)') &
        'Discretization package not specified for model "', &
        trim(this%modelname), '".'
      call store_error(errmsg)
      call store_error_filename(this%modelfname)
    end if
 
    ! allocate the pkglist
    allocate (this%pkglist(size(cunit_idxs)))
 
    ! sort cunit indexes
    allocate (indx(size(cunit_idxs)))
    call qsort(indx, cunit_idxs)
 
    ! create sorted LoadablePackageType object list
    do n = 1, size(cunit_idxs)
      call this%pkglist(n)%create(this%modeltype, this%modelname, &
                                  this%cunit(cunit_idxs(n)))
    end do
 
    ! cleanup
    deallocate (cunit_idxs)
    deallocate (indx)

Here is the call graph for this function:

modelpkgs_destroy()

subroutine modelpackageinputsmodule::modelpkgs_destroy

(

class(modelpackageinputstype)

this

)

Definition at line 486 of file ModelPackageInputs.f90.

    class(ModelPackageInputsType) :: this
    integer(I4B) :: n
    do n = 1, size(this%pkglist)
      call this%pkglist(n)%destroy()
    end do
    deallocate (this%pkglist)
    deallocate (this%cunit)

modelpkgs_init()

subroutine modelpackageinputsmodule::modelpkgs_init ( class(modelpackageinputstype)  this, character(len=*), intent(in)  modeltype, character(len=*), intent(in)  modelfname, character(len=*), intent(in)  modelname, integer(i4b), intent(in)  iout  )

private

Definition at line 222 of file ModelPackageInputs.f90.

    use memoryhelpermodule, only: create_mem_path
    use memorymanagermodule, only: mem_allocate
    use simvariablesmodule, only: idm_context, simfile
    use sourcecommonmodule, only: idm_component_type
    use modelpackageinputmodule, only: supported_model_packages
    class(ModelPackageInputsType) :: this
    character(len=*), intent(in) :: modeltype
    character(len=*), intent(in) :: modelfname
    character(len=*), intent(in) :: modelname
    integer(I4B), intent(in) :: iout
 
    ! initialize object
    this%modeltype = modeltype
    this%modelfname = modelfname
    this%modelname = modelname
    this%component_type = idm_component_type(modeltype)
    this%iout = iout
 
    ! verify user specified model type
    if (.not. supported_model(modeltype)) then
      ! -- error and exit for unsupported model type
      write (errmsg, '(3a)') 'Models block model type "', trim(modeltype), &
        '" is not valid.'
      call store_error(errmsg)
      call store_error_filename(simfile)
    end if
 
    ! allocate and set model supported package types
    call supported_model_packages(modeltype, this%cunit, this%niunit)
 
    ! set memory paths
    this%input_mempath = create_mem_path(this%modelname, 'NAM', idm_context)
    this%model_mempath = create_mem_path(component=this%modelname, &
                                         context=idm_context)
    ! allocate managed memory
    call mem_allocate(this%pkgtypes, lenpackagetype, 0, 'PKGTYPES', &
                      this%model_mempath)
    call mem_allocate(this%pkgnames, lenpackagename, 0, 'PKGNAMES', &
                      this%model_mempath)
    call mem_allocate(this%mempaths, lenmempath, 0, 'MEMPATHS', &
                      this%model_mempath)
    call mem_allocate(this%inunits, 0, 'INUNITS', this%model_mempath)
 
    ! build descriptions of packages
    call this%addpkgs()

Here is the call graph for this function:

modelpkgs_memload()

subroutine modelpackageinputsmodule::modelpkgs_memload ( class(modelpackageinputstype)  this )

private

Definition at line 446 of file ModelPackageInputs.f90.

    use memorymanagermodule, only: mem_reallocate
    class(ModelPackageInputsType) :: this
    integer(I4B) :: n, m, idx
    integer(I4B) :: pnum
 
    ! initialize load index
    idx = 0
 
    ! set total number of package instances
    pnum = this%pkgcount()
 
    ! reallocate model input package attribute arrays
    call mem_reallocate(this%pkgtypes, lenpackagetype, pnum, 'PKGTYPES', &
                        this%model_mempath)
    call mem_reallocate(this%pkgnames, lenpackagename, pnum, 'PKGNAMES', &
                        this%model_mempath)
    call mem_reallocate(this%mempaths, lenmempath, pnum, 'MEMPATHS', &
                        this%model_mempath)
    call mem_reallocate(this%inunits, pnum, 'INUNITS', this%model_mempath)
 
    ! load pkinfo
    do n = 1, size(this%pkglist)
      do m = 1, this%pkglist(n)%pnum
        ! increment index
        idx = idx + 1
        ! package type like 'CHD6'
        this%pkgtypes(idx) = trim(this%pkglist(n)%pkgtype)
        ! package name like 'CHD-2'
        this%pkgnames(idx) = trim(this%pkglist(n)%pkgnames(m))
        ! memory path like '__INPUT__/MYMODEL/CHD-2'
        this%mempaths(idx) = trim(this%pkglist(n)%mempaths(m))
        ! input file unit number
        this%inunits(idx) = this%pkglist(n)%inunits(m)
      end do
    end do

modelpkgs_pkgcount()

integer(i4b) function modelpackageinputsmodule::modelpkgs_pkgcount

(

class(modelpackageinputstype)

this

)

Definition at line 413 of file ModelPackageInputs.f90.

    class(ModelPackageInputsType) :: this
    integer(I4B) :: pnum
    integer(I4B) :: n
 
    ! initialize
    pnum = 0
 
    ! count model package instances
    do n = 1, size(this%pkglist)
      if (multi_pkg_type(this%component_type, &
                         this%pkglist(n)%subcomponent_type, &
                         this%pkglist(n)%pkgtype)) then
        ! multiple instances ok
      else
        ! set error for unexpected extra packages
        if (this%pkglist(n)%pnum > 1) then
          write (errmsg, '(a,a,a,a,a)') &
            'Multiple instances specified for model base package type &
            &[model=', trim(this%modelname), ', type=', &
            trim(this%pkglist(n)%pkgtype), '].'
          call store_error(errmsg)
          call store_error_filename(this%modelfname)
        end if
      end if
 
      ! add to package count
      pnum = pnum + this%pkglist(n)%pnum
    end do

Here is the call graph for this function:

multi_pkg_type()

logical(lgp) function modelpackageinputsmodule::multi_pkg_type ( character(len=lencomponentname), intent(in)  mtype_component, character(len=lencomponentname), intent(in)  ptype_component, character(len=lenftype), intent(in)  pkgtype  )

private

Definition at line 93 of file ModelPackageInputs.f90.

    use idmdfnselectormodule, only: idm_integrated, idm_multi_package
    use modelpackageinputmodule, only: multi_package_type
    character(len=LENCOMPONENTNAME), intent(in) :: mtype_component
    character(len=LENCOMPONENTNAME), intent(in) :: ptype_component
    character(len=LENFTYPE), intent(in) :: pkgtype
    logical(LGP) :: multi_pkg
    multi_pkg = .false.
    if (idm_integrated(mtype_component, ptype_component)) then
      multi_pkg = idm_multi_package(mtype_component, ptype_component)
    else
      multi_pkg = multi_package_type(mtype_component, ptype_component, pkgtype)
    end if

Here is the call graph for this function:

Here is the caller graph for this function:

pkgtype_add()

subroutine modelpackageinputsmodule::pkgtype_add	(	class(loadablepackagetype)	this,
		character(len=*), intent(in)	modelname,
		character(len=*), intent(in)	mtype_component,
		character(len=*), intent(in)	filetype,
		character(len=*), intent(in)	filename,
		character(len=*), intent(in)	pkgname,
		integer(i4b), intent(in)	iout
	)

Definition at line 148 of file ModelPackageInputs.f90.

    use memorymanagermodule, only: mem_allocate
    use memoryhelpermodule, only: create_mem_path
    use simvariablesmodule, only: idm_context
    use idmdfnselectormodule, only: idm_integrated, idm_multi_package
    use sourcecommonmodule, only: idm_subcomponent_name, idm_pkg_instance_name
    class(LoadablePackageType) :: this
    character(len=*), intent(in) :: modelname
    character(len=*), intent(in) :: mtype_component
    character(len=*), intent(in) :: filetype
    character(len=*), intent(in) :: filename
    character(len=*), intent(in) :: pkgname
    integer(I4B), intent(in) :: iout
    character(len=LENPACKAGENAME) :: sc_name, pname
    character(len=LENMEMPATH) :: mempath
    character(len=LINELENGTH), pointer :: cstr
 
    ! reallocate
    call expandarray(this%filenames)
    call expandarray(this%pkgnames)
    call expandarray(this%inunits)
    call expandarray(this%mempaths)
 
    ! add new package instance
    this%pnum = this%pnum + 1
    this%filenames(this%pnum) = filename
    this%pkgnames(this%pnum) = pkgname
    this%inunits(this%pnum) = 0
 
    ! set pkgname if empty
    if (this%pkgnames(this%pnum) == '') then
      if (multi_pkg_type(mtype_component, &
                         this%subcomponent_type, &
                         filetype)) then
        pname = idm_pkg_instance_name(this%subcomponent_type, &
                                      this%pnum)
      else
        write (pname, '(a)') trim(this%subcomponent_type)
      end if
      this%pkgnames(this%pnum) = pname
    end if
 
    ! set up input context for model
    if (idm_integrated(mtype_component, this%subcomponent_type)) then
      ! set subcomponent name
      sc_name = idm_subcomponent_name(mtype_component, this%subcomponent_type, &
                                      this%pkgnames(this%pnum))
      ! create and store the mempath
      this%mempaths(this%pnum) = &
        create_mem_path(modelname, sc_name, idm_context)
      ! allocate and initialize filename for package
      mempath = create_mem_path(modelname, sc_name, idm_context)
      call mem_allocate(cstr, linelength, 'INPUT_FNAME', mempath)
      cstr = filename
    else
      ! set mempath empty
      this%mempaths(this%pnum) = ''
    end if

Here is the call graph for this function:

pkgtype_create()

subroutine modelpackageinputsmodule::pkgtype_create	(	class(loadablepackagetype)	this,
		character(len=*), intent(in)	modeltype,
		character(len=*), intent(in)	modelname,
		character(len=*), intent(in)	pkgtype
	)

Definition at line 127 of file ModelPackageInputs.f90.

    use sourcecommonmodule, only: idm_subcomponent_type
    class(LoadablePackageType) :: this
    character(len=*), intent(in) :: modeltype
    character(len=*), intent(in) :: modelname
    character(len=*), intent(in) :: pkgtype
 
    ! initialize
    this%pkgtype = pkgtype
    this%subcomponent_type = idm_subcomponent_type(modeltype, pkgtype)
    this%pnum = 0
 
    ! allocate arrays
    allocate (this%filenames(0))
    allocate (this%pkgnames(0))
    allocate (this%mempaths(0))
    allocate (this%inunits(0))

Here is the call graph for this function:

pkgtype_destroy()

subroutine modelpackageinputsmodule::pkgtype_destroy

(

class(loadablepackagetype)

this

)

Definition at line 211 of file ModelPackageInputs.f90.

    class(LoadablePackageType) :: this
    ! deallocate dynamic arrays
    deallocate (this%filenames)
    deallocate (this%pkgnames)
    deallocate (this%inunits)
    deallocate (this%mempaths)

supported_model()

logical(lgp) function, public modelpackageinputsmodule::supported_model

(

character(len=*), intent(in)

ctype

)

Definition at line 111 of file ModelPackageInputs.f90.

    use modelpackageinputmodule, only: nmodel, modflow6models
    character(len=*), intent(in) :: ctype
    logical(LGP) :: supported_model
    integer(I4B) :: n
    supported_model = .false.
    do n = 1, nmodel
      if (ctype == modflow6models(n)) then
        supported_model = .true.
        exit
      end if
    end do

Here is the caller graph for this function: