Test_BracketSpec.pf Source File

#include "MAPL_TestErr.h"

module Test_BracketSpec
   use funit
   use mapl3g_BracketSpec
   use mapl3g_FieldSpec
   use mapl3g_UngriddedDims
   use mapl3g_VerticalDimSpec
   use mapl3g_VerticalGrid
   use mapl3g_BasicVerticalGrid
   use mapl3g_ActualConnectionPt
   use mapl3g_StateItemSpec
   use mapl3g_ESMF_Utilities, only: MAPL_TYPEKIND_MIRROR
   use mapl3g_geom_mgr
   use gftl2_StringVector
   use esmf
   implicit none

   type(ESMF_Geom) :: geom

contains

   @before
   subroutine setup()
      type(ESMF_HConfig) :: hconfig
      type(MaplGeom) :: mapl_geom
      type(GeomManager), pointer :: geom_mgr
      integer :: status

      hconfig = ESMF_HConfigCreate(content="{class: latlon, im_world: 12, jm_world: 13, pole: PC, dateline: DC}", _RC)
      geom_mgr => get_geom_manager()
      mapl_geom = geom_mgr%get_mapl_geom(hconfig, _RC)
      geom = mapl_geom%get_geom()
   end subroutine setup

   @test
   subroutine test_mirror_bracket_size()
      type(BracketSpec) :: spec_1, spec_2, spec_mirror

      spec_1 = BracketSpec( &
           field_spec=FieldSpec(geom=geom, vertical_grid=BasicVerticalGrid(), &
           vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='barn'), &
           bracket_size=1)
      spec_2 = BracketSpec( &
           field_spec=FieldSpec(geom=geom, vertical_grid=BasicVerticalGrid(), &
           vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='barn'), &
           bracket_size=2)
      spec_mirror = BracketSpec( &
           field_spec=FieldSpec(geom=geom, vertical_grid=BasicVerticalGrid(), &
           vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='barn'))


      @assert_that(spec_1%can_connect_to(spec_1), is(true()))
      @assert_that(spec_2%can_connect_to(spec_2), is(true()))
      @assert_that(spec_1%can_connect_to(spec_2), is(false()))
      @assert_that(spec_2%can_connect_to(spec_1), is(false()))
      
      @assert_that(spec_mirror%can_connect_to(spec_mirror), is(false()))
      @assert_that(spec_mirror%can_connect_to(spec_1), is(true()))
      @assert_that(spec_mirror%can_connect_to(spec_2), is(true()))
      @assert_that(spec_1%can_connect_to(spec_mirror), is(true()))
      @assert_that(spec_2%can_connect_to(spec_mirror), is(true()))

   end subroutine test_mirror_bracket_size

   @test
   ! Verify that once a bracket size mirrors some concrete value it
   ! can no longer connect to other for bracket size. But can connect to
   ! specs with bracket size the same as first connection.
   subroutine test_connect_unique_mirror()
      type(BracketSpec) :: spec_1, spec_1b, spec_2, spec_mirror
      type(ActualConnectionPt) :: actual_pt

      integer :: status

      spec_1 = BracketSpec( &
           field_spec=FieldSpec(geom=geom, vertical_grid=BasicVerticalGrid(), &
           vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='barn'), &
           bracket_size=1)
      spec_1b = spec_1

      spec_2 = BracketSpec( &
           field_spec=FieldSpec(geom=geom, vertical_grid=BasicVerticalGrid(), &
           vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='barn'), &
           bracket_size=2)
      spec_mirror = BracketSpec( &
           field_spec=FieldSpec(geom=geom, vertical_grid=BasicVerticalGrid(), &
           vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='barn'))

      call spec_mirror%create(rc=status)
      @assert_that(status, is(0))
      call spec_mirror%connect_to(spec_1, actual_pt, rc=status)
      @assert_that(status, is(0))

      @assert_that(spec_mirror%can_connect_to(spec_2), is(false()))
      @assert_that(spec_mirror%can_connect_to(spec_1b), is(true()))

   end subroutine test_connect_unique_mirror
      

end module Test_BracketSpec