module GwfModule

  use KindModule,                  only: DP, I4B
  use InputOutputModule,           only: ParseLine, upcase
  use ConstantsModule,             only: LENFTYPE, DZERO, DTEN, DEP20
  use NumericalModelModule,        only: NumericalModelType
  use BaseDisModule,               only: DisBaseType
  use BndModule,                   only: BndType, AddBndToList, GetBndFromList
  use GwfIcModule,                 only: GwfIcType
  use GwfNpfModule,                only: GwfNpfType
  use Xt3dModule,                  only: Xt3dType
  use GwfHfbModule,                only: GwfHfbType
  use GwfStoModule,                only: GwfStoType
  use GwfMvrModule,                only: GwfMvrType
  use BudgetModule,                only: BudgetType
  use GwfOcModule,                 only: GwfOcType
  use GhostNodeModule,             only: GhostNodeType, gnc_cr
  use GwfObsModule,                only: GwfObsType, gwf_obs_cr
  use ObserveModule,               only: ObserveType
  use SimModule,                   only: count_errors, store_error,            &
                                         store_error_unit, ustop
  use BaseModelModule,             only: BaseModelType
  use ListModule,                  only: ListType

  implicit none

  private
  public :: gwf_cr
  public :: GwfModelType

  type, extends(NumericalModelType) :: GwfModelType

    type(GwfIcType),                pointer :: ic      => null()                ! initial conditions package
    type(GwfNpfType),               pointer :: npf     => null()                ! node property flow package
    type(Xt3dType),                 pointer :: xt3d    => null()                ! xt3d option for npf
    type(GwfStoType),               pointer :: sto     => null()                ! storage package
    type(GwfOcType),                pointer :: oc      => null()                ! output control package
    type(GhostNodeType),            pointer :: gnc     => null()                ! ghost node correction package
    type(GwfHfbType),               pointer :: hfb     => null()                ! horizontal flow barrier package
    type(GwfMvrType),               pointer :: mvr     => null()                ! water mover package
    type(GwfObsType),               pointer :: obs     => null()                ! observation package
    type(BudgetType),               pointer :: budget  => null()                ! budget object
    integer(I4B),                   pointer :: inic    => null()                ! unit number IC
    integer(I4B),                   pointer :: inoc    => null()                ! unit number OC
    integer(I4B),                   pointer :: innpf   => null()                ! unit number NPF
    integer(I4B),                   pointer :: insto   => null()                ! unit number STO
    integer(I4B),                   pointer :: inmvr   => null()                ! unit number MVR
    integer(I4B),                   pointer :: inhfb   => null()                ! unit number HFB
    integer(I4B),                   pointer :: ingnc   => null()                ! unit number GNC
    integer(I4B),                   pointer :: inobs   => null()                ! unit number OBS
    integer(I4B),                   pointer :: iss     => null()                ! steady state flag
    integer(I4B),                   pointer :: inewtonur => null()              ! newton under relaxation flag

  contains

    procedure :: model_df                => gwf_df
    procedure :: model_ac                => gwf_ac
    procedure :: model_mc                => gwf_mc
    procedure :: model_ar                => gwf_ar
    procedure :: model_rp                => gwf_rp
    procedure :: model_ad                => gwf_ad
    procedure :: model_cf                => gwf_cf
    procedure :: model_fc                => gwf_fc
    procedure :: model_cc                => gwf_cc
    procedure :: model_ptcchk            => gwf_ptcchk
    procedure :: model_ptc               => gwf_ptc
    procedure :: model_nur               => gwf_nur
    procedure :: model_bd                => gwf_bd
    procedure :: model_ot                => gwf_ot
    procedure :: model_fp                => gwf_fp
    procedure :: model_da                => gwf_da
    procedure :: get_nsubtimes           => gwf_get_nsubtimes
    procedure :: model_bdentry           => gwf_bdentry
    procedure :: get_iasym               => gwf_get_iasym
    ! -- private
    procedure :: allocate_scalars
    procedure :: package_create
    procedure :: ftype_check
    !
  end type GwfModelType

  ! -- Module variables constant for simulation
  integer(I4B), parameter :: NIUNIT=100
  character(len=LENFTYPE), dimension(NIUNIT) :: cunit
  data cunit/   'IC6  ', 'DIS6 ', 'DISU6', 'OC6  ', 'NPF6 ', & !  5
                'STO6 ', 'HFB6 ', 'WEL6 ', 'DRN6 ', 'RIV6 ', & ! 10
                'GHB6 ', 'RCH6 ', 'EVT6 ', 'OBS6 ', 'GNC6 ', & ! 15
                '     ', 'CHD6 ', '     ', '     ', '     ', & ! 20
                '     ', 'MAW6 ', 'SFR6 ', 'LAK6 ', 'UZF6 ', & ! 25
                'DISV6', 'MVR6 ', '     ', '     ', '     ', & ! 30
                70 * '     '/

  contains

  subroutine gwf_cr(filename, id, modelname, smr)
! ******************************************************************************
! gwf_cr -- Create a new groundwater flow model object
! Subroutine: (1) creates model object and add to modellist
!             (2) assign values
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use ListsModule,                only: basemodellist
    use BaseModelModule,            only: AddBaseModelToList
    use SimModule,                  only: ustop, store_error, count_errors
    use InputOutputModule,          only: write_centered
    use ConstantsModule,            only: VERSION, MFVNAM, MFTITLE,            &
                                          FMTDISCLAIMER, LINELENGTH,           &
                                          LENPACKAGENAME, IDEVELOPMODE
    use CompilerVersion
    use MemoryManagerModule,        only: mem_allocate
    use GwfDisModule,               only: dis_cr
    use GwfDisvModule,              only: disv_cr
    use GwfDisuModule,              only: disu_cr
    use GwfNpfModule,               only: npf_cr
    use Xt3dModule,                 only: xt3d_cr
    use GwfStoModule,               only: sto_cr
    use GwfMvrModule,               only: mvr_cr
    use GwfHfbModule,               only: hfb_cr
    use GwfIcModule,                only: ic_cr
    use GwfOcModule,                only: oc_cr
    use BudgetModule,               only: budget_cr
    use NameFileModule,             only: NameFileType
    ! -- dummy
    character(len=*), intent(in)  :: filename
    integer(I4B), intent(in)           :: id
    character(len=*), intent(in)  :: modelname
    logical, optional, intent(in) :: smr
    ! -- local
    integer(I4B) :: indis, indis6, indisu6, indisv6
    integer(I4B) :: ipakid, i, j, iu, ipaknum
    character(len=LINELENGTH) :: errmsg
    character(len=LENPACKAGENAME) :: pakname
    type(NameFileType) :: namefile_obj
    type(GwfModelType), pointer        :: this
    class(BaseModelType), pointer       :: model
    integer(I4B) :: nwords
    character(len=LINELENGTH), allocatable, dimension(:) :: words
    character(len=80) :: compiler
    ! -- format
! ------------------------------------------------------------------------------
    !
    ! -- Allocate a new GWF Model (this) and add it to basemodellist
    allocate(this)
    call this%allocate_scalars(modelname)
    model => this
    call AddBaseModelToList(basemodellist, model)
    !
    ! -- Assign values
    this%filename = filename
    this%name = modelname
    this%macronym = 'GWF'
    this%id = id
    if(present(smr)) this%single_model_run = smr
    !
    ! -- Open namefile and set iout
    call namefile_obj%init(this%filename, 0)
    call namefile_obj%add_cunit(niunit, cunit)
    call namefile_obj%openlistfile(this%iout)
    !
    ! -- Write title to list file
    call write_centered('MODFLOW'//MFVNAM, this%iout, 80)
    call write_centered(MFTITLE, this%iout, 80)
    call write_centered('GROUNDWATER FLOW MODEL (GWF)', this%iout, 80)
    call write_centered('VERSION '//VERSION, this%iout, 80)
    !
    ! -- Write if develop mode
    if (IDEVELOPMODE == 1) call write_centered('***DEVELOP MODE***',           &
      this%iout, 80)
    !
    ! -- Write compiler version
    call get_compiler(compiler)
    call write_centered(' ', this%iout, 80)
    call write_centered(trim(adjustl(compiler)), this%iout, 80)
    !
    ! -- Write disclaimer
    write(this%iout, FMTDISCLAIMER)
    !
    ! -- Write precision of real variables
    write(this%iout, '(/,a)') 'MODFLOW was compiled using uniform precision.'
    write(this%iout, '(a,i0,/)') 'Precision of REAL variables: ',              &
                                 precision(DZERO)
    !
    ! -- Open files
    call namefile_obj%openfiles(this%iout)
    !
    ! -- GWF options
    if (size(namefile_obj%opts) > 0) then
      write(this%iout, '(1x,a)') 'NAMEFILE OPTIONS:'
    end if
    !
    ! -- Parse options in the GWF name file
    do i = 1, size(namefile_obj%opts)
      call ParseLine(namefile_obj%opts(i), nwords, words)
      call upcase(words(1))
      select case(words(1))
        case('NEWTON')
          this%inewton = 1
          write(this%iout, '(4x,a)')                                           &
                            'NEWTON-RAPHSON method enabled for the model.'
          if (nwords > 1) then
            call upcase(words(2))
            if (words(2) == 'UNDER_RELAXATION') then
              this%inewtonur = 1
              write(this%iout, '(4x,a,a)')                                     &
                'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ',        &
                'elevation of the model will be applied to the model.'
            end if
          end if
        case ('PRINT_INPUT')
          this%iprpak = 1
          write(this%iout,'(4x,a)') 'STRESS PACKAGE INPUT WILL BE PRINTED '//  &
                                    'FOR ALL MODEL STRESS PACKAGES'
        case ('PRINT_FLOWS')
          this%iprflow = 1
          write(this%iout,'(4x,a)') 'PACKAGE FLOWS WILL BE PRINTED '//         &
                                    'FOR ALL MODEL PACKAGES'
        case ('SAVE_FLOWS')
          this%ipakcb = -1
          write(this%iout, '(4x,a)')                                           &
            'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
        case default
          write(errmsg,'(4x,a,a,a,a)')                                         &
            '****ERROR. UNKNOWN GWF NAMEFILE (',                               &
            trim(adjustl(this%filename)), ') OPTION: ',                        &
            trim(adjustl(namefile_obj%opts(i)))
          call store_error(errmsg)
          call ustop()
      end select
    end do
    !
    ! -- Assign unit numbers to attached modules, and remove
    ! -- from unitnumber (by specifying 1 for iremove)
    !
    indis = 0
    indis6 = 0
    indisu6 = 0
    indisv6 = 0
    call namefile_obj%get_unitnumber('DIS6', indis6, 1)
    if(indis6 > 0) indis = indis6
    if(indis <= 0) call namefile_obj%get_unitnumber('DISU6', indisu6, 1)
    if(indisu6 > 0) indis = indisu6
    if(indis <= 0) call namefile_obj%get_unitnumber('DISV6', indisv6, 1)
    if(indisv6 > 0) indis = indisv6
    call namefile_obj%get_unitnumber('IC6',  this%inic, 1)
    call namefile_obj%get_unitnumber('OC6',  this%inoc, 1)
    call namefile_obj%get_unitnumber('NPF6', this%innpf, 1)
    call namefile_obj%get_unitnumber('STO6', this%insto, 1)
    call namefile_obj%get_unitnumber('MVR6', this%inmvr, 1)
    call namefile_obj%get_unitnumber('HFB6', this%inhfb, 1)
    call namefile_obj%get_unitnumber('GNC6', this%ingnc, 1)
    call namefile_obj%get_unitnumber('OBS6', this%inobs, 1)
    !
    ! -- Check to make sure that required ftype's have been specified
    call this%ftype_check(namefile_obj, indis)
    !
    ! -- Create discretization object
    if(indis6 > 0) then
      call dis_cr(this%dis, this%name, indis, this%iout)
    elseif(indisu6 > 0) then
      call disu_cr(this%dis, this%name, indis, this%iout)
    elseif(indisv6 > 0) then
      call disv_cr(this%dis, this%name, indis, this%iout)
    endif
    !
    ! -- Create utility objects
    call budget_cr(this%budget, this%name)
    !
    ! -- Create packages that are tied directly to model
    call npf_cr(this%npf, this%name, this%innpf, this%iout)
    call xt3d_cr(this%xt3d, this%name, this%innpf, this%iout)
    call gnc_cr(this%gnc, this%name, this%ingnc, this%iout)
    call hfb_cr(this%hfb, this%name, this%inhfb, this%iout)
    call sto_cr(this%sto, this%name, this%insto, this%iout)
    call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis)
    call mvr_cr(this%mvr, this%name, this%inmvr, this%iout)
    call oc_cr(this%oc, this%name, this%inoc, this%iout)
    call gwf_obs_cr(this%obs, this%inobs)
    !
    ! -- Create stress packages
    ipakid = 1
    do i = 1, niunit
      ipaknum = 1
      do j = 1, namefile_obj%get_nval_for_row(i)
        iu = namefile_obj%get_unitnumber_rowcol(i, j)
        call namefile_obj%get_pakname(i, j, pakname)
        call this%package_create(cunit(i), ipakid, ipaknum, pakname, iu,       &
          this%iout)
        ipaknum = ipaknum + 1
        ipakid = ipakid + 1
      enddo
    enddo
    !
    ! -- return
    return
  end subroutine gwf_cr

  subroutine gwf_df(this)
! ******************************************************************************
! gwf_df -- Define packages of the model
! Subroutine: (1) call df routines for each package
!             (2) set gwf variables and pointers
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    ! -- dummy
    class(GwfModelType) :: this
    ! -- local
    integer(I4B) :: ip
    class(BndType), pointer :: packobj
! ------------------------------------------------------------------------------
    !
    ! -- Define packages and utility objects
    call this%dis%dis_df()
    call this%npf%npf_df(this%xt3d)
    call this%oc%oc_df()
    call this%budget%budget_df(niunit, 'VOLUME', 'L**3')
    if(this%ingnc > 0) call this%gnc%gnc_df(this)
    !
    ! -- Assign or point model members to dis members
    this%neq = this%dis%nodes
    this%nja = this%dis%nja
    this%ia  => this%dis%con%ia
    this%ja  => this%dis%con%ja
    !
    ! -- Allocate model arrays, now that neq and nja are assigned
    call this%allocate_arrays()
    !
    ! -- Define packages and assign iout for time series managers
    do ip=1,this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_df(this%neq, this%dis)
    enddo
    !
    ! -- Store information needed for observations
    call this%obs%obs_df(this%iout, this%name, 'GWF', this%dis)
    !
    ! -- return
    return
  end subroutine gwf_df

  subroutine gwf_ac(this, sparse)
! ******************************************************************************
! gwf_ac -- Add the internal connections of this model to the sparse matrix
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use SparseModule, only: sparsematrix
    ! -- dummy
    class(GwfModelType) :: this
    type(sparsematrix), intent(inout) :: sparse
    ! -- local
    class(BndType), pointer :: packobj
    integer(I4B) :: ip
! ------------------------------------------------------------------------------
    !
    ! -- Add the internal connections of this model to sparse
    call this%dis%dis_ac(this%moffset, sparse)
    !
    ! -- Add any additional connections that NPF may need
    if(this%innpf > 0) call this%npf%npf_ac(this%moffset, sparse,              &
      this%dis%nodes, this%ia, this%ja)
    !
    ! -- Add any package connections
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_ac(this%moffset, sparse)
    enddo
    !
    ! -- If GNC is active, then add the gnc connections to sparse
    if(this%ingnc > 0) call this%gnc%gnc_ac(sparse)
    !
    ! -- return
    return
  end subroutine gwf_ac

  subroutine gwf_mc(this, iasln, jasln)
! ******************************************************************************
! gwf_mc -- Map the positions of this models connections in the
! numerical solution coefficient matrix.
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B), dimension(:), intent(in) :: iasln
    integer(I4B), dimension(:), intent(in) :: jasln
    ! -- local
    class(BndType), pointer :: packobj
    integer(I4B) :: ip
! ------------------------------------------------------------------------------
    !
    ! -- Find the position of each connection in the global ia, ja structure
    !    and store them in idxglo.
    call this%dis%dis_mc(this%moffset, this%idxglo, iasln, jasln)
    !
    ! -- Map any additional connections that NPF may need
    if(this%innpf > 0) call this%npf%npf_mc(this%moffset, this%dis%nodes,      &
      this%ia, this%ja, iasln, jasln)
    !
    ! -- Map any package connections
    do ip=1,this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_mc(this%moffset, iasln, jasln)
    enddo
    !
    ! -- For implicit gnc, need to store positions of gnc connections
    !    in solution matrix connection
    if(this%ingnc > 0) call this%gnc%gnc_mc(iasln, jasln)
    !
    ! -- return
    return
  end subroutine gwf_mc

  subroutine gwf_ar(this)
! ******************************************************************************
! gwf_ar -- GroundWater Flow Model Allocate and Read
! Subroutine: (1) allocates and reads packages part of this model,
!             (2) allocates memory for arrays part of this model object
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- dummy
    class(GwfModelType) :: this
    ! -- locals
    integer(I4B) :: ip
    class(BndType), pointer :: packobj
! ------------------------------------------------------------------------------
    !
    ! -- Allocate and read modules attached to model
    if(this%inic  > 0) call this%ic%ic_ar(this%x)
    if(this%innpf > 0) call this%npf%npf_ar(this%dis, this%ic,                 &
                                            this%ibound, this%x)
    if(this%inhfb > 0) call this%hfb%hfb_ar(this%ibound, this%xt3d, this%dis)
    if(this%insto > 0) call this%sto%sto_ar(this%dis, this%ibound)
    if(this%inmvr > 0) call this%mvr%mvr_ar()
    if(this%inobs > 0) call this%obs%gwf_obs_ar(this%ic, this%x, this%flowja)
    !
    ! -- Call dis_ar to write binary grid file
    call this%dis%dis_ar(this%npf%icelltype)
    !
    ! -- set up output control
    call this%oc%oc_ar(this%x, this%dis, this%npf%hnoflo)
    !
    ! -- Package input files now open, so allocate and read
    do ip=1,this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%set_pointers(this%dis%nodes, this%ibound, this%x,           &
                                this%xold, this%flowja)
      ! -- Read and allocate package
      call packobj%bnd_ar()
    enddo
    !
    ! -- return
    return
  end subroutine gwf_ar

  subroutine gwf_rp(this)
! ******************************************************************************
! gwf_rp -- GroundWater Flow Model Read and Prepare
! Subroutine: (1) calls package read and prepare routines
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use TdisModule, only: readnewdata
    ! -- dummy
    class(GwfModelType) :: this
    ! -- local
    class(BndType), pointer :: packobj
    integer(I4B) :: ip
! ------------------------------------------------------------------------------
    !
    ! -- Check with TDIS on whether or not it is time to RP
    if (.not. readnewdata) return
    !
    ! -- Read and prepare
    if(this%inhfb > 0) call this%hfb%hfb_rp()
    if(this%inoc > 0)  call this%oc%oc_rp()
    if(this%insto > 0) call this%sto%sto_rp()
    if(this%inmvr > 0) call this%mvr%mvr_rp()
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_rp()
      call packobj%bnd_rp_obs()
    enddo
    !
    ! -- Return
    return
  end subroutine gwf_rp

  subroutine gwf_ad(this, ipicard, isubtime)
! ******************************************************************************
! gwf_ad -- GroundWater Flow Model Time Step Advance
! Subroutine: (1) calls package advance subroutines
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use SimVariablesModule, only: isimcheck
    ! -- dummy
    class(GwfModelType) :: this
    class(BndType), pointer :: packobj
    integer(I4B), intent(in) :: ipicard
    integer(I4B), intent(in) :: isubtime
    ! -- local
    integer(I4B) :: ip, n
! ------------------------------------------------------------------------------
    !
    ! -- copy x into xold
    do n=1,this%dis%nodes
      this%xold(n)=this%x(n)
    enddo
    !
    ! -- Advance
    if(this%innpf > 0) call this%npf%npf_ad(this%dis%nodes, this%xold)
    if(this%insto > 0) call this%sto%sto_ad()
    if(this%inmvr > 0) call this%mvr%mvr_ad()
    do ip=1,this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_ad()
      if (isimcheck > 0) then
        call packobj%bnd_ck()
      end if
    enddo
    !
    ! -- Push simulated values to preceding time/subtime step
    call this%obs%obs_ad()
    !
    ! -- return
    return
  end subroutine gwf_ad

  subroutine gwf_cf(this, kiter)
! ******************************************************************************
! gwf_cf -- GroundWater Flow Model calculate coefficients
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B),intent(in) :: kiter
    ! -- local
    class(BndType), pointer :: packobj
    integer(I4B) :: ip
! ------------------------------------------------------------------------------
    !
    ! -- Call package cf routines
    if(this%innpf > 0) call this%npf%npf_cf(kiter, this%dis%nodes, this%x)
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_cf()
    enddo
    !
    ! -- return
    return
  end subroutine gwf_cf

  subroutine gwf_fc(this, kiter, amatsln, njasln, inwtflag)
! ******************************************************************************
! gwf_fc -- GroundWater Flow Model fill coefficients
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B), intent(in) :: kiter
    integer(I4B), intent(in) :: njasln
    real(DP), dimension(njasln), intent(inout) :: amatsln
    integer(I4B), intent(in) :: inwtflag
    ! -- local
    class(BndType), pointer :: packobj
    integer(I4B) :: ip
    integer(I4B) :: inwt, inwtsto, inwtpak
! ------------------------------------------------------------------------------
    !
    ! -- newton flags
    inwt = inwtflag
    if(inwtflag == 1) inwt = this%npf%inewton
    inwtsto = inwtflag
    if(this%insto > 0) then
      if(inwtflag == 1) inwtsto = this%sto%inewton
    endif
    !
    ! -- Fill standard conductance terms
    if(this%innpf > 0) call this%npf%npf_fc(kiter, this%dis%nodes,             &
                                                this%nja, njasln, amatsln,     &
                                                this%idxglo, this%rhs, this%x)
    if(this%inhfb > 0) call this%hfb%hfb_fc(kiter, this%dis%nodes,             &
                                                this%nja, njasln, amatsln,     &
                                                this%idxglo, this%rhs, this%x)
    if(this%ingnc > 0) call this%gnc%gnc_fc(kiter, this%ia, amatsln)
    if(this%insto > 0) then
      call this%sto%sto_fc(kiter, this%dis%nodes, this%xold,                   &
                            this%x, this%nja, njasln,                          &
                            amatsln, this%idxglo, this%rhs)
    end if
    if(this%inmvr > 0) call this%mvr%mvr_fc()
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_fc(this%rhs, this%ia, this%idxglo, amatsln)
    enddo
    !
    !--Fill newton terms
    if(this%innpf > 0) then
      if(inwt /= 0) then
        call this%npf%npf_fn(kiter, this%dis%nodes, this%nja, njasln,          &
                             amatsln, this%idxglo, this%rhs, this%x)
      endif
    endif
    !
    ! -- Fill newton terms for ghost nodes
    if(this%ingnc > 0) then
      if(inwt /= 0) then
        call this%gnc%gnc_fn(kiter, njasln, amatsln, this%npf%condsat,         &
          ivarcv_opt=this%npf%ivarcv,                                          &
          ictm1_opt=this%npf%icelltype,                                        &
          ictm2_opt=this%npf%icelltype)
      endif
    endif
    !
    ! -- Fill newton terms for storage
    if(this%insto > 0) then
      if (inwtsto /= 0) then
        call this%sto%sto_fn(kiter, this%dis%nodes, this%xold, this%x,         &
                              this%nja, njasln, amatsln, this%idxglo, this%rhs)
      end if
    end if
    !
    ! -- Fill Newton terms for packages
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      inwtpak = inwtflag
      if(inwtflag == 1) inwtpak = packobj%inewton
      if (inwtpak /= 0) then
        call packobj%bnd_fn(this%rhs, this%ia, this%idxglo, amatsln)
      end if
    enddo
    !
    ! -- return
    return
  end subroutine gwf_fc

  subroutine gwf_cc(this, kiter, iend, icnvg)
! ******************************************************************************
! gwf_cc -- GroundWater Flow Model Final Convergence Check for Boundary Packages
! Subroutine: (1) calls package cc routines
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B),intent(in) :: kiter
    integer(I4B),intent(in) :: iend
    integer(I4B),intent(inout) :: icnvg
    ! -- local
    class(BndType), pointer :: packobj
    integer(I4B) :: ip
    ! -- formats
! ------------------------------------------------------------------------------
    !
    ! -- If mover is on, then at least 2 outers required
    if (this%inmvr > 0) call this%mvr%mvr_cc(kiter, iend, icnvg)
    !
    ! -- Call package cc routines
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_cc(iend, icnvg)
    enddo
    !
    ! -- return
    return
  end subroutine gwf_cc

  subroutine gwf_ptcchk(this, iptc)
! ******************************************************************************
! gwf_ptc -- check if pseudo-transient continuation factor should be used
! Subroutine: (1) Check if pseudo-transient continuation factor should be used
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! modules
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B), intent(inout) :: iptc
! ------------------------------------------------------------------------------
    ! -- determine if pseudo-transient continuation should be applied to this
    !    model - pseudo-transient continuation only appled to problems without
    !    storage
    iptc = 0
    if (this%iss > 0) then
      if (this%insto == 0) then
        ! -- and problems using Newton-Raphson
        if (this%inewton > 0) then
          iptc = this%inewton
        else
          iptc = this%npf%inewton
        end if
      end if
    end if
    !
    ! -- return
    return
  end subroutine gwf_ptcchk

  subroutine gwf_ptc(this, kiter, neqsln, njasln, ia, ja,                       &
                     x, rhs, amatsln, iptc, ptcf)
! ******************************************************************************
! gwf_ptc -- calculate maximum pseudo-transient continuation factor
! Subroutine: (1) Calculate maximum pseudo-transient continuation factor
!                 for the current outer iteration
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! modules
    use ConstantsModule, only: DONE, DP9
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B),intent(in) :: kiter
    integer(I4B), intent(in) :: neqsln
    integer(I4B),intent(in) :: njasln
    integer(I4B), dimension(neqsln+1), intent(in) :: ia
    integer(I4B),dimension(njasln),intent(in) :: ja
    real(DP), dimension(neqsln), intent(in) :: x
    real(DP), dimension(neqsln), intent(in) :: rhs
    real(DP),dimension(njasln),intent(in) :: amatsln
    integer(I4B), intent(inout) :: iptc
    real(DP),intent(inout) :: ptcf
    ! -- local
    integer(I4B) :: iptct
    integer(I4B) :: n
    integer(I4B) :: jcol
    integer(I4B) :: j, jj
    real(DP) :: v
    real(DP) :: q
    real(DP) :: diag
    real(DP) :: diagcnt
    real(DP) :: diagmin
! ------------------------------------------------------------------------------
    ! -- set temporary flag indicating if pseudo-transient continuation should
    !    be used for this model and time step
    iptct = 0
    ! -- only apply pseudo-transient continuation for problems without storage
    if (this%iss > 0) then
      if (this%insto == 0) then
        ! -- and problems using Newton-Raphson
        if (this%inewton > 0) then
          iptct = this%inewton
        else
          iptct = this%npf%inewton
        end if
      end if
    end if
    !
    ! -- calculate pseudo-transient continuation factor for model
    if (iptct > 0) then
      diagmin = DEP20
      diagcnt = DZERO
      do n = 1, this%dis%nodes
        if (this%npf%ibound(n) < 1) cycle
        jcol = n + this%moffset
        v = this%dis%get_cell_volume(n, x(jcol))
        if (v > DZERO) then
          q = DZERO
          do j = ia(jcol), ia(jcol+1)-1
            jj = ja(j)
            q = q + amatsln(j) * x(jcol)
          end do
          q = q - rhs(jcol)
        else
          cycle
        end if
        q = q / v
        if (abs(q) > ptcf) ptcf = abs(q)
        j = ia(jcol)
        diag = abs(amatsln(j))
        diagcnt = diagcnt + DONE
        if (diag > DZERO) then
          if (diag < diagmin) diagmin = diag
        end if
      end do
      if (diagcnt > DZERO) then
        if (ptcf < diagmin) ptcf = diagmin
      end if
    end if

    ! reset ipc if needed
    if (iptc == 0) then
      if (iptct > 0) iptc = 1
    end if
    !
    ! -- return
    return
  end subroutine gwf_ptc

  subroutine gwf_nur(this, neqmod, x, xtemp, inewtonur)
! ******************************************************************************
! gwf_nur -- under-relaxation
! Subroutine: (1) Under-relaxation of Groundwater Flow Model Heads for current
!                 outer iteration using the cell bottoms at the bottom of the
!                 model
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! modules
    use ConstantsModule, only: DONE, DP9
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B), intent(in) :: neqmod
    real(DP), dimension(neqmod), intent(inout) :: x
    real(DP), dimension(neqmod), intent(in) :: xtemp
    integer(I4B), intent(inout) :: inewtonur
    ! -- local
    !integer(I4B) :: n
    !integer(I4B) :: jcol
    !real(DP) :: botm
    integer(I4B) :: i0
    integer(I4B) :: i1
    class(BndType), pointer :: packobj
    integer(I4B) :: ip
! ------------------------------------------------------------------------------
    !
    ! -- apply Newton-Raphson under-relaxation if model is using
    !    the Newton-Raphson formulation and this Newton-Raphson
    !    under-relaxation is turned on.
    if (this%inewton /= 0 .and. this%inewtonur /= 0) then
      if (this%innpf > 0) then
        call this%npf%npf_nur(neqmod, x, xtemp, inewtonur)
      end if
      !
      ! -- Call package nur routines
      i0 = this%dis%nodes + 1
      do ip = 1, this%bndlist%Count()
        packobj => GetBndFromList(this%bndlist, ip)
        if (packobj%npakeq > 0) then
          i1 = i0 + packobj%npakeq - 1
          call packobj%bnd_nur(packobj%npakeq, x(i0:i1), xtemp(i0:i1), inewtonur)
          i0 = i1 + 1
        end if
      enddo
    end if
    !
    ! -- return
    return
  end subroutine gwf_nur

  subroutine gwf_bd(this, icnvg, isuppress_output)
! ******************************************************************************
! gwf_bd --GroundWater Flow Model Budget
! Subroutine: (1) Calculate intercell flows (flowja)
!             (2) Calculate stress package contributions to model budget
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    use ConstantsModule, only: DZERO
    ! -- dummy
    class(GwfModelType) :: this
    integer(I4B), intent(in) :: icnvg
    integer(I4B), intent(in) :: isuppress_output
    ! -- local
    integer(I4B) :: icbcfl, ibudfl, icbcun, iprobs, idvfl
    integer(I4B) :: ip
    integer(I4B) :: i
    class(BndType),pointer :: packobj
! ------------------------------------------------------------------------------
    !
    ! -- Save the solution convergence flag
    this%icnvg = icnvg
    !
    ! -- Set write and print flags differently if output is suppressed.
    if(isuppress_output == 0) then
      idvfl = 0
      if(this%oc%oc_save('HEAD')) idvfl = 1
      icbcfl = 0
      if(this%oc%oc_save('BUDGET')) icbcfl = 1
      icbcun = this%oc%oc_save_unit('BUDGET')
      ibudfl = 0
      if(this%oc%oc_print('BUDGET')) ibudfl = 1
      iprobs = 1
    else
      icbcfl = 0
      ibudfl = 0
      icbcun = 0
      iprobs = 0
      idvfl  = 0
    endif
    !
    ! -- Construct the flowja array.  Flowja is calculated each time, even if
    !    output is suppressed.  (flowja is positive into a cell.)
    do i = 1, this%nja
      this%flowja(i) = DZERO
    enddo
    if(this%innpf > 0) call this%npf%npf_flowja(this%neq, this%nja, this%x,    &
                                                this%flowja)
    if(this%inhfb > 0) call this%hfb%hfb_flowja(this%neq, this%nja, this%x,    &
                                                this%flowja)
    if(this%ingnc > 0) call this%gnc%flowja(this%flowja)
    !
    ! -- Budget routines (start by resetting)
    call this%budget%reset()
    !
    ! -- Storage
    if(this%insto > 0) then
      call this%sto%bdcalc(this%dis%nodes, this%x, this%xold,                  &
                           isuppress_output, this%budget)
      call this%sto%bdsav(icbcfl, icbcun)
    endif
    !
    ! -- Node Property Flow
    if(this%innpf > 0) then
      call this%npf%npf_bdadj(this%nja, this%flowja, icbcfl, icbcun)
    endif
    !
    ! -- Clear obs
    call this%obs%obs_bd_clear()
    !
    ! -- Mover budget
    if(this%inmvr > 0) call this%mvr%mvr_bd(icbcfl, ibudfl, isuppress_output)
    !
    ! -- Boundary packages calculate budget and total flows to model budget
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_bd(this%x, idvfl, icbcfl, ibudfl, icbcun, iprobs,       &
                          isuppress_output, this%budget)
    enddo
    !
    ! -- Calculate and write simulated values for observations
    if(iprobs /= 0) then
      if (icnvg > 0) then
        call this%obs%obs_bd()
      endif
    endif
    !
    ! -- Return
    return
  end subroutine gwf_bd

  subroutine gwf_ot(this)
! ******************************************************************************
! gwf_ot -- GroundWater Flow Model Output
! Subroutine: (1) Output budget items
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use TdisModule,only:kstp, kper, endofperiod, tdis_ot
    ! -- dummy
    class(GwfModelType) :: this
    ! -- local
    integer(I4B) :: ipflg, ibudfl, ihedfl
    integer(I4B) :: ip
    class(BndType), pointer :: packobj
    ! -- formats
    character(len=*),parameter :: fmtnocnvg = &
      "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', &
      I0,' OF STRESS PERIOD ',I0,'****')"
! ------------------------------------------------------------------------------
    !
    ! -- Set ibudfl flag for printing budget information
    ibudfl = 0
    if(this%oc%oc_print('BUDGET')) ibudfl = 1
    if(this%icnvg == 0) ibudfl = 1
    if(endofperiod) ibudfl = 1
    !
    ! -- Set ibudfl flag for printing dependent variable information
    ihedfl = 0
    if(this%oc%oc_print('HEAD')) ihedfl = 1
    if(this%icnvg == 0) ihedfl = 1
    if(endofperiod) ihedfl = 1
    !
    ! -- Output individual flows if requested
    if(ibudfl /= 0) then
      !
      ! -- NPF output
      if(this%innpf > 0) call this%npf%npf_ot(this%neq, this%nja, this%flowja)
      !
      ! -- GNC output
      if(this%ingnc > 0) &
        call this%gnc%gnc_ot()
    endif
    !
    ! -- Output control
    ipflg = 0
    this%budget%budperc = 1.e30
    if(this%icnvg == 0) then
      write(this%iout,fmtnocnvg) kstp, kper
      ipflg = 1
    endif
    call this%oc%oc_ot(ipflg)
    !
    ! -- Write Budget and Head if these conditions are met
    if (ibudfl /= 0 .or. ihedfl /=0) then
      ipflg = 1
      !
      ! -- Package budget output
      do ip = 1, this%bndlist%Count()
        packobj => GetBndFromList(this%bndlist, ip)
        call packobj%bnd_ot(kstp, kper, this%iout, ihedfl, ibudfl)
      enddo
      !
      if (ibudfl /= 0) then
        !
        ! -- Mover budget output
        if(this%inmvr > 0) call this%mvr%mvr_ot()
        !
        ! -- gwf model budget
        call this%budget%budget_ot(kstp, kper, this%iout)
      end if
    end if
    !
    ! -- Timing Output
    if(ipflg == 1) call tdis_ot(this%iout)
    !
    ! -- OBS output
    call this%obs%obs_ot()
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_ot_obs()
    enddo
    !
    ! -- return
    return
  end subroutine gwf_ot

  subroutine gwf_fp(this)
! ******************************************************************************
! gwf_fp -- Final processing
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    ! -- dummy
    class(GwfModelType) :: this
    ! -- local
    integer(I4B) :: ip
    class(BndType), pointer :: packobj
! ------------------------------------------------------------------------------
    !
    return
  end subroutine gwf_fp

  subroutine gwf_da(this)
! ******************************************************************************
! gwf_da -- Deallocate
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use MemoryManagerModule, only: mem_deallocate
    ! -- dummy
    class(GwfModelType) :: this
    ! -- local
    integer(I4B) :: ip
    class(BndType),pointer :: packobj
! ------------------------------------------------------------------------------
    !
    ! -- Internal flow packages deallocate
    call this%dis%dis_da()
    call this%ic%ic_da()
    call this%npf%npf_da()
    call this%xt3d%xt3d_da()
    call this%gnc%gnc_da()
    call this%sto%sto_da()
    call this%budget%budget_da()
    call this%hfb%hfb_da()
    call this%mvr%mvr_da()
    call this%oc%oc_da()
    call this%obs%obs_da()
    !
    ! -- Internal package objects
    deallocate(this%dis)
    deallocate(this%ic)
    deallocate(this%npf)
    deallocate(this%xt3d)
    deallocate(this%gnc)
    deallocate(this%sto)
    deallocate(this%budget)
    deallocate(this%hfb)
    deallocate(this%mvr)
    deallocate(this%obs)
    deallocate(this%oc)
    !
    ! -- Boundary packages
    do ip = 1, this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      call packobj%bnd_da()
      deallocate(packobj)
    enddo
    !
    ! -- Scalars
    call mem_deallocate(this%inic)
    call mem_deallocate(this%inoc)
    call mem_deallocate(this%inobs)
    call mem_deallocate(this%innpf)
    call mem_deallocate(this%insto)
    call mem_deallocate(this%inmvr)
    call mem_deallocate(this%inhfb)
    call mem_deallocate(this%ingnc)
    call mem_deallocate(this%iss)
    call mem_deallocate(this%inewtonur)
    !
    ! -- NumericalModelType
    call this%NumericalModelType%model_da()
    !
    ! -- return
    return
  end subroutine gwf_da

  function gwf_get_nsubtimes(this) result(nsubtimes)
    !
    ! -- result
    integer(I4B) :: nsubtimes
    class(GwfModelType) :: this
    nsubtimes = 1
    return
  end function gwf_get_nsubtimes

  subroutine gwf_bdentry(this, budterm, budtxt, rowlabel)
! ******************************************************************************
! gwf_bdentry -- GroundWater Flow Model Budget Entry
! This subroutine adds a budget entry to the flow budget.  It was added as
! a method for the gwf3 model object so that the exchange object could add its
! contributions.
! Subroutine: (1) adds the entry to the budget object
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use ConstantsModule, only: LENBUDTXT, LENPACKAGENAME
    use TdisModule, only:delt
    ! -- dummy
    class(GwfModelType) :: this
    real(DP), dimension(:, :), intent(in) :: budterm
    character(len=LENBUDTXT), dimension(:), intent(in) :: budtxt
    character(len=LENPACKAGENAME), intent(in) :: rowlabel
! ------------------------------------------------------------------------------
    !
    call this%budget%addentry(budterm, delt, budtxt, rowlabel=rowlabel)
    !
    ! -- return
    return
  end subroutine gwf_bdentry

  function gwf_get_iasym(this) result (iasym)
! ******************************************************************************
! gwf_get_iasym -- return 1 if any package causes the matrix to be asymmetric.
!   Otherwise return 0.
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    class(GwfModelType) :: this
    ! -- local
    integer(I4B) :: iasym
    integer(I4B) :: ip
    class(BndType), pointer :: packobj
! ------------------------------------------------------------------------------
    !
    ! -- Start by setting iasym to zero
    iasym = 0
    !
    ! -- NPF
    if (this%innpf > 0) then
      if (this%npf%iasym /= 0) iasym = 1
      if (this%npf%ixt3d /= 0) iasym = 1
    endif
    !
    ! -- GNC
    if (this%ingnc > 0) then
      if (this%gnc%iasym /= 0) iasym = 1
    endif
    !
    ! -- Check for any packages that introduce matrix asymmetry
    do ip=1,this%bndlist%Count()
      packobj => GetBndFromList(this%bndlist, ip)
      if (packobj%iasym /= 0) iasym = 1
    enddo
    !
    ! -- return
    return
  end function gwf_get_iasym

  subroutine allocate_scalars(this, modelname)
! ******************************************************************************
! allocate_scalars -- Allocate memory for non-allocatable members
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use MemoryManagerModule, only: mem_allocate
    ! -- dummy
    class(GwfModelType) :: this
    character(len=*), intent(in)  :: modelname
! ------------------------------------------------------------------------------
    !
    ! -- allocate members from parent class
    call this%NumericalModelType%allocate_scalars(modelname)
    !
    ! -- allocate members that are part of model class
    call mem_allocate(this%inic,  'INIC',  modelname)
    call mem_allocate(this%inoc,  'INOC',  modelname)
    call mem_allocate(this%innpf, 'INNPF', modelname)
    call mem_allocate(this%insto, 'INSTO', modelname)
    call mem_allocate(this%inmvr, 'INMVR', modelname)
    call mem_allocate(this%inhfb, 'INHFB', modelname)
    call mem_allocate(this%ingnc, 'INGNC', modelname)
    call mem_allocate(this%inobs, 'INOBS', modelname)
    call mem_allocate(this%iss,   'ISS',   modelname)
    call mem_allocate(this%inewtonur, 'INEWTONUR', modelname)
    !
    this%inic = 0
    this%inoc = 0
    this%innpf = 0
    this%insto = 0
    this%inmvr = 0
    this%inhfb = 0
    this%ingnc = 0
    this%inobs = 0
    this%iss = 1       !default is steady-state (i.e., no STO package)
    this%inewtonur = 0 !default is to not use newton bottom head dampening
    !
    ! -- return
    return
  end subroutine allocate_scalars

  subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit,    &
                            iout)
! ******************************************************************************
! package_create -- Create boundary condition packages for this model
! Subroutine: (1) create new-style package
!             (2) add a pointer to the package
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use ConstantsModule, only: LINELENGTH
    use SimModule, only: store_error, ustop
    use ChdModule, only: chd_create
    use WelModule, only: wel_create
    use DrnModule, only: drn_create
    use RivModule, only: riv_create
    use GhbModule, only: ghb_create
    use RchModule, only: rch_create
    use EvtModule, only: evt_create
    use MawModule, only: maw_create
    use SfrModule, only: sfr_create
    use LakModule, only: lak_create
    use UzfModule, only: uzf_create
    ! -- dummy
    class(GwfModelType) :: this
    character(len=*),intent(in) :: filtyp
    character(len=LINELENGTH) :: errmsg
    integer(I4B),intent(in) :: ipakid
    integer(I4B),intent(in) :: ipaknum
    character(len=*), intent(in) :: pakname
    integer(I4B),intent(in) :: inunit
    integer(I4B),intent(in) :: iout
    ! -- local
    class(BndType), pointer :: packobj
    class(BndType), pointer :: packobj2
    integer(I4B) :: ip
! ------------------------------------------------------------------------------
    !
    ! -- Now supporting new-style WEL and GHB packages.
    ! -- This part creates the package object
    select case(filtyp)
    case('CHD6')
      call chd_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('WEL6')
      call wel_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('DRN6')
      call drn_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('RIV6')
      call riv_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('GHB6')
      call ghb_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('RCH6')
      call rch_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('EVT6')
      call evt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('MAW6')
      call maw_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('SFR6')
      call sfr_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('LAK6')
      call lak_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case('UZF6')
      call uzf_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
    case default
      write(errmsg, *) 'Invalid package type: ', filtyp
      call store_error(errmsg)
      call ustop()
    end select
    !
    ! -- Packages is the bndlist that is associated with the parent model
    ! -- The following statement puts a pointer to this package in the ipakid
    ! -- position of packages.
      do ip = 1, this%bndlist%Count()
        packobj2 => GetBndFromList(this%bndlist, ip)
        if(packobj2%name == pakname) then
          write(errmsg, '(a,a)') 'Cannot create package.  Package name  ' //   &
            'already exists: ', trim(pakname)
          call store_error(errmsg)
          call ustop()
        endif
      enddo
    call AddBndToList(this%bndlist, packobj)
    !
    ! -- return
    return
  end subroutine package_create

  subroutine ftype_check(this, namefile_obj, indis)
! ******************************************************************************
! ftype_check -- Check to make sure required input files have been specified
! ******************************************************************************
!
!    SPECIFICATIONS:
! ------------------------------------------------------------------------------
    ! -- modules
    use ConstantsModule,   only: LINELENGTH
    use SimModule,         only: ustop, store_error, count_errors
    use NameFileModule,    only: NameFileType
    ! -- dummy
    class(GwfModelType) :: this
    type(NameFileType), intent(in) :: namefile_obj
    integer(I4B), intent(in) :: indis
    ! -- local
    character(len=LINELENGTH) :: errmsg
    integer(I4B) :: i, iu
    character(len=LENFTYPE), dimension(11) :: nodupftype =                     &
      (/'DIS6 ', 'DISU6', 'DISV6', 'IC6  ', 'OC6  ', 'NPF6 ', 'STO6 ',         &
        'MVR6 ', 'HFB6 ', 'GNC6 ', 'OBS6 '/)
! ------------------------------------------------------------------------------
    !
    if(this%single_model_run) then
      !
      ! -- Ensure TDIS6 is present
      call namefile_obj%get_unitnumber('TDIS6', iu, 1)
      if(iu == 0) then
        call store_error('TDIS6 ftype not specified in name file.')
      endif
      !
      ! -- Ensure IMS6 is present
      call namefile_obj%get_unitnumber('IMS6', iu, 1)
      if(iu == 0) then
        call store_error('IMS6 ftype not specified in name file.')
      endif
      !
    else
      !
      ! -- Warn if TDIS6 is present
      call namefile_obj%get_unitnumber('TDIS6', iu, 1)
      if(iu > 0) then
        write(this%iout, '(/a)') 'Warning TDIS6 detected in GWF name file.'
        write(this%iout, *) 'Simulation TDIS file will be used instead.'
        close(iu)
      endif
      !
      ! -- Warn if SMS8 is present
      call namefile_obj%get_unitnumber('IMS6', iu, 1)
      if(iu > 0) then
        write(this%iout, '(/a)') 'Warning IMS6 detected in GWF name file.'
        write(this%iout, *) 'Simulation IMS6 file will be used instead.'
        close(iu)
      endif
    endif
    !
    ! -- Check for IC8, DIS(u), and NPF. Stop if not present.
    if(this%inic==0) then
      write(errmsg, '(1x,a)') 'ERROR. INITIAL CONDITIONS (IC6) PACKAGE NOT SPECIFIED.'
      call store_error(errmsg)
    endif
    if(indis==0) then
      write(errmsg, '(1x,a)') &
        'ERROR. DISCRETIZATION (DIS6 or DISU6) PACKAGE NOT SPECIFIED.'
      call store_error(errmsg)
    endif
    if(this%innpf==0) then
      write(errmsg, '(1x,a)') &
        'ERROR.  NODE PROPERTY FLOW (NPF6) PACKAGE NOT SPECIFIED.'
      call store_error(errmsg)
    endif
    if(count_errors() > 0) then
      write(errmsg,'(1x,a)') 'ERROR. REQUIRED PACKAGE(S) NOT SPECIFIED.'
      call store_error(errmsg)
    endif
    !
    ! -- Check to make sure that some GWF packages are not specified more
    !    than once
    do i = 1, size(nodupftype)
      call namefile_obj%get_unitnumber(trim(nodupftype(i)), iu, 0)
      if (iu > 0) then
        write(errmsg,'(1x, a, a, a)')                                          &
          'DUPLICATE ENTRIES FOR FTYPE ', trim(nodupftype(i)),                 &
          ' NOT ALLOWED FOR GWF MODEL.'
        call store_error(errmsg)
      endif
    enddo
    !
    ! -- Stop if errors
    if(count_errors() > 0) then
      write(errmsg, '(a, a)') 'ERROR OCCURRED WHILE READING FILE: ',           &
        trim(namefile_obj%filename)
      call store_error(errmsg)
      call ustop()
    endif
    !
    ! -- return
    return
  end subroutine ftype_check

end module GwfModule


! This is the omuse-specific native interface to the
! Dutch Large Eddy Simulation code DALES.
! Written by G. van den Oord, 2016

module dales_interface

    use daleslib, only : initialize, step, finalize, &
            allocate_z_axis, allocate_2d, allocate_3d, &
            my_task, master_task, gatherlayer, &
            FIELDID_U, FIELDID_V, FIELDID_W, FIELDID_THL, FIELDID_QT, &
            u_tend, v_tend, thl_tend, qt_tend, ql_tend, ps_tend, ql_ref, qt_alpha, &
            gatherlayeravg, gathervol, localindex, gatherlwp, gathercloudfrac, gatherlayericeavg, geticecontent, &
            qt_forcing_type, QT_FORCING_GLOBAL, QT_FORCING_LOCAL, QT_FORCING_VARIANCE, &
            u_nudge, v_nudge, thl_nudge, qt_nudge, u_nudge_time, v_nudge_time, thl_nudge_time, qt_nudge_time

    !TODO: Expose everything so this module only depends on daleslib
    use modfields, only : u0, v0, w0, thl0, qt0, ql0, qsat, e120, tmp0, sv0, um, vm, wm, thlm, qtm, surf_rain
    use modpois, only : p
    use modglobal, only : i1, j1, k1, itot, jtot, kmax, lmoist
    use modsurfdata, only : ps, ustar, z0m, z0h, tskin, qskin, LE, H, obl, thlflux, qtflux, svflux, dudz, dvdz, &
            dqtdz, dthldz, thls, qts, thvs, svs, ustin, wqsurf, wtsurf, wsvsurf, z0, z0mav, z0hav
    use modraddata, only : swd, swdir, swdif, swu, lwd, lwu, swdca, swuca, lwdca, lwuca
    use modmicrodata, only : iqr
    use modglobal, only : rtimee, rdt, fname_options, timeleft, tres, timee, rk3step, dt_lim
    use modstartup, only : do_writerestartfiles
    use mpi, only : MPI_COMM_WORLD

    implicit none

    real(8), allocatable :: tmp1Dz(:)
    real(8), allocatable :: tmp2Dxy(:, :)
    real(8), allocatable :: tmp3D(:, :, :)

    integer :: MPI_local_comm = MPI_COMM_WORLD
    integer :: startdate = 0
    integer :: starttime = 0

    logical :: exactEnd = .false.

contains

    ! Sets the variance nudging type
    function set_qt_forcing(forcing_type) result(ret)
        integer :: ret
        integer, intent(in) :: forcing_type
        if (forcing_type >= 0 .and. forcing_type <= 3) then
           write(*,*) 'Setting qt forcing type', forcing_type
           qt_forcing_type = forcing_type
           ret = 0
         else
            write(*,*) 'qt forcing type out of range', forcing_type
            ret = 1
         endif
    end function set_qt_forcing

    ! Sets the dales input file
    function set_input_file(ifile) result(ret)
        integer :: ret
        character(256), intent(in) :: ifile

        fname_options = ifile
        ret = 0
    end function set_input_file

    ! Returns the dales input file
    function get_input_file(ifile) result(ret)
        integer :: ret
        character(256), intent(out) :: ifile

        ifile = fname_options
        ret = 0
    end function get_input_file

    ! set the working directory of the dales worker process
    function change_dir(directory) result(ret)
#if defined (__INTEL_COMPILER)
        USE IFPORT   ! for intel chdir function.
#endif
        integer :: ret
        character(256), intent(in) :: directory
        ret = chdir(directory)
    end function change_dir

    ! Sets the simulation starting date
    function set_start_date(date) result(ret)
        integer :: ret
        integer, intent(in) :: date

        startdate = date
        ret = 0
    end function set_start_date

    ! Sets the simulation starting timestamp
    function set_start_time(time) result(ret)
        integer :: ret
        integer, intent(in) :: time

        starttime = time
        ret = 0
    end function set_start_time

    ! Dales instantiation function
    function initialize_code() result(ret)
        integer :: ret

        fname_options = "namoptions.001"
        !startdate=0
        !starttime=0
        ret = 0
    end function

    ! Dales initializer function
    function commit_parameters() result(ret)
        integer :: ret

        call initialize(fname_options, mpi_comm = MPI_local_comm, date = startdate, time = starttime)

        ret = 0
        if(my_task==master_task) then
            ret = allocate_z_axis(tmp1Dz)
            if(ret/=0) return
            ret = allocate_2d(tmp2dxy)
            if(ret/=0) return
            ret = allocate_3d(tmp3D)
        endif
    end function

    ! Trivial placeholder method
    function recommit_parameters() result(ret)
        integer :: ret
        ret = 0
    end function

    ! Switch from/to adaptive time stepping
    function set_exact_end(t) result(ret)
        integer :: ret
        logical, intent(in) :: t

        exactEnd = t
        ret = 0
    end function set_exact_end

    ! Returns the adaptive time stepping flag
    function get_exact_end(t) result(ret)
        integer :: ret
        logical, intent(out) :: t

        t = exactEnd
        ret = 0
    end function get_exact_end

    ! evolve the model to time tend
    ! returns 1 if the end of the simulation was reached (timeleft == 0)
    !
    ! EXPERIMENTAL: if exactEnd is nonzero,
    !               set dt_lim so that the timestepping finishes exactly at tend
    !               then the end time from namoptions is not used.
    !
    !  .or. rk3step < 3) SHOULD BE USED TO FINISH A FULL TIME STEP BEFORE EXITING ??
    !                    but it breaks the current result test, which was stored without this.
    !                    see program.f90: main loop - while(timeleft>0 .or. rk3step < 3)
    !
    !  Returns the elapsed time in seconds (real) in walltime
    function evolve_model(tend, exactEnd_, walltime) result(ret)
        use mpi, only : MPI_Wtime
        integer :: ret
        real(8), intent(in) :: tend
        integer, intent(in) :: exactEnd_
        real(8), intent(out) :: walltime
        integer :: i
        real(8) :: start_time

        start_time = MPI_Wtime()

        do while((rtimee < tend .and. timeleft > 0)) ! .or. rk3step < 3)

            if (exactEnd_ /= 0 .or. exactEnd) then
                ! set dt_lim to finish at tend (or before)
                dt_lim = min(dt_lim, (int(tend / tres) - timee))
            endif

            ! thrice to ensure consistency of state (rkstep==3)
            call step
            call step
            call step
            !           print *, '  ', 'rtimee=',rtimee, 'timeleft=',timeleft, 'rk3step=',rk3step, 'rdt=',rdt
        enddo

        walltime = MPI_Wtime() - start_time
        ret = 0
        if(timeleft <= 0) then
            ret = 1
        endif

    end function

    ! Dales finalizer method
    function cleanup_code() result(ret)
        integer :: ret

        call finalize
        ret = 0
    end function

    ! Returns the model fixed timestep
    function get_timestep(dt) result(ret)
        real(8), intent(out) :: dt
        integer :: ret

        dt = rdt
        ret = 0
    end function

    ! Returns the model time
    function get_model_time(t) result(ret)
        real(8), intent(out) :: t
        integer :: ret

        t = rtimee
        ret = 0
    end function get_model_time

    ! Sets the (uniform) surface pressure
    function set_surface_pressure(p) result(ret)

        use modsurface, only : qtsurf

        real(8), intent(in) :: p
        integer :: ret

        ps = p

        ! modtimedep calls qtsurf to update surface values after changing ps, so we'll do the same
        if (lmoist) then
            call qtsurf
        else
            qts = 0.
        endif

        ret = 0
    end function set_surface_pressure

    ! Returns the model surface pressure
    function get_surface_pressure(p) result(ret)
        real(8), intent(out) :: p
        integer :: ret

        p = ps
        ret = 0
    end function get_surface_pressure

    ! Trivial placeholder method
    function commit_grid() result(ret)
        integer :: ret
        ret = 0
    end function

    !!!!! get functions for vertical profiles / slab averages
    !   g_k is a dummy array
    !   a is the returned result
    !   n is the array length

    ! Returns eastward wind profile
    function get_profile_U_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(u0(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_U_

    ! Returns northward wind profile
    function get_profile_V_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(v0(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_V_

    ! Returns vertical wind profile
    function get_profile_W_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(w0(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_W_

    ! Returns the vertical liquid pot.temp. profile
    function get_profile_THL_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(thl0(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_THL_

    ! Returns the total humidity profile
    function get_profile_QT_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(qt0(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_QT_

    ! Returns the liquid water content profile
    function get_profile_QL_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(ql0(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_QL_

    ! Returns the ice water content profile
    function get_profile_QL_ice_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        real, dimension(kmax) :: a_
        integer :: i, ret

        ret = gatherlayericeavg(a_)
        do i = 1, n
            a(i) = a_(g_k(i))
        enddo
    end function get_profile_QL_ice_

    ! Returns the rain water profile
    function get_profile_QR_(g_k, a, n) result(ret)
        use modmicrodata, only : iqr
        use modglobal, only : nsv
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        if (nsv >= iqr) then
            ret = gatherlayeravg(sv0(2:i1, 2:j1, g_k(1:n), iqr), a)
        else
            a = 0  ! Dales doesn't have the requested rain field
            ret = 1
        endif

    end function get_profile_QR_

    ! Returns the TKE profile
    function get_profile_E12_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(e120(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_E12_

    ! Returns the real temperature profile
    function get_profile_T_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gatherlayeravg(tmp0(2:i1, 2:j1, g_k(1:n)), a)
    end function get_profile_T_

    ! Returns the vertical layer center heights
    function get_zf_(g_k, a, n) result(ret)
        use modglobal, only : zf
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        a = zf(g_k(1:n))
        ret = 0
    end function get_zf_

    ! Returns the vertical layer interface heights
    function get_zh_(g_k, a, n) result(ret)
        use modglobal, only : zh
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        a = zh(g_k(1:n))
        ret = 0
    end function get_zh_

    ! Returns the vertical layer center pressures
    function get_presf_(g_k, a, n) result(ret)
        use modfields, only : presf
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        a = presf(g_k(1:n))
        ret = 0
    end function get_presf_

    ! Returns the vertical layer interface pressures
    function get_presh_(g_k, a, n) result(ret)
        use modfields, only : presh
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        a = presh(g_k(1:n))
        ret = 0
    end function get_presh_

    ! Returns the full level density
    function get_rhof_(g_k, a, n) result(ret)
        use modfields, only : rhof
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        a = rhof(g_k(1:n))
        ret = 0
    end function get_rhof_

      ! Returns the full level base density
    function get_rhobf_(g_k, a, n) result(ret)
        use modfields, only : rhobf
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        a = rhobf(g_k(1:n))
        ret = 0
    end function get_rhobf_

    ! Cloud fraction getter
    ! Note: in contrast to the other profile getters,
    ! this one relies on g_k to define slabs
    ! the result a has the same length as g_k
    function get_cloudfraction(g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        ret = gathercloudfrac(ql0(2:i1, 2:j1, :), g_k, a)
    end function get_cloudfraction
    !!! end of vertical profile getters

    ! Total rain water content getter
    function get_rain(rain) result(ret)
        use mpi
        use modmpi, only : comm3d, my_real, mpierr, myid, nprocs
        use modglobal, only : itot, jtot

        real, intent(out) :: rain
        integer :: ret

        rain = sum(surf_rain(2:i1, 2:j1))

        !in-place reduction
        if (myid == 0) then
            CALL mpi_reduce(MPI_IN_PLACE, rain, 1, MY_REAL, MPI_SUM, 0, comm3d, ret)
            rain = rain / (itot * jtot)
        else
            CALL mpi_reduce(rain, rain, 1, MY_REAL, MPI_SUM, 0, comm3d, ret)
        endif
        ret = 0
    end function get_rain

    ! set functions for vertical tendency vectors
    !   a is the profile to set
    !   n is the array length - assumed to be the number of layers in the model
    ! Sets the eastward wind tendency profile
    function set_tendency_U(a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer :: ret
        u_tend = a
        ret = 0
    end function set_tendency_U

    ! Sets the northward wind tendency profile
    function set_tendency_V(a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer :: ret
        v_tend = a
        ret = 0
    end function set_tendency_V

    ! Sets the liquid water pot. temperature profile
    function set_tendency_THL(a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer :: ret
        thl_tend = a
        ret = 0
    end function set_tendency_THL

    ! Sets the total humidity tendency profile
    function set_tendency_QT(a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer :: ret
        qt_tend = a
        ret = 0
    end function set_tendency_QT

    ! Sets the liquid water content tendency
    function set_tendency_QL(a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer :: ret
        ql_tend = a
        ret = 0
    end function set_tendency_QL

    ! Sets the liquid water reference profile
    function set_ref_profile_QL(a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer :: ret
        ql_ref = a
        ret = 0
    end function set_ref_profile_QL

    ! Sets the variance nudging factor
    function set_qt_variability_factor(a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer :: ret
        qt_alpha = a
        ret = 0
    end function set_qt_variability_factor

    !!!!! indexed get/set functions for vertical tendency vectors
    ! Sets the eastward velocity tendency profile
    function set_tendency_U_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        u_tend(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_tendency_U_

    ! Returns the eastward velocity tendency profile
    function get_tendency_U_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = u_tend(g_k(1:n))
        ret = 0
    end function get_tendency_U_

    ! Sets the northward velocity tendency profile
    function set_tendency_V_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        v_tend(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_tendency_V_

    ! Returns the northward velocity tendency profile
    function get_tendency_V_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = V_tend(g_k(1:n))
        ret = 0
    end function get_tendency_V_

    ! Sets the liquid water pot. temp. tendency profile
    function set_tendency_THL_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        thl_tend(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_tendency_THL_

    ! Returns the liquid water pot. temp. tendency profile
    function get_tendency_THL_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = thl_tend(g_k(1:n))
        ret = 0
    end function get_tendency_THL_

    ! Sets the total humidity tendency profile
    function set_tendency_QT_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        qt_tend(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_tendency_QT_

    ! Returns the total humidity tendency profile
    function get_tendency_QT_(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = qt_tend(g_k(1:n))
        ret = 0
    end function get_tendency_QT_

    ! Sets the surface pressure tendency
    function set_tendency_surface_pressure(p_tend) result(ret)
        real(8), intent(in) :: p_tend
        integer :: ret

        ps_tend = p_tend

        ret = 0
    end function set_tendency_surface_pressure

    ! Returns the surface pressure tendency
    function get_tendency_surface_pressure(p_tend) result(ret)
        real(8), intent(out) :: p_tend
        integer :: ret

        p_tend = ps_tend

        ret = 0
    end function get_tendency_surface_pressure
    !!! end of vertical tendency setters

    !!!!! indexed get/set functions for nudge targets
    ! Sets the eastward wind velocity nudging relaxation time
    function set_nudge_time_U(time) result(ret)
        real, intent(in) :: time
        integer :: ret
        u_nudge_time = time
        ret = 0
    end function set_nudge_time_U

    ! Returns the eastward wind velocity nudging relaxation time
    function get_nudge_time_U(time) result(ret)
        real, intent(out) :: time
        integer :: ret
        time = u_nudge_time
        ret = 0
    end function get_nudge_time_U

    ! Sets the northward wind velocity nudging relaxation time
    function set_nudge_time_V(time) result(ret)
        real, intent(in) :: time
        integer :: ret
        v_nudge_time = time
        ret = 0
    end function set_nudge_time_V

    ! Returns the northward wind velocity nudging relaxation time
    function get_nudge_time_V(time) result(ret)
        real, intent(out) :: time
        integer :: ret
        time = v_nudge_time
        ret = 0
    end function get_nudge_time_V

    ! Sets the liquid water pot. temp. nudging relaxation time
    function set_nudge_time_THL(time) result(ret)
        real, intent(in) :: time
        integer :: ret
        thl_nudge_time = time
        ret = 0
    end function set_nudge_time_THL

    ! Returns the liquid water pot. temp. nudging relaxation time
    function get_nudge_time_THL(time) result(ret)
        real, intent(out) :: time
        integer :: ret
        time = thl_nudge_time
        ret = 0
    end function get_nudge_time_THL

    ! Sets the total humidity nudging relaxation time
    function set_nudge_time_QT(time) result(ret)
        real, intent(in) :: time
        integer :: ret
        qt_nudge_time = time
        ret = 0
    end function set_nudge_time_QT

    ! Returns the total humidity nudging relaxation time
    function get_nudge_time_QT(time) result(ret)
        real, intent(out) :: time
        integer :: ret
        time = qt_nudge_time
        ret = 0
    end function get_nudge_time_QT

    ! Sets the eastward velocity nudging profile
    function set_nudge_U(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        u_nudge(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_nudge_U

    ! Returns the eastward velocity nudging profile
    function get_nudge_U(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = u_nudge(g_k(1:n))
        ret = 0
    end function get_nudge_U

    ! Sets the northward velocity nudging profile
    function set_nudge_V(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        v_nudge(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_nudge_V

    ! Returns the northward velocity nudging profile
    function get_nudge_V(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = V_nudge(g_k(1:n))
        ret = 0
    end function get_nudge_V

    ! Sets the liquid water pot. temperature nudging profile
    function set_nudge_THL(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        thl_nudge(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_nudge_THL

    ! Returns the liquid water pot. temperature nudging profile
    function get_nudge_THL(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = thl_nudge(g_k(1:n))
        ret = 0
    end function get_nudge_THL

    ! Sets the total humidity nudging profile
    function set_nudge_QT(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(in) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        qt_nudge(g_k(1:n)) = a(1:n)
        ret = 0
    end function set_nudge_QT

    ! Returns the total humidity nudging profile
    function get_nudge_QT(g_k, a, n) result(ret)
        integer, intent(in) :: n
        real, dimension(n), intent(out) :: a
        integer, dimension(n), intent(in) :: g_k
        integer :: ret
        a(1:n) = qt_nudge(g_k(1:n))
        ret = 0
    end function get_nudge_QT
    !!! end of nudge target getters/setters

    !!! getter functions for full 3D fields - using index arrays
    ! Eastward wind velocity volume field getter
    function get_field_U(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, u0(2:i1, 2:j1, 1:kmax))
    end function get_field_U

    ! Northward wind velocity volume field getter
    function get_field_V(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, v0(2:i1, 2:j1, 1:kmax))
    end function get_field_V

    ! Upward wind velocity volume field getter
    function get_field_W(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, w0(2:i1, 2:j1, 1:kmax))
    end function get_field_W

    ! Liquid water potential temperature volume field getter
    function get_field_THL(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, thl0(2:i1, 2:j1, 1:kmax))
    end function get_field_THL

    ! Total humidity volume field getter
    function get_field_QT(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, qt0(2:i1, 2:j1, 1:kmax))
    end function get_field_QT

    ! Liquid water content volume field getter
    function get_field_QL(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, ql0(2:i1, 2:j1, 1:kmax))
    end function get_field_QL

    ! Ice water content volume field getter
    function get_field_QL_ice(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        real    :: qli(2:i1, 2:j1, 1:kmax)
        ret = geticecontent(qli)
        ret = gathervol(g_i, g_j, g_k, a, n, qli)
    end function get_field_QL_ice

    ! Returns the rain water profile
    function get_field_QR(g_i, g_j, g_k, a, n) result(ret)
        use modmicrodata, only : iqr
        use modglobal, only : nsv
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret

        if (nsv >= iqr) then
            ret = gathervol(g_i, g_j, g_k, a, n, sv0(2:i1, 2:j1, 1:kmax, iqr))
        else
            a = 0  ! Dales doesn't have the requested rain field
            ret = 1
        endif
    end function get_field_QR

    ! Saturation humidity volume field getter
    function get_field_Qsat(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, qsat(2:i1, 2:j1, 1:kmax))
    end function get_field_Qsat

    ! Turbulent kinetic energy volume field getter
    function get_field_E12(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, e120(2:i1, 2:j1, 1:kmax))
    end function get_field_E12

    ! Temperature volume field getter
    function get_field_T(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, tmp0(2:i1, 2:j1, 1:kmax))
    end function get_field_T

    ! Modified pressure volume field getter
    function get_field_pi(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, p(2:i1, 2:j1, 1:kmax))
    end function get_field_pi

    ! Downwelling shortwave radiative flux getter
    function get_field_rswd(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, swd(2:i1, 2:j1, 1:kmax))
    end function get_field_rswd

    ! Upwelling shortwave radiative flux getter
    function get_field_rswu(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, swu(2:i1, 2:j1, 1:kmax))
    end function get_field_rswu

    ! Downwelling direct shortwave radiative flux getter
    function get_field_rswdir(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, swdir(2:i1, 2:j1, 1:kmax))
    end function get_field_rswdir

    ! Downwelling diffuse shortwave radiative flux getter
    function get_field_rswdif(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, swdif(2:i1, 2:j1, 1:kmax))
    end function get_field_rswdif

    ! Downwelling longwave radiative flux getter
    function get_field_rlwd(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, lwd(2:i1, 2:j1, 1:kmax))
    end function get_field_rlwd

    ! Upwelling longwave radiative flux getter
    function get_field_rlwu(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, lwu(2:i1, 2:j1, 1:kmax))
    end function get_field_rlwu

    ! Clear-sky downwelling shortwave radiative flux getter
    function get_field_rswdcs(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, swdca(2:i1, 2:j1, 1:kmax))
    end function get_field_rswdcs

    ! Clear-sky upwelling shortwave radiative flux getter
    function get_field_rswucs(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, swuca(2:i1, 2:j1, 1:kmax))
    end function get_field_rswucs

    ! Clear-sky downwelling longwave radiative flux getter
    function get_field_rlwdcs(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, lwdca(2:i1, 2:j1, 1:kmax))
    end function get_field_rlwdcs

    ! Clear-sky upwelling longwave radiative flux getter
    function get_field_rlwucs(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gathervol(g_i, g_j, g_k, a, n, lwuca(2:i1, 2:j1, 1:kmax))
    end function get_field_rlwucs
    !!! end of full 3D field getter functions

    ! getter function for LWP - a 2D field, vertical integral of ql
    function get_field_LWP(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlwp(g_i, g_j, a, n, ql0(2:i1, 2:j1, 1:kmax))
    end function get_field_LWP

    ! getter function for TWP - Total Water Path - 2D field, vertical integral of qt
    function get_field_TWP(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlwp(g_i, g_j, a, n, qt0(2:i1, 2:j1, 1:kmax))
    end function get_field_TWP

    ! Rain water path - like LWP but for rain water
    ! get it from sv0(:,:,:,iqr)
    function get_field_RWP(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlwp(g_i, g_j, a, n, sv0(2:i1, 2:j1, 1:kmax, iqr))
    end function get_field_RWP

    ! Surface friction velocity field getter
    function get_field_ustar(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, ustar(2:i1, 2:j1))
    end function get_field_ustar

    ! Surface momentum roughness length field getter
    function get_field_z0m(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, z0m(2:i1, 2:j1))
    end function get_field_z0m

    ! Surface heat roughness length field getter
    function get_field_z0h(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, z0h(2:i1, 2:j1))
    end function get_field_z0h

    ! Surface skin temperature field getter
    function get_field_tskin(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, tskin(2:i1, 2:j1))
    end function get_field_tskin

    ! Surface skin moisture content field getter
    function get_field_qskin(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, qskin(2:i1, 2:j1))
    end function get_field_qskin

    ! Surface latent heat flux field getter
    function get_field_LE(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        if(allocated(LE)) then
            ret = gatherlayer(g_i, g_j, a, n, LE(2:i1, 2:j1))
        else
            ret = 1
        end if
    end function get_field_LE

    ! Surface sensible heat flux field getter
    function get_field_H(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        if(allocated(H)) then
            ret = gatherlayer(g_i, g_j, a, n, H(2:i1, 2:j1))
        else
            ret = 1
        end if
    end function get_field_H

    ! Surface Obukhov length field getter
    function get_field_obl(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, obl(2:i1, 2:j1))
    end function get_field_obl

    ! Surface theta-l flux field getter
    function get_field_thlflux(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, thlflux(2:i1, 2:j1))
    end function get_field_thlflux

    ! Surface moisture flux field getter
    function get_field_qtflux(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, qtflux(2:i1, 2:j1))
    end function get_field_qtflux

    ! Surface eastward wind vertical gradient getter
    function get_field_dudz(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, dudz(2:i1, 2:j1))
    end function get_field_dudz

    ! Surface northward wind vertical gradient getter
    function get_field_dvdz(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, dvdz(2:i1, 2:j1))
    end function get_field_dvdz

    ! Surface moisture vertical gradient getter
    function get_field_dqtdz(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, dqtdz(2:i1, 2:j1))
    end function get_field_dqtdz

    ! Surface liquid water temperature vertical gradient getter
    function get_field_dthldz(g_i, g_j, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j
        real, dimension(n), intent(out) :: a
        integer :: ret
        ret = gatherlayer(g_i, g_j, a, n, dthldz(2:i1, 2:j1))
    end function get_field_dthldz

    ! Surface prescribed uniform heat flux getter
    function get_wt_surf(wtflux) result(ret)
        real, intent(out) :: wtflux
        real :: ret

        ret = 0
        wtflux = wtsurf !- (thl - tskin) / ra
    end function

    ! Surface prescribed uniform heat flux setter
    function set_wt_surf(wtflux) result(ret)
        real, intent(in) :: wtflux
        real :: ret

        ret = 0
        wtsurf = wtflux !- (thl - tskin) / ra
    end function

    ! Surface prescribed uniform moisture flux getter
    function get_wq_surf(wqflux) result(ret)
        real, intent(out) :: wqflux
        real :: ret

        ret = 0
        wqflux = wqsurf !- (qt - qskin) / ra
    end function

    ! Surface prescribed uniform moisture flux setter
    function set_wq_surf(wqflux) result(ret)
        real, intent(in) :: wqflux
        real :: ret

        ret = 0
        wqsurf = wqflux !- (qt - qskin) / ra
    end function

    ! Surface uniform momentum roughness length getter
    function get_z0m_surf(z0) result(ret)
        real, intent(out) :: z0
        real :: ret

        ret = 0
        z0 = z0mav
    end function

    ! Surface uniform momentum roughness length setter
    function set_z0m_surf(z0) result(ret)
        real, intent(in) :: z0
        real :: ret

        ret = 0
        z0m = z0
        z0mav = z0
    end function

    ! Surface uniform heat roughness length getter
    function get_z0h_surf(z0) result(ret)
        real, intent(out) :: z0
        real :: ret

        ret = 0
        z0 = z0hav
    end function

    ! Surface uniform heat roughness length setter
    function set_z0h_surf(z0) result(ret)
        real, intent(in) :: z0
        real :: ret

        ret = 0
        z0h = z0
        z0hav = z0
    end function

    !!! setter functions for full 3D fields - using index arrays
    !!! these functions set BOTH the -m and the -0 fields
    ! Sets the eastward wind velocity total volume field
    function set_field_U(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(in) :: a
        integer :: ret, m, i, j, k
        do m = 1, n
            if (localindex(g_i(m), g_j(m), g_k(m), i, j, k) /= 0) then
                um(i, j, k) = a(m)
                u0(i, j, k) = a(m)
            endif
        enddo
        ret = 0
    end function set_field_U

    ! Sets the northward wind velocity total volume field
    function set_field_V(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(in) :: a
        integer :: ret, m, i, j, k

        do m = 1, n
            if (localindex(g_i(m), g_j(m), g_k(m), i, j, k) /= 0) then
                vm(i, j, k) = a(m)
                v0(i, j, k) = a(m)
            endif
        enddo
        ret = 0
    end function set_field_V

    ! Sets the vertical wind velocity total volume field
    function set_field_W(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(in) :: a
        integer :: ret, m, i, j, k

        do m = 1, n
            if (localindex(g_i(m), g_j(m), g_k(m), i, j, k) /= 0) then
                wm(i, j, k) = a(m)
                w0(i, j, k) = a(m)
            endif
        enddo
        ret = 0
    end function set_field_W

    ! Sets the liquid water temperature total volume field
    function set_field_THL(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(in) :: a
        integer :: ret, m, i, j, k

        do m = 1, n
            if (localindex(g_i(m), g_j(m), g_k(m), i, j, k) /= 0) then
                thlm(i, j, k) = a(m)
                thl0(i, j, k) = a(m)
            endif
        enddo
        ret = 0
    end function set_field_THL

    ! Sets the total humidity total volume field
    function set_field_QT(g_i, g_j, g_k, a, n) result(ret)
        integer, intent(in) :: n
        integer, dimension(n), intent(in) :: g_i, g_j, g_k
        real, dimension(n), intent(in) :: a
        integer :: ret, m, i, j, k

        do m = 1, n
            if (localindex(g_i(m), g_j(m), g_k(m), i, j, k) /= 0) then
                qtm(i, j, k) = a(m)
                qt0(i, j, k) = a(m)
            endif
        enddo
        ret = 0
    end function set_field_QT
    !!! end of setter functions for 3D fields

    !!! get simulation parameters
    function get_params_grid(i, j, k, X, Y) result(ret)
        use modglobal, only : itot, jtot, kmax, xsize, ysize
        implicit none
        integer, intent(out) :: i, j, k
        real, intent(out) :: X, Y
        integer :: ret

        i = itot
        j = jtot
        k = kmax
        X = xsize
        Y = ysize
        ret = 0
    end function get_params_grid

    ! Write a restart file
    function write_restart() result(ret)
        integer :: ret
        call do_writerestartfiles

        ret = 0
    end function write_restart

end module dales_interface