SourceLoad.F90

Go to the documentation of this file.

!> @brief This module contains the SourceLoadModule
!!
!! This module contains the routines needed to generate
!! a loader object for an input source and routines
!! that distribute processing to a particular source.
!!
!<
module sourceloadmodule
 
  use kindmodule, only: dp, i4b, lgp
  use simvariablesmodule, only: errmsg
  use constantsmodule, only: linelength, lenmempath, lenmodelname, lenftype, &
                             lenpackagetype, lenpackagename
  use simmodule, only: store_error, store_error_filename
  use modflowinputmodule, only: modflowinputtype, getmodflowinput
 
  implicit none
  private
  public :: create_input_loader
  public :: open_source_file
  public :: load_modelnam, load_simnam, load_simtdis
  public :: remote_model_ndim
 
contains
 
  !> @brief factory function to create and setup model package static loader
  !<
  function create_input_loader(component_type, subcomponent_type, &
                               component_name, subcomponent_name, input_type, &
                               input_fname, component_fname) result(loader)
    use sourcecommonmodule, only: package_source_type, idm_subcomponent_name
    use inputloadtypemodule, only: staticpkgloadbasetype
    character(len=*), intent(in) :: component_type
    character(len=*), intent(in) :: subcomponent_type
    character(len=*), intent(in) :: component_name
    character(len=*), intent(in) :: subcomponent_name
    character(len=*), intent(in) :: input_type
    character(len=*), intent(in) :: input_fname
    character(len=*), intent(in) :: component_fname
    class(staticpkgloadbasetype), pointer :: loader
    type(modflowinputtype) :: mf6_input
    character(len=LENPACKAGENAME) :: source_type
    character(len=LENPACKAGENAME) :: sc_name
    !
    ! -- set subcomponent name
    sc_name = idm_subcomponent_name(component_type, subcomponent_type, &
                                    subcomponent_name)
    !
    ! -- create description of input
    mf6_input = getmodflowinput(input_type, component_type, subcomponent_type, &
                                component_name, sc_name, input_fname)
    !
    ! -- set package source
    source_type = package_source_type(input_fname)
    !
    ! -- set source loader for model package
    loader => package_loader(source_type)
    !
    ! -- initialize loader
    call loader%init(mf6_input, component_name, component_fname, input_fname)
    !
    ! -- return
    return
  end function create_input_loader
 
  !> @brief allocate source model package static loader
  !<
  function package_loader(source_type) result(loader)
    use inputloadtypemodule, only: staticpkgloadbasetype
    use idmmf6filemodule, only: mf6filestaticpkgloadtype
    character(len=*), intent(inout) :: source_type
    class(mf6filestaticpkgloadtype), pointer :: mf6file_loader
    class(staticpkgloadbasetype), pointer :: loader
    !
    ! -- initialize
    nullify (loader)
    !
    ! -- allocate derived object
    select case (source_type)
    case ('MF6FILE')
      allocate (mf6file_loader)
      loader => mf6file_loader
    case default
      write (errmsg, '(a)') &
        'Simulation package input source type "'//trim(source_type)// &
        '" not currently supported.'
      call store_error(errmsg, .true.)
    end select
    !
    ! -- return
    return
  end function package_loader
 
  function open_source_file(pkgtype, filename, modelfname, iout) result(fd)
    use sourcecommonmodule, only: package_source_type
    use idmmf6filemodule, only: open_mf6file
    character(len=*), intent(in) :: pkgtype
    character(len=*), intent(in) :: filename
    character(len=*), intent(in) :: modelfname
    integer(I4B), intent(in) :: iout
    integer(I4B) :: fd
    character(len=LENPACKAGENAME) :: source_type
    !
    ! -- initialize
    fd = 0
    !
    ! -- set source type
    source_type = package_source_type(filename)
    !
    select case (source_type)
    case ('MF6FILE')
      fd = open_mf6file(pkgtype, filename, modelfname, iout)
    case default
    end select
    !
    ! -- return
    return
  end function open_source_file
 
  subroutine load_modelnam(mtype, mfname, mname, iout)
    use simvariablesmodule, only: simfile
    use sourcecommonmodule, only: package_source_type, idm_component_type
    use idmmf6filemodule, only: input_load
    character(len=*), intent(in) :: mtype
    character(len=*), intent(in) :: mfname
    character(len=*), intent(in) :: mname
    integer(I4B), intent(in) :: iout
    type(modflowinputtype) :: mf6_input
    character(len=LENPACKAGENAME) :: source_type
    !
    ! -- set source type
    source_type = package_source_type(mfname)
    !
    ! -- create description of input
    mf6_input = getmodflowinput(mtype, idm_component_type(mtype), 'NAM', &
                                mname, 'NAM', mfname)
    !
    select case (source_type)
    case ('MF6FILE')
      call input_load(mfname, mf6_input, simfile, iout)
    case default
    end select
    !
    ! -- return
    return
  end subroutine load_modelnam
 
  subroutine load_simnam()
    use simvariablesmodule, only: simfile, iout
    use messagemodule, only: write_message
    use idmmf6filemodule, only: input_load
    type(modflowinputtype) :: mf6_input
    character(len=LINELENGTH) :: line
    logical :: lexist
    !
    ! -- load mfsim.nam if it exists
    inquire (file=trim(adjustl(simfile)), exist=lexist)
    !
    if (lexist) then
      !
      ! -- write name of namfile to stdout
      write (line, '(2(1x,a))') 'Using Simulation name file:', &
        trim(adjustl(simfile))
      call write_message(line, skipafter=1)
      !
      ! -- create description of input
      mf6_input = getmodflowinput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM', simfile)
      !
      ! -- open namfile and load to input context
      call input_load(simfile, mf6_input, simfile, iout)
    end if
    !
    ! -- return
    return
  end subroutine load_simnam
 
  subroutine load_simtdis()
    ! -- modules
    use simvariablesmodule, only: simfile, iout
    use memoryhelpermodule, only: create_mem_path
    use memorymanagermodule, only: mem_setptr
    use simvariablesmodule, only: idm_context
    use sourcecommonmodule, only: package_source_type
    use idmmf6filemodule, only: input_load
    ! -- dummy
    ! -- locals
    character(len=LENMEMPATH) :: input_mempath
    type(modflowinputtype) :: mf6_input
    character(len=LENPACKAGENAME) :: source_type
    character(len=:), pointer :: tdis6
    logical :: lexist
    !
    ! -- set input memory path
    input_mempath = create_mem_path('SIM', 'NAM', idm_context)
    !
    ! -- set pointers to input context timing params
    call mem_setptr(tdis6, 'TDIS6', input_mempath)
    !
    ! -- create timing
    if (tdis6 /= '') then
      !
      ! -- set source type
      source_type = package_source_type(tdis6)
      !
      select case (source_type)
      case ('MF6FILE')
        !
        inquire (file=trim(adjustl(tdis6)), exist=lexist)
        !
        if (lexist) then
          !
          ! -- create description of input
          mf6_input = getmodflowinput('TDIS6', 'SIM', 'TDIS', &
                                      'SIM', 'TDIS', simfile)
          !
          ! -- open namfile and load to input context
          call input_load(tdis6, mf6_input, simfile, iout)
          !
        else
          write (errmsg, '(a)') &
            'Simulation TIMING input file "'//trim(tdis6)// &
            '" does not exist.'
          call store_error(errmsg)
          call store_error_filename(simfile)
        end if
      case default
      end select
    end if
    !
    ! -- return
    return
  end subroutine load_simtdis
 
  function remote_model_ndim(mtype, mfname) result(ncelldim)
    use sourcecommonmodule, only: package_source_type
    use constantsmodule, only: linelength
    use inputoutputmodule, only: openfile, getunit
    use blockparsermodule, only: blockparsertype
    character(len=*), intent(in) :: mtype
    character(len=*), intent(in) :: mfname
    integer(I4B) :: ncelldim
    character(len=LENPACKAGENAME) :: source_type
    type(blockparsertype) :: parser
    integer(I4B) :: ierr, inunit
    logical(LGP) :: isfound, endofblock
    character(len=LINELENGTH) :: ptype
    !
    ! -- initialize
    ncelldim = 0
    !
    ! -- set source type
    source_type = package_source_type(mfname)
    !
    select case (source_type)
    case ('MF6FILE')
      !
      ! -- open name file
      inunit = getunit()
      call openfile(inunit, 0, trim(adjustl(mfname)), mtype, &
                    'FORMATTED', 'SEQUENTIAL', 'OLD')
      !
      ! -- initialize parser
      call parser%Initialize(inunit, 0)
      !
      ! -- get options block
      call parser%GetBlock('OPTIONS', isfound, ierr, &
                           supportopenclose=.true., blockrequired=.false.)
      ! -- iterate through options
      if (isfound) then
        do
          call parser%GetNextLine(endofblock)
          if (endofblock) exit
        end do
      end if
      !
      ! -- get packages block
      call parser%GetBlock('PACKAGES', isfound, ierr, &
                           supportopenclose=.true., blockrequired=.true.)
      if (isfound) then
        ! -- read through packages
        do
          call parser%GetNextLine(endofblock)
          if (endofblock) exit
          !
          call parser%GetStringCaps(ptype)
          !
          select case (ptype)
          case ('DIS6')
            ncelldim = 3
            exit
          case ('DIS2D6')
            ncelldim = 2
            exit
          case ('DISV6')
            ncelldim = 2
            exit
          case ('DISU6')
            ncelldim = 1
            exit
          case default
            write (errmsg, '(a)') &
              'Unknown discretization type "'//trim(ptype)// &
              '" not currently supported.'
            call store_error(errmsg, .true.)
          end select
        end do
      end if
      !
      call parser%clear()
      !
    case default
    end select
    !
    ! -- return
    return
  end function remote_model_ndim
 
end module sourceloadmodule