test_change_weights Subroutine

public subroutine test_change_weights(this)

Arguments

Type IntentOptional Attributes Name
class(ESMF_TestMethod), intent(inout) :: this

Calls

proc~~test_change_weights~~CallsGraph proc~test_change_weights test_change_weights anyexceptions anyexceptions proc~test_change_weights->anyexceptions assert_that assert_that proc~test_change_weights->assert_that assertequal assertequal proc~test_change_weights->assertequal equal_to equal_to proc~test_change_weights->equal_to esmf_fieldget esmf_fieldget proc~test_change_weights->esmf_fieldget every_item every_item proc~test_change_weights->every_item interface~mapl_fieldbundleget~2 MAPL_FieldBundleGet proc~test_change_weights->interface~mapl_fieldbundleget~2 interface~mapl_fieldget MAPL_FieldGet proc~test_change_weights->interface~mapl_fieldget none~update_bundle FieldBundleDelta%update_bundle proc~test_change_weights->none~update_bundle proc~setup_bundle setup_bundle proc~test_change_weights->proc~setup_bundle proc~setup_geom setup_geom proc~test_change_weights->proc~setup_geom proc~teardown_bundle teardown_bundle proc~test_change_weights->proc~teardown_bundle proc~teardown_geom teardown_geom proc~test_change_weights->proc~teardown_geom sourcelocation sourcelocation proc~test_change_weights->sourcelocation true true proc~test_change_weights->true none~update_bundle->interface~mapl_fieldbundleget~2 interface~mapl_fieldbundleset MAPL_FieldBundleSet none~update_bundle->interface~mapl_fieldbundleset none~reallocate_bundle FieldBundleDelta%reallocate_bundle none~update_bundle->none~reallocate_bundle none~update_fields FieldDelta%update_fields none~update_bundle->none~update_fields proc~mapl_return MAPL_Return none~update_bundle->proc~mapl_return proc~mapl_verify MAPL_Verify none~update_bundle->proc~mapl_verify esmf_fieldbundleadd esmf_fieldbundleadd proc~setup_bundle->esmf_fieldbundleadd esmf_fieldbundlecreate esmf_fieldbundlecreate proc~setup_bundle->esmf_fieldbundlecreate proc~setup_bundle->interface~mapl_fieldbundleset none~add_dim UngriddedDims%add_dim proc~setup_bundle->none~add_dim proc~setup_field setup_field proc~setup_bundle->proc~setup_field ESMF_GeomCreate ESMF_GeomCreate proc~setup_geom->ESMF_GeomCreate ESMF_GridCreateNoPeriDim ESMF_GridCreateNoPeriDim proc~setup_geom->ESMF_GridCreateNoPeriDim proc~teardown_bundle->interface~mapl_fieldbundleget~2 esmf_fieldbundledestroy esmf_fieldbundledestroy proc~teardown_bundle->esmf_fieldbundledestroy esmf_fielddestroy esmf_fielddestroy proc~teardown_bundle->esmf_fielddestroy ESMF_GeomDestroy ESMF_GeomDestroy proc~teardown_geom->ESMF_GeomDestroy ESMF_GeomGet ESMF_GeomGet proc~teardown_geom->ESMF_GeomGet ESMF_GridDestroy ESMF_GridDestroy proc~teardown_geom->ESMF_GridDestroy

Source Code

   subroutine test_change_weights(this)
      class(ESMF_TestMethod), intent(inout) :: this

      integer :: status
      type(Fieldbundledelta) :: delta
      type(ESMF_Geom) :: geom, tmp_geom
      type(ESMF_FieldBundle) :: bundle
      integer :: i
      type(ESMF_Field), allocatable :: fieldList(:)
      real(kind=ESMF_KIND_R4), pointer :: x_r4(:,:)
      character(:), allocatable :: new_units
      real(kind=ESMF_KIND_R4), allocatable :: weights(:)
      real(kind=ESMF_KIND_R4), parameter :: NEW_WEIGHTS(*) = [0.,0.25,0.75]

      call setup_geom(geom, 4)
      call setup_bundle(bundle, weights=DEFAULT_WEIGHTS, geom=geom, typekind=ESMF_TYPEKIND_R4, units='km')

      delta = FieldBundleDelta(interpolation_weights=NEW_WEIGHTS) 
      call delta%update_bundle(bundle, _RC) ! should not reallocate fields

      call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC)
      @assert_that(size(fieldList), is(FIELD_COUNT))

      do i = 1, FIELD_COUNT
         call ESMF_FieldGet(fieldList(i), fArrayPtr=x_r4, _RC)
         @assert_that(shape(x_r4), is(equal_to([4,4])))
         @assert_that(x_r4, every_item(is(FILL_VALUE)))

         call MAPL_FieldGet(fieldList(i), units=new_units, _RC)
         @assertEqual('km', new_units)

         call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC)
         @assert_that(tmp_geom == geom, is(true()))
      end do

      call MAPL_FieldBundleGet(bundle, interpolation_weights=weights, _RC)
      @assert_that(weights, is(equal_to(new_weights)))

      call teardown_bundle(bundle)
      call teardown_geom(geom)

      _UNUSED_DUMMY(this)
   end subroutine test_change_weights