NCExportCreate.f90

Go to the documentation of this file.

!> @brief This module contains the NCExportCreateModule
!!
!! This module creates derived model netcdf export
!! objects. It is dependent on netcdf libraries.
!!
!<
module ncexportcreatemodule
 
  use kindmodule, only: dp, i4b, lgp
  use simvariablesmodule, only: errmsg
  use constantsmodule, only: dis, disu, disv
  use simmodule, only: store_error, store_error_filename
  use numericalmodelmodule, only: numericalmodeltype
  use basedismodule, only: disbasetype
  use dismodule, only: distype
  use disvmodule, only: disvtype
  use disumodule, only: disutype
  use modelexportmodule, only: export_models, get_export_model
  use modelexportmodule, only: exportmodeltype
  use ncmodelexportmodule, only: exportpackagetype
 
  implicit none
  private
  public :: nc_export_create
 
contains
 
  !> @brief create model netcdf export type
  !!
  subroutine create_nc_export(export_model, num_model)
    use ncmodelexportmodule, only: netcdf_mesh2d, netcdf_structured
    use meshdismodelmodule, only: mesh2ddisexporttype
    use meshdisvmodelmodule, only: mesh2ddisvexporttype
    use disncstructuredmodule, only: disncstructuredtype
    use inputloadtypemodule, only: modeldynamicpkgstype
    type(exportmodeltype), pointer, intent(inout) :: export_model
    class(numericalmodeltype), pointer, intent(in) :: num_model
    class(mesh2ddisexporttype), pointer :: ugrid_dis
    class(mesh2ddisvexporttype), pointer :: ugrid_disv
    class(disncstructuredtype), pointer :: structured_dis
    class(disbasetype), pointer :: disbase
 
    select case (export_model%disenum)
    case (dis)
      ! allocate nc structured grid export object
      if (export_model%nctype == netcdf_mesh2d) then
        ! allocate nc structured grid export object
        allocate (ugrid_dis)
 
        ! set dis base type
        disbase => num_model%dis
        select type (disbase)
        type is (distype)
          ugrid_dis%dis => disbase
        end select
 
        ! set dynamic loaders
        call create_export_pkglist(ugrid_dis%pkglist, export_model%loaders, &
                                   export_model%iout)
 
        ! initialize export object
        call ugrid_dis%init(export_model%modelname, export_model%modeltype, &
                            export_model%modelfname, export_model%nc_fname, &
                            export_model%disenum, netcdf_mesh2d, &
                            export_model%iout)
 
        ! define export object
        call ugrid_dis%df()
 
        ! set base pointer
        export_model%nc_export => ugrid_dis
      else if (export_model%nctype == netcdf_structured) then
        ! allocate nc structured grid export object
        allocate (structured_dis)
 
        ! set dis base type
        disbase => num_model%dis
        select type (disbase)
        type is (distype)
          structured_dis%dis => disbase
        end select
 
        ! set dynamic loaders
        call create_export_pkglist(structured_dis%pkglist, export_model%loaders, &
                                   export_model%iout)
 
        ! initialize export object
        call structured_dis%init(export_model%modelname, export_model%modeltype, &
                                 export_model%modelfname, export_model%nc_fname, &
                                 export_model%disenum, netcdf_structured, &
                                 export_model%iout)
 
        ! define export object
        call structured_dis%df()
 
        ! set base pointer
        export_model%nc_export => structured_dis
      end if
    case (disv)
      if (export_model%nctype == netcdf_mesh2d) then
        ! allocate nc structured grid export object
        allocate (ugrid_disv)
 
        ! set dis base type
        disbase => num_model%dis
        select type (disbase)
        type is (disvtype)
          ugrid_disv%disv => disbase
        end select
 
        ! set dynamic loaders
        call create_export_pkglist(ugrid_disv%pkglist, export_model%loaders, &
                                   export_model%iout)
 
        ! initialize export object
        call ugrid_disv%init(export_model%modelname, export_model%modeltype, &
                             export_model%modelfname, export_model%nc_fname, &
                             export_model%disenum, netcdf_mesh2d, &
                             export_model%iout)
 
        ! define export object
        call ugrid_disv%df()
 
        ! set base pointer
        export_model%nc_export => ugrid_disv
      else
        errmsg = 'DISV model discretization only &
                 &supported as UGRID NetCDF export. &
                 &Model='//trim(export_model%modelname)//'.'
        call store_error(errmsg)
        call store_error_filename(export_model%modelfname)
      end if
    case default
      errmsg = 'Unsupported discretization for NetCDF model export. &
               &Model='//trim(export_model%modelname)//'.'
      call store_error(errmsg)
      call store_error_filename(export_model%modelfname)
    end select
  end subroutine create_nc_export
 
  subroutine create_export_pkglist(pkglist, loaders, iout)
    use listmodule, only: listtype
    use memorymanagerextmodule, only: mem_set_value
    use inputloadtypemodule, only: modeldynamicpkgstype
    use inputloadtypemodule, only: dynamicpkgloadbasetype
    use asciiinputloadtypemodule, only: asciidynamicpkgloadbasetype
    use mf6filegridinputmodule, only: boundgridinputtype
    use idmmf6filemodule, only: mf6filedynamicpkgloadtype
    type(listtype), intent(inout) :: pkglist
    type(modeldynamicpkgstype), pointer, intent(in) :: loaders
    integer(I4B), intent(in) :: iout
    class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
    class(asciidynamicpkgloadbasetype), pointer :: rp_loader
    type(exportpackagetype), pointer :: export_pkg
    integer(I4B), pointer :: export_arrays
    class(*), pointer :: obj
    logical(LGP) :: found
    integer(I4B) :: n
 
    ! create list of in scope loaders
    allocate (export_arrays)
 
    do n = 1, loaders%pkglist%Count()
      ! initialize export arrays option
      export_arrays = 0
 
      dynamic_pkg => loaders%get(n)
 
      ! update export arrays option
      call mem_set_value(export_arrays, 'EXPORT_NC', &
                         dynamic_pkg%mf6_input%mempath, found)
 
      if (export_arrays > 0 .and. dynamic_pkg%readasarrays) then
        select type (dynamic_pkg)
        type is (mf6filedynamicpkgloadtype)
          rp_loader => dynamic_pkg%rp_loader
          select type (rp_loader)
          type is (boundgridinputtype)
            ! create the export object
            allocate (export_pkg)
            call export_pkg%init(rp_loader%mf6_input, &
                                 rp_loader%bound_context%mshape, &
                                 rp_loader%param_names, rp_loader%nparam)
            obj => export_pkg
            call pkglist%add(obj)
          end select
        end select
      end if
    end do
 
    ! cleanup
    deallocate (export_arrays)
  end subroutine create_export_pkglist
 
  !> @brief initialize netcdf model export type
  !!
  subroutine nc_export_create()
    use numericalmodelmodule, only: getnumericalmodelfromlist
    use listsmodule, only: basemodellist
    use ncmodelexportmodule, only: netcdf_undef
    integer(I4B) :: n
    type(exportmodeltype), pointer :: export_model
    class(numericalmodeltype), pointer :: num_model
    integer(I4B) :: im
    do n = 1, export_models%Count()
      ! set pointer to export model
      export_model => get_export_model(n)
      if (export_model%nctype /= netcdf_undef) then
        ! netcdf export is active identify model
        do im = 1, basemodellist%Count()
          ! set model pointer
          num_model => getnumericalmodelfromlist(basemodellist, im)
          if (num_model%name == export_model%modelname .and. &
              num_model%macronym == export_model%modeltype) then
            ! allocate and initialize nc export model
            call create_nc_export(export_model, num_model)
            exit
          end if
        end do
      end if
    end do
  end subroutine nc_export_create
 
end module ncexportcreatemodule