Test_FieldSpec.pf Source File

#include "MAPL_TestErr.h"

module Test_FieldSpec
   use funit
   use mapl3g_geom_mgr
   use mapl3g_FieldSpec
   use mapl3g_UngriddedDims
   use mapl3g_UngriddedDim
   use mapl3g_UngriddedDimVector
   use mapl3g_VerticalDimSpec
   use mapl3g_BasicVerticalGrid
   use mapl3g_ESMF_Utilities, only: MAPL_TYPEKIND_MIRROR
   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_can_connect_typekind()
      type(FieldSpec) :: spec_r4, spec_r8, spec_mirror
      type(StringVector) :: import_attributes, export_attributes

      spec_r4 = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m')
      spec_r8 = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R8, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m')
      spec_mirror = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=MAPL_TYPEKIND_MIRROR, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m')

      @assert_that(spec_r4%can_connect_to(spec_r4), is(true()))
      @assert_that(spec_r4%can_connect_to(spec_r8), is(true()))
      @assert_that(spec_r8%can_connect_to(spec_r4), is(true()))
      @assert_that(spec_r8%can_connect_to(spec_r8), is(true()))

      @assert_that(spec_mirror%can_connect_to(spec_r4), is(true()))
      @assert_that(spec_mirror%can_connect_to(spec_r8), is(true()))

   end subroutine test_can_connect_typekind


   @test
   ! Verify that framework detects when an export spec does not
   ! provide mandatory attributes specified by import spec.
   subroutine test_mismatched_attribute()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec
      type(StringVector) :: import_attributes, export_attributes

      call import_attributes%push_back('radius')

      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m', &
           attributes=import_attributes)
      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m', &
           attributes=export_attributes)

      @assert_that(import_spec%can_connect_to(export_spec), is(false()))

   end subroutine test_mismatched_attribute

   @test
   ! Only the import attributes need to match. Not all.
   subroutine test_matched_attribute()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec
      type(StringVector) :: import_attributes, export_attributes

      call import_attributes%push_back('radius')
      call export_attributes%push_back('radius')
      call export_attributes%push_back('other')

      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m', &
           attributes=import_attributes)
      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m', &
           attributes=export_attributes)

      @assert_that(import_spec%can_connect_to(export_spec), is(true()))

   end subroutine test_matched_attribute

   @test
   ! Only the import attributes need to match. Not all.
   subroutine test_multiple_attribute()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec
      type(StringVector) :: import_attributes, export_attributes

      call import_attributes%push_back('radius')
      call import_attributes%push_back('diameter')

      call export_attributes%push_back('other')
      call export_attributes%push_back('radius')
      call export_attributes%push_back('other2')
      call export_attributes%push_back('diameter')


      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m', &
           attributes=import_attributes)
      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', units='m', &
           attributes=export_attributes)

      @assert_that(import_spec%can_connect_to(export_spec), is(true()))

   end subroutine test_multiple_attribute

   @test
   subroutine test_mismatched_units()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec

      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='g')

      @assert_that(import_spec%can_connect_to(export_spec), is(false()))

   end subroutine test_mismatched_units

    @test
   subroutine test_convertible_units()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec

      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='km')

      @assert_that(import_spec%can_connect_to(export_spec), is(true()))

   end subroutine test_convertible_units

   @test
   subroutine test_same_units()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec

      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      @assert_that(import_spec%can_connect_to(export_spec), is(true()))

   end subroutine test_same_units

   @test
   subroutine test_mirror_units()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec


      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector())

      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      @assert_that(import_spec%can_connect_to(export_spec), is(true()))

   end subroutine test_mirror_units

   @test
   subroutine test_mirror_geom()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec

      
      import_spec = FieldSpec( &
           vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector())

      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      @assert_that(import_spec%can_connect_to(export_spec), is(true()))

   end subroutine test_mirror_geom

   @test
   subroutine test_mirror_geom_cost()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec

      
      import_spec = FieldSpec( &
           vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector())

      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = UngriddedDims(), &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      @assert_that(export_spec%extension_cost(import_spec), is(0))

   end subroutine test_mirror_geom_cost

   subroutine test_mirror_ungridded_dims()
      type(FieldSpec) :: import_spec
      type(FieldSpec) :: export_spec
      type(ESMF_Geom) :: geom

      type(UngriddedDims) :: mirror_ungrid, export_dims
      type(UngriddedDimVector) :: ungrid_dims
      type(UngriddedDim) :: ungrid_dim

      mirror_ungrid = mirror_ungridded_dims()
      ungrid_dim = UngriddedDim(2)
      call ungrid_dims%push_back(ungrid_dim)
      export_dims = UngriddedDims(ungrid_dims)

      import_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = mirror_ungrid, &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      export_spec = FieldSpec( &
           geom=geom, vertical_grid=BasicVerticalGrid(1), vertical_dim_spec=VerticalDimSpec(), &
           typekind=ESMF_TYPEKIND_R4, &
           ungridded_dims = export_dims, &
           standard_name='A', long_name='AA', attributes=StringVector(), &
           units='m')

      @assert_that(import_spec%can_connect_to(export_spec), is(true()))

   end subroutine test_mirror_ungridded_dims

end module Test_FieldSpec