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...
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 357 of file ModelPackageInputs.f90.

    ! -- modules
    ! -- dummy
    class(ModelPackageInputsType) :: this
    character(len=*), intent(in) :: pkgtype
    character(len=*), intent(in) :: filename
    character(len=*), intent(in) :: pkgname
    ! -- local
    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
    !
    ! -- return
    return

modelpkgs_addpkgs()

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

private

Definition at line 384 of file ModelPackageInputs.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    ! -- dummy
    class(ModelPackageInputsType) :: this
    ! -- local
    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)
      pname = pnames(n)
      !
      ! -- add this instance to package list
      call this%add(ftype, fname, pname)
    end do
    !
    ! --
    return

modelpkgs_create()

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

Definition at line 282 of file ModelPackageInputs.f90.

    ! -- modules
    use sortmodule, only: qsort
    ! -- dummy
    class(ModelPackageInputsType) :: this
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: ftypes
    ! -- local
    integer(I4B), dimension(:), allocatable :: cunit_idxs, indx
    character(len=LENPACKAGETYPE) :: ftype
    integer(I4B) :: n, m
    logical(LGP) :: found
    !
    ! -- allocate
    allocate (cunit_idxs(0))
    !
    ! -- 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.
      !
      ! -- 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
    !
    ! -- 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)
    !
    ! -- return
    return

Here is the call graph for this function:

modelpkgs_destroy()

subroutine modelpackageinputsmodule::modelpkgs_destroy

(

class(modelpackageinputstype)

this

)

Definition at line 514 of file ModelPackageInputs.f90.

    ! -- modules
    ! -- dummy
    class(ModelPackageInputsType) :: this
    ! -- local
    integer(I4B) :: n
    !
    ! --
    do n = 1, size(this%pkglist)
      call this%pkglist(n)%destroy()
    end do
    !
    deallocate (this%pkglist)
    deallocate (this%cunit)
    !
    ! -- return
    return

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

    ! -- modules
    use memoryhelpermodule, only: create_mem_path
    use memorymanagermodule, only: mem_allocate
    use simvariablesmodule, only: idm_context
    use sourcecommonmodule, only: idm_component_type
    use modelpackageinputmodule, only: supported_model_packages
    ! -- dummy
    class(ModelPackageInputsType) :: this
    character(len=*), intent(in) :: modeltype
    character(len=*), intent(in) :: modelfname
    character(len=*), intent(in) :: modelname
    integer(I4B), intent(in) :: iout
    ! -- local
    !
    ! -- initialize object
    this%modeltype = modeltype
    this%modelfname = modelfname
    this%modelname = modelname
    this%component_type = idm_component_type(modeltype)
    this%iout = iout
    !
    ! -- 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()
    !
    ! -- return
    return

Here is the call graph for this function:

modelpkgs_memload()

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

private

Definition at line 467 of file ModelPackageInputs.f90.

    ! -- modules
    use memorymanagermodule, only: mem_reallocate
    ! -- dummy
    class(ModelPackageInputsType) :: this
    ! -- local
    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
    !
    ! -- return
    return

modelpkgs_pkgcount()

integer(i4b) function modelpackageinputsmodule::modelpkgs_pkgcount

(

class(modelpackageinputstype)

this

)

Definition at line 425 of file ModelPackageInputs.f90.

    ! -- modules
    ! -- dummy
    class(ModelPackageInputsType) :: this
    !
    ! -- return
    integer(I4B) :: pnum
    ! -- local
    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
    !
    ! -- return
    return

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 92 of file ModelPackageInputs.f90.

    ! -- modules
    use idmdfnselectormodule, only: idm_integrated, idm_multi_package
    use modelpackageinputmodule, only: multi_package_type
    ! -- dummy
    character(len=LENCOMPONENTNAME), intent(in) :: mtype_component
    character(len=LENCOMPONENTNAME), intent(in) :: ptype_component
    character(len=LENFTYPE), intent(in) :: pkgtype
    ! -- return
    logical(LGP) :: multi_pkg
    ! -- local
    !
    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
    !
    ! -- return
    return

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.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    use memoryhelpermodule, only: create_mem_path
    use memorymanagerextmodule, only: mem_set_value
    use simvariablesmodule, only: idm_context
    use idmdfnselectormodule, only: idm_integrated, idm_multi_package
    use sourcecommonmodule, only: idm_subcomponent_name
    ! -- dummy
    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
    ! -- local
    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
      write (pname, '(a,i0)') trim(this%subcomponent_type)//'-', this%pnum
      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
    !
    ! -- return
    return

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 121 of file ModelPackageInputs.f90.

    ! -- modules
    use sourcecommonmodule, only: idm_subcomponent_type
    ! -- dummy
    class(LoadablePackageType) :: this
    character(len=*), intent(in) :: modeltype
    character(len=*), intent(in) :: modelname
    character(len=*), intent(in) :: pkgtype
    ! -- local
    !
    ! -- 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))
    !
    ! -- return
    return

Here is the call graph for this function:

pkgtype_destroy()

subroutine modelpackageinputsmodule::pkgtype_destroy

(

class(loadablepackagetype)

this

)

Definition at line 216 of file ModelPackageInputs.f90.

    ! -- modules
    ! -- dummy
    class(LoadablePackageType) :: this
    ! -- local
    !
    ! -- deallocate dynamic arrays
    deallocate (this%filenames)
    deallocate (this%pkgnames)
    deallocate (this%inunits)
    deallocate (this%mempaths)
    !
    ! -- return
    return