UngriddedDimSpec.F90 Source File


Files dependent on this one

sourcefile~~ungriddeddimspec.f90~~AfferentGraph sourcefile~ungriddeddimspec.f90 UngriddedDimSpec.F90 sourcefile~dimspec.f90 DimSpec.F90 sourcefile~dimspec.f90->sourcefile~ungriddeddimspec.f90 sourcefile~oomph.f90 oomph.F90 sourcefile~oomph.f90->sourcefile~ungriddeddimspec.f90 sourcefile~oomph.f90->sourcefile~dimspec.f90 sourcefile~fieldspec.f90 FieldSpec.F90 sourcefile~oomph.f90->sourcefile~fieldspec.f90 sourcefile~fieldspec.f90->sourcefile~dimspec.f90 sourcefile~varconnpoint.f90 VarConnPoint.F90 sourcefile~varconnpoint.f90->sourcefile~oomph.f90 sourcefile~varspectype.f90 VarSpecType.F90 sourcefile~varspectype.f90->sourcefile~oomph.f90 sourcefile~mapl_generic.f90 MAPL_Generic.F90 sourcefile~mapl_generic.f90->sourcefile~varspectype.f90 sourcefile~varspec.f90 VarSpec.F90 sourcefile~mapl_generic.f90->sourcefile~varspec.f90 sourcefile~statespecification.f90 StateSpecification.F90 sourcefile~statespecification.f90->sourcefile~varspectype.f90 sourcefile~varspecmiscmod.f90 VarSpecMiscMod.F90 sourcefile~statespecification.f90->sourcefile~varspecmiscmod.f90 sourcefile~varconn.f90 VarConn.F90 sourcefile~varconn.f90->sourcefile~varconnpoint.f90 sourcefile~varconntype.f90 VarConnType.F90 sourcefile~varconn.f90->sourcefile~varconntype.f90 sourcefile~varconn.f90->sourcefile~varspec.f90 sourcefile~varconntype.f90->sourcefile~varconnpoint.f90 sourcefile~varspec.f90->sourcefile~varspectype.f90 sourcefile~varspecmiscmod.f90->sourcefile~varconnpoint.f90 sourcefile~varspecmiscmod.f90->sourcefile~varspectype.f90 sourcefile~varspecmiscmod.f90->sourcefile~varconn.f90 sourcefile~varspecmiscmod.f90->sourcefile~varconntype.f90 sourcefile~varspecmiscmod.f90->sourcefile~varspec.f90 sourcefile~comp_testing_driver.f90 Comp_Testing_Driver.F90 sourcefile~comp_testing_driver.f90->sourcefile~mapl_generic.f90 sourcefile~componentspecification.f90 ComponentSpecification.F90 sourcefile~componentspecification.f90->sourcefile~statespecification.f90 sourcefile~extdatagridcompmod.f90 ExtDataGridCompMod.F90 sourcefile~extdatagridcompmod.f90->sourcefile~mapl_generic.f90 sourcefile~extdatagridcompmod.f90->sourcefile~varspec.f90 sourcefile~extdatagridcompng.f90 ExtDataGridCompNG.F90 sourcefile~extdatagridcompng.f90->sourcefile~mapl_generic.f90 sourcefile~extdatagridcompng.f90->sourcefile~varspec.f90 sourcefile~genericcplcomp.f90 GenericCplComp.F90 sourcefile~genericcplcomp.f90->sourcefile~varspecmiscmod.f90 sourcefile~mapl.f90 MAPL.F90 sourcefile~mapl.f90->sourcefile~mapl_generic.f90 sourcefile~mapl.f90->sourcefile~varspecmiscmod.f90 sourcefile~mapl_capgridcomp.f90 MAPL_CapGridComp.F90 sourcefile~mapl_capgridcomp.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_geosatmaskmod.f90 MAPL_GeosatMaskMod.F90 sourcefile~mapl_geosatmaskmod.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_historycollection.f90 MAPL_HistoryCollection.F90 sourcefile~mapl_historycollection.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_historygridcomp.f90 MAPL_HistoryGridComp.F90 sourcefile~mapl_historygridcomp.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_historygridcomp.f90->sourcefile~varspecmiscmod.f90 sourcefile~mapl_orbgridcompmod.f90 MAPL_OrbGridCompMod.F90 sourcefile~mapl_orbgridcompmod.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_stationsamplermod.f90 MAPL_StationSamplerMod.F90 sourcefile~mapl_stationsamplermod.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_trajectorymod.f90 MAPL_TrajectoryMod.F90 sourcefile~mapl_trajectorymod.f90->sourcefile~mapl_generic.f90 sourcefile~maplgeneric.f90 MaplGeneric.F90 sourcefile~maplgeneric.f90->sourcefile~statespecification.f90 sourcefile~maplgeneric.f90->sourcefile~varconn.f90 sourcefile~maplgeneric.f90->sourcefile~varconntype.f90 sourcefile~maplgeneric.f90->sourcefile~varspecmiscmod.f90 sourcefile~test_varspec.pf Test_VarSpec.pf sourcefile~test_varspec.pf->sourcefile~varspec.f90 sourcefile~varconnvector.f90 VarConnVector.F90 sourcefile~varconnvector.f90->sourcefile~varconntype.f90 sourcefile~varspecptr.f90 VarSpecPtr.F90 sourcefile~varspecptr.f90->sourcefile~varspec.f90 sourcefile~varspecvector.f90 VarSpecVector.F90 sourcefile~varspecvector.f90->sourcefile~varspec.f90

Source Code

module oomph_UngriddedDimSpec
   implicit none
   private

   public :: UngriddedDimSpec
   public :: UNKNOWN_DIM_NAME
   public :: UNKNOWN_DIM_UNITS

   type :: UngriddedDimSpec
      private
      character(:), allocatable :: name
      character(:), allocatable :: units
      real, allocatable :: coordinates(:)
   contains
      procedure :: get_extent
      procedure :: get_name
      procedure :: get_units
      procedure :: get_coordinates
   end type UngriddedDimSpec

   interface UngriddedDimSpec
      module procedure new_UngriddedDimSpec_extent
      module procedure new_UngriddedDimSpec_name_and_coords
      module procedure new_UngriddedDimSpec_name_units_and_coords
   end interface UngriddedDimSpec

   character(*), parameter :: UNKNOWN_DIM_NAME = 'unknown dim name'
   character(*), parameter :: UNKNOWN_DIM_UNITS = 'unknown_dim_units'

contains

   pure function new_UngriddedDimSpec_extent(extent) result(spec)
      integer, intent(in) :: extent
      type(UngriddedDimSpec) :: spec

      spec = UngriddedDimSpec(UNKNOWN_DIM_NAME, UNKNOWN_DIM_UNITS, default_coords(extent))
   end function new_UngriddedDimSpec_extent


   pure function default_coords(extent) result(coords)
      real, allocatable :: coords(:)
      integer, intent(in) :: extent

      integer :: i
      coords = [(i, i=1, extent)]

   end function default_coords
     

   pure function new_UngriddedDimSpec_name_and_coords(name, coordinates) result(spec)
      type(UngriddedDimSpec) :: spec
      character(*), intent(in) :: name
      real, intent(in) :: coordinates(:)

      spec = UngriddedDimSpec(name, UNKNOWN_DIM_UNITS, coordinates)

   end function new_UngriddedDimSpec_name_and_coords

   pure function new_UngriddedDimSpec_name_units_and_coords(name, units, coordinates) result(spec)
      type(UngriddedDimSpec) :: spec
      character(*), intent(in) :: name
      character(*), intent(in) :: units
      real, intent(in) :: coordinates(:)

      spec%name = name
      spec%units = units
      spec%coordinates = coordinates

   end function new_UngriddedDimSpec_name_units_and_coords

   pure integer function get_extent(this) result(extent)
      class(UngriddedDimSpec), intent(in) :: this
      extent = size(this%coordinates)
   end function get_extent

   pure function get_name(this) result(name)
      character(:), allocatable :: name
      class(UngriddedDimSpec), intent(in) :: this
      name = this%name
   end function get_name

   pure function get_units(this) result(units)
      character(:), allocatable :: units
      class(UngriddedDimSpec), intent(in) :: this
      units = this%units
   end function get_units

   ! Default coordinates are:  [1., 2., ...]
   pure function get_coordinates(this) result(coordinates)
      real, allocatable :: coordinates(:)
      class(UngriddedDimSpec), intent(in) :: this
      coordinates = this%coordinates
   end function get_coordinates

end module oomph_UngriddedDimSpec