Fixes #3961 statistics gridcomp

esmf_utils/UngriddedDims.F90

@@ -52,10 +52,14 @@ module mapl3g_UngriddedDims
 
 contains
 
-   function new_UngriddedDims_empty() result(spec)
+   function new_UngriddedDims_empty(is_mirror) result(spec)
       type(UngriddedDims) :: spec
+      logical, optional, intent(in) :: is_mirror
 
       spec%dim_specs = UngriddedDimVector()
+      if (present(is_mirror)) then
+         spec%is_mirror = is_mirror
+      end if
 
    end function new_UngriddedDims_empty
 

field/FieldCreate.F90

@@ -112,6 +112,7 @@ subroutine field_empty_complete(field, &
          allocate(grid_to_field_map(dim_count), source=[(idim, idim=1,dim_count)])
       end if
       bounds = make_bounds(num_levels=num_levels, ungridded_dims=ungridded_dims)
+
       call ESMF_FieldEmptyComplete( &
            field, &
            typekind=typekind, &

field/FieldGet.F90

@@ -28,6 +28,8 @@ subroutine field_get(field, unusable, &
         ungridded_dims, &
         units, standard_name, long_name, &
         allocation_status, &
+        has_deferred_aspects, &
+        regridder_param_info, &
         rc)
       type(ESMF_Field), intent(in) :: field
       class(KeywordEnforcer), optional, intent(in) :: unusable
@@ -43,13 +45,15 @@ subroutine field_get(field, unusable, &
       character(len=:), optional, allocatable, intent(out) :: standard_name
       character(len=:), optional, allocatable, intent(out) :: long_name
       type(StateItemAllocation), optional, intent(out) :: allocation_status
+      logical, optional, intent(out) :: has_deferred_aspects
+      type(esmf_Info), optional, allocatable,  intent(out) :: regridder_param_info
       integer, optional, intent(out) :: rc
 
       integer :: status
       type(ESMF_Info) :: field_info
       character(len=ESMF_MAXSTR) :: fname
       type(ESMF_FieldStatus_Flag) :: fstatus
-      integer, allocatable :: vgrid_id
+      integer :: vgrid_id
       type(VerticalGridManager), pointer :: vgrid_manager
 
       if (present(short_name)) then
@@ -68,28 +72,31 @@ subroutine field_get(field, unusable, &
          end if
       end if
 
-      if (present(vgrid)) then
-         allocate(vgrid_id) ! trigger "is present"
-      end if
-
       if (present(typekind)) then
-         call ESMF_FieldGet(field, typekind=typekind, _RC)
+!#         call ESMF_FieldGet(field, typekind=typekind, _RC)
       end if
 
       call ESMF_InfoGetFromHost(field, field_info, _RC)
       call FieldInfoGetInternal(field_info, &
+           typekind=typekind, &
            num_levels=num_levels, &
            vert_staggerloc=vert_staggerloc, &
            num_vgrid_levels=num_vgrid_levels, &
            ungridded_dims=ungridded_dims, &
            units=units, standard_name=standard_name, long_name=long_name, &
-           allocation_status=allocation_status, &
            vgrid_id=vgrid_id, &
+           allocation_status=allocation_status, &
+           has_deferred_aspects=has_deferred_aspects, &
+           regridder_param_info=regridder_param_info, &
            _RC)
 
       if (present(vgrid)) then
-         vgrid_manager => get_vertical_grid_manager()
-         vgrid => vgrid_manager%get_grid(id=vgrid_id, _RC)
+         if (vgrid_id == VERTICAL_GRID_NOT_FOUND) then
+            vgrid => null()
+         else
+            vgrid_manager => get_vertical_grid_manager()
+            vgrid => vgrid_manager%get_grid(id=vgrid_id, _RC)
+         end if
       end if
 
       _RETURN(_SUCCESS)

field/FieldInfo.F90

@@ -6,6 +6,7 @@ module mapl3g_FieldInfo
    use mapl3g_esmf_info_keys, only: INFO_INTERNAL_NAMESPACE
    use mapl3g_esmf_info_keys, only: INFO_PRIVATE_NAMESPACE
    use mapl3g_InfoUtilities
+   use mapl3g_VerticalGrid_API
    use mapl3g_UngriddedDims
    use mapl3g_VerticalStaggerLoc
    use mapl3g_StateItemAllocation
@@ -59,13 +60,15 @@ module mapl3g_FieldInfo
    character(*), parameter :: KEY_VERT_DIM = "/vert_dim"
    character(*), parameter :: KEY_UNGRIDDED_DIMS = "/ungridded_dims"
    character(*), parameter :: KEY_ALLOCATION_STATUS = "/allocation_status"
+   character(*), parameter :: KEY_REGRIDDER_PARAM = "/EsmfRegridderParam"
 
    character(*), parameter :: KEY_UNDEF_VALUE = "/undef_value"
    character(*), parameter :: KEY_MISSING_VALUE = "/missing_value"
    character(*), parameter :: KEY_FILL_VALUE = "/_FillValue"
 
    character(*), parameter :: KEY_SPEC_HANDLE = "/spec_handle"
    character(*), parameter :: KEY_RESTART_MODE = "/restart_mode"
+   character(*), parameter :: KEY_HAS_DEFERRED_ASPECTS = "/has_deferred_aspects"
 
 contains
 
@@ -75,9 +78,11 @@ subroutine field_info_set_internal(info, unusable, &
         num_levels, vert_staggerloc, &
         ungridded_dims, &
         units, long_name, standard_name, &
-        allocation_status, &
         vgrid_id, &
         spec_handle, &
+        allocation_status, &
+        has_deferred_aspects, &
+        regridder_param_info, &
         rc)
       type(ESMF_Info), intent(inout) :: info
       class(KeywordEnforcer), optional, intent(in) :: unusable
@@ -91,7 +96,9 @@ subroutine field_info_set_internal(info, unusable, &
       character(*), optional, intent(in) :: long_name
       character(*), optional, intent(in) :: standard_name
       type(StateItemAllocation), optional, intent(in) :: allocation_status
+      logical, optional, intent(in) :: has_deferred_aspects
       integer, optional, intent(in) :: spec_handle(:)
+      type(esmf_info), optional, intent(in) :: regridder_param_info
       integer, optional, intent(out) :: rc
 
       integer :: status
@@ -116,6 +123,7 @@ subroutine field_info_set_internal(info, unusable, &
       if (present(ungridded_dims)) then
          ungridded_info = ungridded_dims%make_info(_RC)
          call MAPL_InfoSet(info, namespace_ // KEY_UNGRIDDED_DIMS, ungridded_info, _RC)
+         call esmf_InfoDestroy(ungridded_info, _RC)
       end if
 
       if (present(units)) then
@@ -134,13 +142,18 @@ subroutine field_info_set_internal(info, unusable, &
          call MAPL_InfoSet(info, namespace_ // KEY_NUM_LEVELS, num_levels, _RC)
       end if
 
+      if (present(regridder_param_info)) then
+         call MAPL_InfoSet(info, namespace_ // KEY_REGRIDDER_PARAM, regridder_param_info, _RC)
+         _HERE
+      end if
+
       if (present(vert_staggerloc)) then
          call MAPL_InfoSet(info, namespace_ // KEY_VERT_STAGGERLOC, vert_staggerloc%to_string(), _RC)
 
          ! Delete later - needed for transition
 
          if (present(num_levels) .and. present(vert_staggerloc)) then
-            
+
             if (vert_staggerLoc == VERTICAL_STAGGER_NONE) then
                call MAPL_InfoSet(info, namespace_ // KEY_VERT_DIM, "VERTICAL_DIM_NONE", _RC)
                call MAPL_InfoSet(info, namespace_ // KEY_NUM_VGRID_LEVELS, 0, _RC)
@@ -161,6 +174,10 @@ subroutine field_info_set_internal(info, unusable, &
          call MAPL_InfoSet(info, namespace_ // KEY_ALLOCATION_STATUS, allocation_status%to_string(), _RC)
       end if
 
+      if (present(has_deferred_aspects)) then
+         call MAPL_InfoSet(info, namespace_ // KEY_HAS_DEFERRED_ASPECTS, has_deferred_aspects, _RC)
+      end if
+
       if (present(spec_handle)) then
          call MAPL_InfoSet(info, namespace_ // KEY_SPEC_HANDLE, spec_handle, _RC)
       end if
@@ -179,6 +196,8 @@ subroutine field_info_get_internal(info, unusable, &
         ungridded_dims, &
         allocation_status, &
         spec_handle, &
+        has_deferred_aspects, &
+        regridder_param_info, &
         rc)
       type(ESMF_Info), intent(in) :: info
       class(KeywordEnforcer), optional, intent(in) :: unusable
@@ -194,16 +213,17 @@ subroutine field_info_get_internal(info, unusable, &
       type(UngriddedDims), optional, intent(out) :: ungridded_dims
       type(StateItemAllocation), optional, intent(out) :: allocation_status
       integer, optional, allocatable, intent(out) :: spec_handle(:)
+      logical, optional, intent(out) :: has_deferred_aspects
+      type(esmf_Info), allocatable, optional, intent(out) :: regridder_param_info
       integer, optional, intent(out) :: rc
 
       integer :: status
       integer :: num_levels_
-      type(ESMF_Info) :: ungridded_info
+      type(esmf_Info) :: ungridded_info
       character(:), allocatable :: vert_staggerloc_str, allocation_status_str
       type(VerticalStaggerLoc) :: vert_staggerloc_
       character(:), allocatable :: namespace_ 
       character(:), allocatable :: str
-      logical :: key_is_present
       logical :: is_present
 
       namespace_ = INFO_INTERNAL_NAMESPACE
@@ -212,7 +232,8 @@ subroutine field_info_get_internal(info, unusable, &
       end if
 
       if (present(vgrid_id)) then
-         call mapl_InfoGet(info, namespace_ // KEY_VGRID_ID, vgrid_id, _RC)
+         call esmf_InfoGet(info, key=namespace_ // KEY_VGRID_ID, &
+              value=vgrid_id, default=VERTICAL_GRID_NOT_FOUND, _RC)
       end if
 
       if (present(typekind)) then
@@ -221,14 +242,32 @@ subroutine field_info_get_internal(info, unusable, &
       end if
 
       if (present(ungridded_dims)) then
-         ungridded_info = ESMF_InfoCreate(info, namespace_ // KEY_UNGRIDDED_DIMS, _RC)
-         ungridded_dims = make_UngriddedDims(ungridded_info, _RC)
+         is_present = esmf_InfoIsPresent(info, namespace_ // KEY_UNGRIDDED_DIMS, _RC)
+         if (is_present) then
+            ungridded_info = ESMF_InfoCreate(info, namespace_ // KEY_UNGRIDDED_DIMS, _RC)
+            ungridded_dims = make_UngriddedDims(ungridded_info, _RC)
+            call esmf_InfoDestroy(ungridded_info, _RC)
+         else
+            ungridded_dims = UngriddedDims(is_mirror=.true.)
+         end if
+      end if
+
+      if (present(regridder_param_info)) then
+         is_present = esmf_InfoIsPresent(info, namespace_ // KEY_REGRIDDER_PARAM, _RC)
+         if (is_present) then
+            regridder_param_info = esmf_InfoCreate(info, namespace_ // KEY_REGRIDDER_PARAM, _RC)
+         end if
       end if
 
       if (present(num_levels) .or. present(num_vgrid_levels)) then
-         call MAPL_InfoGet(info, namespace_ // KEY_NUM_LEVELS, num_levels_, _RC)
-         if (present(num_levels)) then
-            num_levels = num_levels_
+         is_present = esmf_InfoIsPresent(info, namespace_ // KEY_NUM_LEVELS, _RC)
+         if (is_present) then
+            call MAPL_InfoGet(info, namespace_ // KEY_NUM_LEVELS, num_levels_, _RC)
+            if (present(num_levels)) then
+               num_levels = num_levels_
+            end if
+         else
+            num_levels = 0
          end if
       end if
 
@@ -242,7 +281,7 @@ subroutine field_info_get_internal(info, unusable, &
 
       if (present(num_vgrid_levels)) then
          if (vert_staggerloc_ == VERTICAL_STAGGER_NONE) then
-            num_vgrid_levels = 0
+            num_vgrid_levels = 0 ! num_levels_ must not be used here
          else if (vert_staggerloc_ == VERTICAL_STAGGER_EDGE) then
             num_vgrid_levels = num_levels_ - 1
          else if (vert_staggerloc_ == VERTICAL_STAGGER_CENTER) then
@@ -252,8 +291,11 @@ subroutine field_info_get_internal(info, unusable, &
          end if
       end if
 
-      if (present(units)) then
-         call MAPL_InfoGet(info, namespace_ // KEY_UNITS, units, _RC)
+      if (present(units)) then ! leave unallocated unless found
+         is_present = esmf_InfoIsPresent(info, key=namespace_ // KEY_UNITS, _RC)
+         if (is_present) then 
+            call MAPL_InfoGet(info, namespace_ // KEY_UNITS, units, _RC)
+         end if
       end if
 
       if (present(long_name)) then
@@ -273,7 +315,12 @@ subroutine field_info_get_internal(info, unusable, &
          call MAPL_InfoGet(info, namespace_ // KEY_SPEC_HANDLE, spec_handle, _RC)
       end if
 
-      _RETURN(_SUCCESS)
+      if (present(has_deferred_aspects)) then
+         call esmf_InfoGet(info, key=namespace_ // KEY_HAS_DEFERRED_ASPECTS, &
+              value=has_deferred_aspects, default=.false., _RC)
+      end if
+
+     _RETURN(_SUCCESS)
       _UNUSED_DUMMY(unusable)
    end subroutine field_info_get_internal
 

field/FieldPointerUtilities.F90

@@ -383,7 +383,10 @@ function get_local_element_count(x, rc) result(element_count)
       integer :: status
       integer :: rank
 
+      element_count = [integer :: ] ! must allocate even under failure
       call ESMF_FieldGet(x, rank=rank, _RC)
+
+      deallocate(element_count)
       allocate(element_count(rank))
       ! ESMF has a big fat bug with multi tile grids and loal element count
       !call ESMF_FieldGet(x, localElementCount=element_count, _RC)
@@ -482,7 +485,6 @@ subroutine clone(x, y, rc)
       call ESMF_InfoGetFromHost(x, x_info, _RC)
       call ESMF_InfoGetFromHost(y, y_info, _RC)
       call ESMF_InfoUpdate(y_info, x_info, recursive=.true., _RC)
-      y_info = x_info
 
       _RETURN(_SUCCESS)
    end subroutine clone
@@ -891,8 +893,13 @@ subroutine MAPL_FieldGetLocalElementCount(field,local_count,rc)
       integer(kind=ESMF_KIND_I4), pointer :: i4_1d(:),i4_2d(:,:),i4_3d(:,:,:),i4_4d(:,:,:,:)
       integer(kind=ESMF_KIND_I8), pointer :: i8_1d(:),i8_2d(:,:),i8_3d(:,:,:),i8_4d(:,:,:,:)
 
+      integer, parameter :: MAX_RANK = 4
+
+      local_count = [integer :: ] ! default in case of failure
       call ESMF_FieldGet(field,rank=rank,typekind=tk,_RC)
+      _ASSERT(rank <= MAX_RANK, 'Need to extend FieldPointerUtilities for rank > 4.')
 
+      deallocate(local_count)
       if (tk == ESMF_TypeKind_R4) then
          select case(rank)
          case(1)

field/FieldSet.F90

@@ -4,6 +4,7 @@ module mapl3g_FieldSet
    use mapl3g_VerticalGrid_API
    use mapl3g_FieldInfo
    use mapl3g_FieldDelta
+   use mapl3g_StateItemAllocation
    use mapl_KeywordEnforcer
    use mapl_ErrorHandling
    use mapl3g_UngriddedDims
@@ -28,9 +29,12 @@ subroutine field_set(field, &
         typekind, &
         unusable, &
         num_levels, &
-        units, &
+        units, standard_name, long_name, &
         ungridded_dims, &
         attributes, &
+        allocation_status, &
+        has_deferred_aspects, &
+        regridder_param_info, &
         rc)
 
 
@@ -42,8 +46,13 @@ subroutine field_set(field, &
       type(esmf_TypeKind_Flag), optional, intent(in) :: typekind
       integer, optional, intent(in) :: num_levels
       character(len=*), optional, intent(in) :: units
+      character(len=*), optional, intent(in) :: standard_name
+      character(len=*), optional, intent(in) :: long_name
       type(UngriddedDims), optional, intent(in) :: ungridded_dims
       type(StringVector), optional, intent(in) :: attributes
+      type(StateItemAllocation), optional, intent(in) :: allocation_status
+      logical, optional, intent(in) :: has_deferred_aspects
+      type(esmf_Info), optional, intent(in) :: regridder_param_info
       integer, optional, intent(out) :: rc
 
       integer :: status
@@ -58,6 +67,11 @@ subroutine field_set(field, &
          call field_delta%update_field(field, _RC)
       end if
 
+      if (fstatus /= ESMF_FIELDSTATUS_COMPLETE .and. present(geom)) then
+         call esmf_FieldEmptyReset(field, status=ESMF_FIELDSTATUS_EMPTY, _RC)
+         call esmf_FieldEmptySet(field, geom=geom, _RC)
+      end if
+
       if (present(vgrid)) then
          vgrid_id = vgrid%get_id() ! allocate so "present" below
       end if
@@ -66,8 +80,14 @@ subroutine field_set(field, &
       call FieldInfoSetInternal(field_info, &
            vgrid_id=vgrid_id, &
            vert_staggerloc=vert_staggerloc, &
-           typekind=typekind, units=units, &
-           ungridded_dims=ungridded_dims, _RC)
+           num_levels=num_levels, &
+           typekind=typekind, &
+           units=units, standard_name=standard_name, long_name=long_name, &
+           ungridded_dims=ungridded_dims, &
+           allocation_status=allocation_status, &
+           has_deferred_aspects=has_deferred_aspects, &
+           regridder_param_info=regridder_param_info, &
+           _RC)
 
       _RETURN(_SUCCESS)
    end subroutine field_set