NCContextBuild.f90

Go to the documentation of this file.

!> @brief This module contains the NCContextBuildModule
!!
!! Read NetCDF input file and add modflow6 input variables
!1 information to internal NCFileVarsType structure.
!!
!<
module nccontextbuildmodule
 
  use kindmodule, only: dp, i4b, lgp
  use constantsmodule, only: linelength, lencomponentname
  use simmodule, only: store_error, store_warning, store_error_filename
  use simvariablesmodule, only: errmsg, warnmsg
  use ncfilevarsmodule, only: ncfilevarstype
  use netcdfcommonmodule, only: nf_verify, netcdf_attr_strlen
  use netcdf
 
  implicit none
  private
  public :: open_ncfile
  public :: create_netcdf_context
 
contains
 
  !> @brief open netcdf file
  !<
  function open_ncfile(nc_fname, iout) result(ncid)
    use netcdfcommonmodule, only: nc_fopen
    character(len=*) :: nc_fname
    integer(I4B) :: iout
    integer(I4B) :: ncid
    logical(LGP) :: exists
 
    ! initialize
    ncid = 0
 
    ! check if NETCDF file exists
    inquire (file=nc_fname, exist=exists)
    if (.not. exists) then
      write (errmsg, '(a,a,a)') 'Specified NetCDF input file does &
        &not exist [file=', trim(nc_fname), '].'
      call store_error(errmsg, .true.)
    end if
 
    ! open
    ncid = nc_fopen(nc_fname, iout)
  end function open_ncfile
 
  !> @brief add a package input variable to nc_vars structure
  !<
  subroutine add_package_var(modeltype, modelname, nc_vars, input_name, varid, &
                             iout)
    use inputoutputmodule, only: lowcase, upcase
    use memoryhelpermodule, only: split_mem_path, mempathseparator
    use sourcecommonmodule, only: idm_subcomponent_type
    use sourcecommonmodule, only: idm_subcomponent_name
    character(len=*), intent(in) :: modeltype
    character(len=*), intent(in) :: modelname
    type(ncfilevarstype), intent(inout) :: nc_vars
    character(len=*), intent(in) :: input_name
    integer(I4B), intent(in) :: varid
    integer(I4B), intent(in) :: iout
    character(len=NETCDF_ATTR_STRLEN) :: input_str
    character(len=LENCOMPONENTNAME) :: c_name, sc_name
    character(len=LINELENGTH) :: mempath, varname
    integer(I4B) :: layer, iaux, mf6_layer, mf6_iaux, idx
    logical(LGP) :: success
 
    ! initialize
    layer = -1
    iaux = -1
    mempath = ''
    varname = ''
    c_name = ''
    sc_name = ''
 
    ! process mf6_input attribute
    if (nf90_get_att(nc_vars%ncid, varid, 'modflow_input', &
                     input_str) == nf90_noerr) then
      ! modflow_input is "<model>/<package>/<tagname>"; a tag name can be
      ! longer than a memory variable name, so split on the last separator
      idx = index(input_str, mempathseparator, back=.true.)
      success = (idx > 1 .and. idx < len_trim(input_str))
      if (success) then
        mempath = input_str(:idx - 1)
        varname = input_str(idx + 1:)
      end if
 
      if (success) then
        ! split the mempath
        call split_mem_path(mempath, c_name, sc_name)
        ! set read tokens to upper case
        call upcase(varname)
        call upcase(c_name)
        call upcase(sc_name)
        ! check for optional layer attribute
        if (nf90_get_att(nc_vars%ncid, varid, &
                         'layer', mf6_layer) == nf90_noerr) then
          layer = mf6_layer
        end if
 
        ! check for optional iaux attribute
        if (nf90_get_att(nc_vars%ncid, varid, &
                         'modflow_iaux', mf6_iaux) == nf90_noerr) then
          iaux = mf6_iaux
        end if
 
        ! add the variable to netcdf description
        call nc_vars%add(sc_name, varname, layer, iaux, varid)
      else
        errmsg = 'NetCDF variable invalid modflow_input attribute: "'// &
                 trim(input_str)//'".'
        call store_error(errmsg)
        call store_error_filename(nc_vars%nc_fname)
      end if
    end if
  end subroutine add_package_var
 
  !> @brief verify global attribute modflow_grid is present and return value
  !<
  function verify_global_attr(modeltype, modelname, input_name, nc_fname, ncid) &
    result(nctype)
    use inputoutputmodule, only: lowcase, upcase
    character(len=*), intent(in) :: modeltype
    character(len=*), intent(in) :: modelname
    character(len=*), intent(in) :: input_name
    character(len=*), intent(in) :: nc_fname
    integer(I4B), intent(in) :: ncid
    character(len=NETCDF_ATTR_STRLEN) :: grid, mesh, nctype
    integer(I4B) :: mesh_ierr
 
    ! initialize grid
    grid = ''
    mesh = ''
    nctype = ''
 
    ! verify expected mf6_modeltype file attribute
    if (nf90_get_att(ncid, nf90_global, "modflow_grid", &
                     grid) == nf90_noerr) then
      call upcase(grid)
      mesh_ierr = nf90_get_att(ncid, nf90_global, "modflow_mesh", mesh)
      if (mesh_ierr /= nf90_noerr) then
        ! fall back to the legacy unprefixed name for files written by
        ! older MF6 versions
        mesh_ierr = nf90_get_att(ncid, nf90_global, "mesh", mesh)
      end if
      if (mesh_ierr == nf90_noerr) then
        call upcase(mesh)
        if (mesh == 'LAYERED') then
          nctype = 'LAYERED MESH'
        else
          errmsg = 'NetCDF unsupported mesh type: "'//trim(mesh)//'".'
          call store_error(errmsg)
          call store_error_filename(nc_fname)
        end if
      else if (grid == 'STRUCTURED') then
        nctype = 'STRUCTURED'
      else if (grid == 'VERTEX' .or. grid == 'LAYERED MESH') then
        warnmsg = 'Verify "modflow_grid" and "modflow_mesh" global &
                  &attributes in file: '//trim(nc_fname)
        call store_warning(warnmsg)
        nctype = 'LAYERED MESH'
      end if
    else
      errmsg = 'NetCDF input file global attribute "modflow_grid" not found.'
      call store_error(errmsg)
      call store_error_filename(nc_fname)
    end if
  end function verify_global_attr
 
  !> @brief create internal description of modflow6 input variables in netcdf file
  !<
  subroutine create_netcdf_context(modeltype, modelname, input_name, &
                                   nc_vars, nc_fname, ncid, iout)
    use inputoutputmodule, only: lowcase, upcase
    character(len=*), intent(in) :: modeltype
    character(len=*), intent(in) :: modelname
    character(len=*), intent(in) :: input_name
    type(ncfilevarstype), intent(inout) :: nc_vars
    character(len=*), intent(in) :: nc_fname
    integer(I4B), intent(in) :: ncid
    integer(I4B), intent(in) :: iout
    integer(I4B) :: ndim, nvar, nattr, unlimdimid
    integer(I4B), dimension(:), allocatable :: varids
    character(len=LINELENGTH) :: grid
    integer(I4B) :: iparam
 
    ! check global attributes
    grid = verify_global_attr(modeltype, modelname, input_name, nc_fname, ncid)
 
    ! initialize netcdf input structure
    call nc_vars%init(modelname, nc_fname, ncid, grid)
 
    ! inquire for root dataset info
    call nf_verify(nf90_inquire(ncid, ndim, nvar, nattr, unlimdimid), &
                   nc_vars%nc_fname)
 
    ! allocate and set varids
    allocate (varids(nvar))
    call nf_verify(nf90_inq_varids(ncid, nvar, varids), nc_vars%nc_fname)
    do iparam = 1, nvar
      ! validate and add netcdf file input variable
      call add_package_var(modeltype, modelname, nc_vars, input_name, &
                           varids(iparam), iout)
    end do
 
    ! cleanup
    deallocate (varids)
  end subroutine create_netcdf_context
 
end module nccontextbuildmodule