x_comp_realize_field Subroutine

private subroutine x_comp_realize_field(xstate, xfield, state, rc)

Arguments

Type IntentOptional Attributes Name
type(xdata_state), intent(inout), pointer :: xstate
type(xdata_field), intent(inout), pointer :: xfield
type(ESMF_State), intent(inout) :: state
integer, intent(out) :: rc

Source Code

  subroutine x_comp_realize_field(xstate, xfield, state, rc)
    ! arguments
    type(xdata_state), pointer, intent(inout) :: xstate
    type(xdata_field), pointer, intent(inout) :: xfield
    type(ESMF_State), intent(inout)  :: state
    integer, intent(out)             :: rc
    ! local variables
    integer :: stat

    rc = ESMF_SUCCESS

    if (.not. associated(xstate)) then
      call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, &
        msg='XDATA: xstate has not been associated', &
        line=__LINE__, file=__FILE__, rcToReturn=rc)
      return
    endif

    if (.not. associated(xfield)) then
      call ESMF_LogSetError(ESMF_RC_MEM_ALLOCATE, &
        msg=trim(xstate%cname)//": xfield error", &
        line=__LINE__, &
        file=__FILE__, &
        rcToReturn=rc)
      return
    endif

    if (associated(xfield%efld)) then
      call ESMF_LogSetError(ESMF_RC_MEM_ALLOCATE, &
        msg=trim(xstate%cname)//": ESMF_Field error - "//trim(xfield%stdn), &
        line=__LINE__, &
        file=__FILE__, &
        rcToReturn=rc)
      return
    endif
    allocate(xfield%efld, stat=stat)
    if (ESMF_LogFoundAllocError(statusToCheck=stat, &
      msg=trim(xstate%cname)//': Memory allocation failed.', &
      line=__LINE__, &
      file=__FILE__, &
      rcToReturn=rc)) return

    if (xfield%fdim .eq. 3) then
      xfield%efld = ESMF_FieldCreate(name=trim(xfield%stdn), grid=xstate%grid, &
        typekind=ESMF_TYPEKIND_R8, gridToFieldMap=(/1,3/), &
      ungriddedLBound=(/1/), ungriddedUBound=(/xstate%nz/), rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      call ESMF_FieldGet(xfield%efld, farrayPtr=xfield%ptr3, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
    elseif (xfield%fdim .eq. 2) then
      xfield%efld = ESMF_FieldCreate(name=trim(xfield%stdn), grid=xstate%grid, &
        typekind=ESMF_TYPEKIND_R8, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      call ESMF_FieldGet(xfield%efld, farrayPtr=xfield%ptr2, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
    else
      call ESMF_LogSetError(ESMF_RC_NOT_IMPL, &
        msg=trim(xstate%cname)//": field dimension - "//trim(xfield%stdn), &
        line=__LINE__, file=__FILE__, rcToReturn=rc)
      return
    endif

    call NUOPC_Realize(state, field=xfield%efld, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return
    call ESMF_FieldFill(xfield%efld, dataFillScheme="const", &
      const1=0.0_ESMF_KIND_R8, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return
    xfield%rlze = .true.
  endsubroutine x_comp_realize_field