test_retrieve_multi Subroutine

public subroutine test_retrieve_multi()

Arguments

None

Calls

proc~~test_retrieve_multi~2~~CallsGraph proc~test_retrieve_multi~2 test_retrieve_multi ESMF_GridEmptyCreate ESMF_GridEmptyCreate proc~test_retrieve_multi~2->ESMF_GridEmptyCreate ESMF_InfoGetFromHost ESMF_InfoGetFromHost proc~test_retrieve_multi~2->ESMF_InfoGetFromHost ESMF_InfoSet ESMF_InfoSet proc~test_retrieve_multi~2->ESMF_InfoSet assertequal assertequal proc~test_retrieve_multi~2->assertequal asserttrue asserttrue proc~test_retrieve_multi~2->asserttrue at at proc~test_retrieve_multi~2->at get_name get_name proc~test_retrieve_multi~2->get_name insert insert proc~test_retrieve_multi~2->insert make_regridder make_regridder proc~test_retrieve_multi~2->make_regridder mockregridderfactory mockregridderfactory proc~test_retrieve_multi~2->mockregridderfactory regridderfactoryspec regridderfactoryspec proc~test_retrieve_multi~2->regridderfactoryspec regridderspec regridderspec proc~test_retrieve_multi~2->regridderspec throw throw proc~test_retrieve_multi~2->throw

Source Code

   subroutine test_retrieve_multi()
      type (ESMF_Grid), target :: g_A, g_B, g_C
      type (RegridderSpec) :: regridder_spec
      type (RegridderFactorySpec) :: spec_AB, spec_BC, spec_CB
      type (RegridderFactoryRegistry) :: registry

      class (AbstractRegridderFactory), pointer :: factory
      class (AbstractRegridder), allocatable :: regridder
      type (ESMF_Info) :: infoha, infohb, infohc


      g_A = ESMF_GridEmptyCreate()
      g_B = ESMF_GridEmptyCreate()
      g_C = ESMF_GridEmptyCreate()

      call ESMF_InfoGetFromHost(g_A,infoha)
      call ESMF_InfoSet(infoha,'GridType','A')
      call ESMF_InfoGetFromHost(g_B,infohb)
      call ESMF_InfoSet(infohb,'GridType','B')
      call ESMF_InfoGetFromHost(g_C,infohc)
      call ESMF_InfoSet(infohc,'GridType','C')

      regridder_spec = RegridderSpec(g_A, g_B)
      spec_AB = RegridderFactorySpec(regridder_spec)
      call registry%insert(spec_AB, MockRegridderFactory('A to B'))

      regridder_spec = RegridderSpec(g_B, g_C)
      spec_BC = RegridderFactorySpec(regridder_spec)
      call registry%insert(spec_BC, MockRegridderFactory('B to C'))
      
      regridder_spec = RegridderSpec(g_C, g_B)
      spec_CB = RegridderFactorySpec(regridder_spec)
      call registry%insert(spec_CB, MockRegridderFactory('C to B'))
      
      factory => registry%at(spec_AB)
      @assertTrue(associated(factory))

      regridder_spec = RegridderSpec(g_C, g_A)
      allocate(regridder, source=factory%make_regridder(regridder_spec))
      select type (regridder)
      type is (MockRegridder)
         @assertEqual('A to B::C -> A', regridder%get_name())
      class default
         call throw('incorrect type of regridder returned')
      end select
      deallocate(regridder)

      factory => registry%at(spec_BC)
      @assertTrue(associated(factory))

      allocate(regridder, source=factory%make_regridder(regridder_spec))
      select type (regridder)
      type is (MockRegridder)
         @assertEqual('B to C::C -> A', regridder%get_name())
      class default
         call throw('incorrect type of regridder returned')
      end select
      deallocate(regridder)

      factory => registry%at(spec_CB)
      @assertTrue(associated(factory))

      allocate(regridder, source=factory%make_regridder(regridder_spec))
      select type (regridder)
      type is (MockRegridder)
         @assertEqual('C to B::C -> A', regridder%get_name())
      class default
         call throw('incorrect type of regridder returned')
      end select
      deallocate(regridder)
      
   end subroutine test_retrieve_multi