check_field_value Subroutine

public subroutine check_field_value(expectations, state, short_name, description, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_HConfig), intent(in) :: expectations
type(ESMF_State), intent(inout) :: state
character(len=*), intent(in) :: short_name
character(len=*), intent(in) :: description
integer, intent(out) :: rc

Calls

proc~~check_field_value~~CallsGraph proc~check_field_value check_field_value anyexceptions anyexceptions proc~check_field_value->anyexceptions assert_that assert_that proc~check_field_value->assert_that esmf_fieldget esmf_fieldget proc~check_field_value->esmf_fieldget esmf_hconfigasr4 esmf_hconfigasr4 proc~check_field_value->esmf_hconfigasr4 esmf_hconfigisdefined esmf_hconfigisdefined proc~check_field_value->esmf_hconfigisdefined esmf_stateget esmf_stateget proc~check_field_value->esmf_stateget proc~get_itemtype get_itemtype proc~check_field_value->proc~get_itemtype sourcelocation sourcelocation proc~check_field_value->sourcelocation true true proc~check_field_value->true x2 x2 proc~check_field_value->x2 x3 x3 proc~check_field_value->x3 x4 x4 proc~check_field_value->x4 proc~get_itemtype->anyexceptions proc~get_itemtype->assert_that proc~get_itemtype->esmf_stateget proc~get_itemtype->sourcelocation

Source Code

   subroutine check_field_value(expectations, state, short_name, description, rc)
      type(ESMF_HConfig), intent(in) :: expectations
      type(ESMF_State), intent(inout) :: state
      character(*), intent(in) :: short_name
      character(*), intent(in) :: description
      integer, intent(out) :: rc

      character(len=:), allocatable :: expected_field_typekind_str
      real :: expected_field_value
      integer :: rank
      type(ESMF_TypeKind_Flag) :: typekind
      integer :: status
      character(len=:), allocatable :: msg
      type(ESMF_Field) :: field
      type(ESMF_StateItem_Flag) :: itemtype

      msg = description

      itemtype = get_itemtype(state, short_name, _RC)
      if (itemtype /= ESMF_STATEITEM_FIELD) then ! that's ok
         rc = 0
         return
      end if

     if (.not. ESMF_HConfigIsDefined(expectations,keyString='value')) then 
         rc = 0
         return
      end if

      expected_field_value = ESMF_HConfigAsR4(expectations,keyString='value',_RC)

      call ESMF_StateGet(state, short_name, field, _RC)
      call ESMF_FieldGet(field, typekind=typekind, rank=rank, rc=status)
      @assert_that('field get failed '//short_name,  status, is(0))

      if (typekind == ESMF_TYPEKIND_R4) then
         block
           real(kind=ESMF_KIND_R4), pointer :: x2(:,:),x3(:,:,:),x4(:,:,:,:)
           select case(rank)
           case(2)
              call ESMF_FieldGet(field, farrayptr=x2, _RC)
              @assert_that('value of '//short_name, all(x2 == expected_field_value), is(true()))
           case(3)
              call ESMF_FieldGet(field, farrayptr=x3, _RC)
              @assert_that('value of '//short_name, all(x3 == expected_field_value), is(true()))
           case(4)
              call ESMF_FieldGet(field, farrayptr=x4, _RC)
              @assert_that('value of '//short_name, all(x4 == expected_field_value), is(true()))
           end select
         end block
      elseif (typekind == ESMF_TYPEKIND_R8) then
         block
           real(kind=ESMF_KIND_R8), pointer :: x2(:,:),x3(:,:,:),x4(:,:,:,:)
           select case(rank)
           case(2)
              call ESMF_FieldGet(field, farrayptr=x2, _RC)
              @assert_that('value of '//short_name, all(x2 == expected_field_value), is(true()))
           case(3)
              call ESMF_FieldGet(field, farrayptr=x3, _RC)
              @assert_that('value of '//short_name, all(x3 == expected_field_value), is(true()))
           case(4)
              call ESMF_FieldGet(field, farrayptr=x4, _RC)
              @assert_that('value of '//short_name, all(x4 == expected_field_value), is(true()))
           end select
         end block
      else
         _VERIFY(-1)
      end if

      rc = 0
   end subroutine check_field_value