ModelExport.f90

Go to the documentation of this file.

!> @brief This module contains the ModelExportModule
!!
!! This modeule defines the local list of model exports.
!! It is not dependent on netcdf or other external
!! libraries.
!!
!<
module modelexportmodule
 
  use kindmodule, only: dp, i4b, lgp
  use simmodule, only: store_error, store_error_filename
  use simvariablesmodule, only: errmsg
  use constantsmodule, only: linelength, lenmodelname, lencomponentname, &
                             lenmempath
  use listmodule, only: listtype
  use ncmodelexportmodule, only: ncbasemodelexporttype
  use inputloadtypemodule, only: modeldynamicpkgstype
 
  implicit none
  private
  public :: modelexports_create
  public :: modelexports_post_prepare
  public :: modelexports_post_step
  public :: modelexports_destroy
  public :: nc_export_active
  public :: export_models
  public :: get_export_model
  public :: exportmodeltype
 
  type(listtype) :: export_models
 
  !> @brief export model type
  !!
  !!  This is a container variable which holds
  !!  model export objects.
  !!
  !<
  type :: exportmodeltype
    type(modeldynamicpkgstype), pointer :: loaders => null()
    character(len=LENMODELNAME) :: modelname !< name of model
    character(len=LENCOMPONENTNAME) :: modeltype !< type of model
    character(len=LINELENGTH) :: modelfname !< name of model input file
    character(len=LINELENGTH) :: nc_fname !< name of netcdf export file
    class(ncbasemodelexporttype), pointer :: nc_export => null() !< netcdf export object pointer
    integer(I4B) :: nctype !< type of netcdf export
    integer(I4B) :: disenum !< type of discretization
    integer(I4B) :: iout !< lst file descriptor
  contains
    procedure :: init
    procedure :: post_prepare
    procedure :: post_step
    procedure :: destroy
  end type exportmodeltype
 
contains
 
  !> @brief is netcdf export configured for any model
  !!
  function nc_export_active() result(active)
    use ncmodelexportmodule, only: netcdf_undef
    logical(LGP) :: active
    integer(I4B) :: n
    type(exportmodeltype), pointer :: export_model
    active = .false.
    do n = 1, export_models%Count()
      export_model => get_export_model(n)
      if (export_model%nctype /= netcdf_undef) then
        active = .true.
        exit
      end if
    end do
  end function nc_export_active
 
  !> @brief create export container variable for all local models
  !!
  subroutine modelexports_create(iout)
    use inputloadtypemodule, only: model_dynamic_pkgs
    use memorymanagermodule, only: mem_setptr
    use memorymanagerextmodule, only: mem_set_value
    use memoryhelpermodule, only: create_mem_path
    use inputloadtypemodule, only: getdynamicmodelfromlist
    use simvariablesmodule, only: idm_context
    use ncmodelexportmodule, only: netcdf_mesh2d, netcdf_structured
    use sourcecommonmodule, only: file_ext
    integer(I4B), intent(in) :: iout
    type(modeldynamicpkgstype), pointer :: model_dynamic_input
    type(exportmodeltype), pointer :: export_model
    character(len=LENMEMPATH) :: modelnam_mempath, model_mempath, ext
    integer(I4B), pointer :: disenum
    integer(I4B) :: n
    logical(LGP) :: found
 
    do n = 1, model_dynamic_pkgs%Count()
      ! allocate and initialize
      allocate (export_model)
 
      ! set pointer to dynamic input model instance
      model_dynamic_input => getdynamicmodelfromlist(model_dynamic_pkgs, n)
 
      ! set input mempaths
      modelnam_mempath = &
        create_mem_path(component=model_dynamic_input%modelname, &
                        subcomponent='NAM', context=idm_context)
      model_mempath = create_mem_path(component=model_dynamic_input%modelname, &
                                      context=idm_context)
      ! set pointer to dis enum type
      call mem_setptr(disenum, 'DISENUM', model_mempath)
 
      ! initialize model
      call export_model%init(model_dynamic_input, disenum, iout)
 
      ! update NetCDF fileout name if provided
      call mem_set_value(export_model%nc_fname, 'NCMESH2DFILE', &
                         modelnam_mempath, found)
      if (found) then
        export_model%nctype = netcdf_mesh2d
      else
        call mem_set_value(export_model%nc_fname, 'NCSTRUCTFILE', &
                           modelnam_mempath, found)
        if (found) then
          export_model%nctype = netcdf_structured
        end if
      end if
 
      if (found) then
        ext = file_ext(export_model%nc_fname)
        if (ext /= 'nc') then
          errmsg = 'NetCDF output file name must use ".nc" extension. '// &
                   'Filename="'//trim(export_model%nc_fname)//'".'
          call store_error(errmsg)
          call store_error_filename(export_model%modelfname)
        end if
      end if
 
      ! add model to list
      call add_export_model(export_model)
    end do
  end subroutine modelexports_create
 
  !> @brief export model list post prepare step
  !!
  subroutine modelexports_post_prepare()
    class(*), pointer :: obj
    class(exportmodeltype), pointer :: export_model
    integer(I4B) :: n
    do n = 1, export_models%Count()
      obj => export_models%GetItem(n)
      if (associated(obj)) then
        select type (obj)
        class is (exportmodeltype)
          export_model => obj
          call export_model%post_prepare()
        end select
      end if
    end do
  end subroutine modelexports_post_prepare
 
  !> @brief export model list post step
  !!
  subroutine modelexports_post_step()
    class(*), pointer :: obj
    class(exportmodeltype), pointer :: export_model
    integer(I4B) :: n
    do n = 1, export_models%Count()
      obj => export_models%GetItem(n)
      if (associated(obj)) then
        select type (obj)
        class is (exportmodeltype)
          export_model => obj
          call export_model%post_step()
        end select
      end if
    end do
  end subroutine modelexports_post_step
 
  !> @brief destroy export model list
  !!
  subroutine modelexports_destroy()
    class(*), pointer :: obj
    class(exportmodeltype), pointer :: export_model
    integer(I4B) :: n
    do n = 1, export_models%Count()
      obj => export_models%GetItem(n)
      if (associated(obj)) then
        select type (obj)
        class is (exportmodeltype)
          export_model => obj
          call export_model%destroy()
          deallocate (export_model)
          nullify (export_model)
        end select
      end if
    end do
    !
    call export_models%clear()
  end subroutine modelexports_destroy
 
  !> @brief initialize model export container variable
  !!
  !<
  subroutine init(this, loaders, disenum, iout)
    use ncmodelexportmodule, only: netcdf_undef
    class(exportmodeltype), intent(inout) :: this
    type(modeldynamicpkgstype), pointer, intent(in) :: loaders
    integer(I4B), intent(in) :: disenum
    integer(I4B), intent(in) :: iout
    this%loaders => loaders
    this%modelname = loaders%modelname
    this%modeltype = loaders%modeltype
    this%modelfname = loaders%modelfname
    this%nc_fname = ''
    this%nctype = netcdf_undef
    this%disenum = disenum
    this%iout = iout
    nullify (this%nc_export)
  end subroutine init
 
  !> @brief model export container post prepare step actions
  !!
  !<
  subroutine post_prepare(this)
    class(exportmodeltype), intent(inout) :: this
    if (associated(this%nc_export)) then
      call this%nc_export%export_input()
    end if
  end subroutine post_prepare
 
  !> @brief model export container post step actions
  !!
  !<
  subroutine post_step(this)
    class(exportmodeltype), intent(inout) :: this
    if (associated(this%nc_export)) then
      call this%nc_export%step()
    end if
  end subroutine post_step
 
  !> @brief destroy model export container
  !!
  !<
  subroutine destroy(this)
    class(exportmodeltype), intent(inout) :: this
    if (associated(this%nc_export)) then
      call this%nc_export%destroy()
      deallocate (this%nc_export)
      nullify (this%nc_export)
    end if
  end subroutine destroy
 
  !> @brief add model export object to list
  !!
  !<
  subroutine add_export_model(export_model)
    type(exportmodeltype), pointer, intent(inout) :: export_model
    class(*), pointer :: obj
    obj => export_model
    call export_models%Add(obj)
  end subroutine add_export_model
 
  !> @brief get model export object by index
  !!
  !<
  function get_export_model(idx) result(res)
    integer(I4B), intent(in) :: idx !< package number
    class(exportmodeltype), pointer :: res
    class(*), pointer :: obj
    ! initialize res
    nullify (res)
    ! get the object from the list
    obj => export_models%GetItem(idx)
    if (associated(obj)) then
      select type (obj)
      class is (exportmodeltype)
        res => obj
      end select
    end if
  end function get_export_model
 
end module modelexportmodule