check_field_vertical_profile Subroutine

public subroutine check_field_vertical_profile(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_vertical_profile~~CallsGraph proc~check_field_vertical_profile check_field_vertical_profile anyexceptions anyexceptions proc~check_field_vertical_profile->anyexceptions assert_that assert_that proc~check_field_vertical_profile->assert_that equal_to equal_to proc~check_field_vertical_profile->equal_to esmf_fieldget esmf_fieldget proc~check_field_vertical_profile->esmf_fieldget esmf_hconfigasr4seq esmf_hconfigasr4seq proc~check_field_vertical_profile->esmf_hconfigasr4seq esmf_hconfigisdefined esmf_hconfigisdefined proc~check_field_vertical_profile->esmf_hconfigisdefined esmf_stateget esmf_stateget proc~check_field_vertical_profile->esmf_stateget proc~get_itemtype get_itemtype proc~check_field_vertical_profile->proc~get_itemtype sourcelocation sourcelocation proc~check_field_vertical_profile->sourcelocation x3 x3 proc~check_field_vertical_profile->x3 x4 x4 proc~check_field_vertical_profile->x4 proc~get_itemtype->anyexceptions proc~get_itemtype->assert_that proc~get_itemtype->esmf_stateget proc~get_itemtype->sourcelocation

Source Code

   subroutine check_field_vertical_profile(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

      real, allocatable :: expected_vertical_profile(:)
      integer :: rank
      type(ESMF_TypeKind_Flag) :: typekind
      integer :: status
      character(len=:), allocatable :: msg
      type(ESMF_Field) :: field
      type(ESMF_StateItem_Flag) :: itemtype
      integer :: i, j, l, shape3(3), shape4(4)

      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='vertical_profile')) then
         rc = 0
         return
      end if

      expected_vertical_profile = ESMF_HConfigAsR4Seq(expectations,keyString='vertical_profile',_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 :: x3(:, :, :), x4(:, :, :, :)
            select case(rank)
            case(3)
               call ESMF_FieldGet(field, farrayPtr=x3, _RC)
               shape3 = shape(x3)
               do i = 1, shape3(1)
                  do j = 1, shape3(2)
                     @assert_that("value of "//short_name, x3(i, j, :), is(equal_to(expected_vertical_profile)))
                  end do
               end do
            case(4)
               call ESMF_FieldGet(field, farrayPtr=x4, _RC)
               shape4 = shape(x4)
               do i = 1, shape4(1)
                  do j = 1, shape4(2)
                     do l = 1, shape4(4)
                        @assert_that("value of "//short_name, x4(i, j, :, l), is(equal_to(expected_vertical_profile)))
                     end do
                  end do
               end do
            case default
               error stop "invalid rank"
            end select
         end block
      elseif (typekind == ESMF_TYPEKIND_R8) then
         block
            real(kind=ESMF_KIND_R8), pointer :: x3(:, :, :), x4(:, :, :, :)
            select case(rank)
            case(3)
               call ESMF_FieldGet(field, farrayPtr=x3, _RC)
               shape3 = shape(x3)
               do i = 1, shape3(1)
                  do j = 1, shape3(2)
                     @assert_that("value of "//short_name, x3(i, j, :), is(equal_to(expected_vertical_profile)))
                  end do
               end do
            case(4)
               call ESMF_FieldGet(field, farrayPtr=x4, _RC)
               shape4 = shape(x4)
               do i = 1, shape4(1)
                  do j = 1, shape4(2)
                     do l = 1, shape4(4)
                        @assert_that("value of "//short_name, x4(i, j, :, l), is(equal_to(expected_vertical_profile)))
                     end do
                  end do
               end do
            case default
               error stop "invalid rank"
            end select
         end block
      else
         _VERIFY(-1)
      end if

      rc = 0
   end subroutine check_field_vertical_profile