Test_SharedIO.pf Source File


This file depends on

sourcefile~~test_sharedio.pf~~EfferentGraph sourcefile~test_sharedio.pf Test_SharedIO.pf sourcefile~sharedio.f90 SharedIO.F90 sourcefile~test_sharedio.pf->sourcefile~sharedio.f90 sourcefile~ungriddeddim.f90 UngriddedDim.F90 sourcefile~test_sharedio.pf->sourcefile~ungriddeddim.f90 sourcefile~ungriddeddims.f90 UngriddedDims.F90 sourcefile~test_sharedio.pf->sourcefile~ungriddeddims.f90 sourcefile~sharedio.f90->sourcefile~ungriddeddim.f90 sourcefile~sharedio.f90->sourcefile~ungriddeddims.f90 sourcefile~base_base.f90 Base_Base.F90 sourcefile~sharedio.f90->sourcefile~base_base.f90 sourcefile~errorhandling.f90 ErrorHandling.F90 sourcefile~sharedio.f90->sourcefile~errorhandling.f90 sourcefile~geom_mgr.f90 geom_mgr.F90 sourcefile~sharedio.f90->sourcefile~geom_mgr.f90 sourcefile~outputinfo.f90 OutputInfo.F90 sourcefile~sharedio.f90->sourcefile~outputinfo.f90 sourcefile~pfio.f90 pFIO.F90 sourcefile~sharedio.f90->sourcefile~pfio.f90 sourcefile~ungriddeddim.f90->sourcefile~errorhandling.f90 sourcefile~lu_bound.f90 LU_Bound.F90 sourcefile~ungriddeddim.f90->sourcefile~lu_bound.f90 sourcefile~ungriddeddims.f90->sourcefile~ungriddeddim.f90 sourcefile~ungriddeddims.f90->sourcefile~errorhandling.f90 sourcefile~ungriddeddims.f90->sourcefile~lu_bound.f90 sourcefile~ungriddeddimvector.f90 UngriddedDimVector.F90 sourcefile~ungriddeddims.f90->sourcefile~ungriddeddimvector.f90

Source Code

module Test_SharedIO

    use pfunit
    use mapl3g_SharedIO
    use mapl3g_UngriddedDims
    use mapl3g_UngriddedDim

    implicit none

    type :: String
       character(len=:), allocatable :: s_
    contains
       procedure, pass(this) :: assign_character_from_string
       generic :: assignment(=) => assign_character_from_string
    end type

    character(len=*), parameter :: DIM_CENTER = 'VERTICAL_DIM_CENTER'
    character(len=*), parameter :: DIM_EDGE = 'VERTICAL_DIM_EDGE'
    character(len=*), parameter :: DIM_UNK = 'UNKNOWN'
    character(len=*), parameter :: CENTER_NAME = 'lev'
    character(len=*), parameter :: EDGE_NAME = 'edge'

    interface make_message
       module procedure :: make_message_string
    end interface make_message

contains

   subroutine assign_character_from_string(ch, this)
      character(len=:), allocatable, intent(inout) :: ch
      class(String), intent(in) :: this

      ch = this%s_

   end subroutine assign_character_from_string

    @Test
    subroutine test_get_vertical_dimension_name()
       character(len=:), allocatable :: name
       character(len=:), allocatable :: vertical_dim
       character(len=:), allocatable :: message

       vertical_dim = DIM_CENTER
       name = CENTER_NAME
       message = make_message('Dimension name does not match for', vertical_dim)
       @assertEqual(name, get_vertical_dimension_name(vertical_dim), message)

       vertical_dim = DIM_EDGE
       name = EDGE_NAME
       message = make_message('Dimension name does not match for', vertical_dim)
       @assertEqual(name, get_vertical_dimension_name(vertical_dim), message)

       vertical_dim = DIM_UNK
       message = make_message('Return value should be empty String', vertical_dim)
       @assertEqual(0, len(get_vertical_dimension_name(DIM_UNK)), message)

    end subroutine test_get_vertical_dimension_name

    @Test
    subroutine test_get_vertical_dimension_num_levels()
      integer, parameter :: NUMLEVELS = 3
      character(:), allocatable :: vertical_dim
      integer :: num_levels
      character(len=:), allocatable :: message

      vertical_dim = DIM_CENTER
      num_levels = NUMLEVELS
      message = make_message('Num_levels does not match for', vertical_dim)
      @assertEqual(num_levels, get_vertical_dimension_num_levels(vertical_dim, NUMLEVELS), message)

      vertical_dim = DIM_EDGE
      num_levels = NUMLEVELS+1
      message = make_message('Num_levels does not match for', vertical_dim)
      @assertEqual(num_levels, get_vertical_dimension_num_levels(vertical_dim, NUMLEVELS), message)

    end subroutine test_get_vertical_dimension_num_levels

    @Test
    subroutine test_cat_ungridded_dim_names()
       type(UngriddedDims) :: dims
       character(len=8), parameter :: NAMES(3) = [character(len=8) :: 'Alice', 'Bob', 'Mallory']

       dims = make_ungridded_dims(NAMES)

    end subroutine test_cat_ungridded_dim_names

    function make_message_string(message, String) result(msg)
       character(len=:), allocatable :: msg
       character(len=*), intent(in) :: message
       character(len=*), intent(in) :: String

       msg = message // ' "' // String // '".'

    end function make_message_string

    function make_ungridded_dims(names) result(dims)
       type(UngriddedDims) :: dims
       character(len=*), intent(in) :: names(:)
       type(UngriddedDim), allocatable :: dims_array(:)
       integer :: i
       character(len=:), allocatable :: name

       allocate(dims_array(size(names)))
       do i = 1, size(names)
         name = trim(names(i))
         dims_array(i) = UngriddedDim(len(name), name=name)
       end do

       dims = UngriddedDims(dims_array)

    end function make_ungridded_dims

   function make_string_array(names) result(array)
      type(String), allocatable :: array(:)
      character(len=*), intent(in) :: names(:)
      integer :: i

      allocate(array(size(names)))

      do i = 1, size(array)
         array(i) = String(names(i))
      end do

    end function make_string_array

end module Test_SharedIO