Merge pull request #2766 from GEOS-ESM/mapl3/tclune/#2729-mirror-vert…

…ical-dim

Fixes #2279 Mapl3/tclune/#2729 mirror vertical dim

generic3g/ComponentSpecParser.F90

@@ -262,6 +262,8 @@ subroutine parse_state_specs(var_specs, hconfig, state_intent, rc)
                  ungridded_dims=ungridded_dim_specs, &
                  dependencies=dependencies &
                  )
+            if (allocated(units)) deallocate(units)
+            if (allocated(standard_name)) deallocate(standard_name)
 
             call var_specs%push_back(var_spec)
 
@@ -359,12 +361,14 @@ function to_VerticalDimSpec(attributes, rc) result(vertical_dim_spec)
          vertical_str= ESMF_HConfigAsString(attributes,keyString=KEY_VERTICAL_DIM_SPEC,_RC)
 
          select case (vertical_str)
-         case ('vertical_dim_none', 'N')
+         case ('vertical_dim_none', 'N', 'NONE')
             vertical_dim_spec = VERTICAL_DIM_NONE
-         case ('vertical_dim_center', 'C')
+         case ('vertical_dim_center', 'C', 'CENTER')
             vertical_dim_spec = VERTICAL_DIM_CENTER
-         case ('vertical_dim_edge', 'E')
+         case ('vertical_dim_edge', 'E', 'EDGE')
             vertical_dim_spec = VERTICAL_DIM_EDGE
+         case ('vertical_dim_mirror', 'M', 'MIRROR')
+            vertical_dim_spec = VERTICAL_DIM_MIRROR
          case default
             _FAIL('Unsupported vertical_dim_spec')
          end select

generic3g/registry/HierarchicalRegistry.F90

@@ -647,13 +647,20 @@ subroutine write_actual_pts(this, virtual_pt, iostat, iomsg)
          type(ActualPtVector), pointer :: actual_pts
          type(ActualConnectionPt), pointer :: actual_pt
          integer :: i
+         class(StateItemSpec), pointer :: spec
+         type(StateItemSpecPtr), pointer :: wrap
 
          actual_pts => this%virtual_pts%at(virtual_pt, rc=iostat)
          if (iostat /= 0) return
 
          do i = 1, actual_pts%size()
             actual_pt => actual_pts%of(i)
-            write(unit,*,iostat=iostat,iomsg=iomsg)'           ',actual_pt, new_line('a')
+
+            spec => null()
+            wrap => this%actual_specs_map%at(actual_pt, rc=iostat)
+            if (iostat /= 0) return
+            if (associated(wrap)) spec => wrap%ptr
+            write(unit,*,iostat=iostat,iomsg=iomsg)'           ',actual_pt, spec%is_active(), new_line('a')
             if (iostat /= 0) return
          end do
 

generic3g/specs/FieldSpec.F90

@@ -38,7 +38,7 @@ module mapl3g_FieldSpec
 
       type(ESMF_Geom), allocatable :: geom
       type(VerticalGeom) :: vertical_geom
-      type(VerticalDimSpec) :: vertical_dim
+      type(VerticalDimSpec) :: vertical_dim = VERTICAL_DIM_UNDEF
       type(ESMF_typekind_flag) :: typekind = ESMF_TYPEKIND_R4
       type(UngriddedDimsSpec) :: ungridded_dims
       type(StringVector) :: attributes
@@ -86,6 +86,7 @@ module mapl3g_FieldSpec
       procedure :: match_geom
       procedure :: match_typekind
       procedure :: match_string
+      procedure :: match_vertical_dim
    end interface match
 
    interface get_cost
@@ -228,7 +229,6 @@ subroutine allocate(this, rc)
 
       call ESMF_FieldGet(this%payload, status=fstatus, _RC)
       _ASSERT(fstatus == ESMF_FIELDSTATUS_COMPLETE, 'ESMF field status problem.')
-
       if (allocated(this%default_value)) then
          call set_field_default(_RC)
       end if
@@ -244,7 +244,7 @@ subroutine set_field_default(rc)
          real(kind=ESMF_KIND_R4), pointer :: x_r4_1d(:),x_r4_2d(:,:),x_r4_3d(:,:,:),x_r4_4d(:,:,:,:)
          real(kind=ESMF_KIND_R8), pointer :: x_r8_1d(:),x_r8_2d(:,:),x_r8_3d(:,:,:),x_r8_4d(:,:,:,:)
          integer :: status, rank
-         
+
          call ESMF_FieldGet(this%payload,rank=rank,_RC) 
          if (this%typekind == ESMF_TYPEKIND_R4) then
             if (rank == 1) then
@@ -325,6 +325,8 @@ subroutine connect_to(this, src_spec, actual_pt, rc)
       interface mirror
          procedure :: mirror_typekind
          procedure :: mirror_string
+         procedure :: mirror_real
+         procedure :: mirror_vertical_dim
       end interface mirror
 
       _ASSERT(this%can_connect_to(src_spec), 'illegal connection')
@@ -336,6 +338,8 @@ subroutine connect_to(this, src_spec, actual_pt, rc)
          this%payload = src_spec%payload
          call mirror(dst=this%typekind, src=src_spec%typekind)
          call mirror(dst=this%units, src=src_spec%units)
+         call mirror(dst=this%vertical_dim, src=src_spec%vertical_dim)
+         call mirror(dst=this%default_value, src=src_spec%default_value)
 
       class default
          _FAIL('Cannot connect field spec to non field spec.')
@@ -362,6 +366,24 @@ subroutine mirror_typekind(dst, src)
          _ASSERT(dst == src, 'unsupported typekind mismatch')
       end subroutine mirror_typekind
 
+      ! Earlier checks should rule out double-mirror before this is
+      ! called.
+      subroutine mirror_vertical_dim(dst, src)
+         type(VerticalDimSpec), intent(inout) :: dst, src
+
+         if (dst == src) return
+
+         if (dst == VERTICAL_DIM_MIRROR) then
+            dst = src
+         end if
+
+         if (src == VERTICAL_DIM_MIRROR) then
+            src = dst
+         end if
+
+         _ASSERT(dst == src, 'unsupported typekind mismatch')
+      end subroutine mirror_vertical_dim
+
       subroutine mirror_string(dst, src)
          character(len=:), allocatable, intent(inout) :: dst, src
 
@@ -377,6 +399,21 @@ subroutine mirror_string(dst, src)
 
       end subroutine mirror_string
 
+      subroutine mirror_real(dst, src)
+         real, allocatable, intent(inout) :: dst, src
+
+         if (allocated(dst) .eqv. allocated(src)) return
+
+         if (.not. allocated(dst)) then
+            dst = src
+         end if
+
+         if (.not. allocated(src)) then
+            src = dst
+         end if
+
+      end subroutine mirror_real
+
    end subroutine connect_to
 
 
@@ -394,7 +431,7 @@ logical function can_connect_to(this, src_spec, rc)
          can_convert_units_ = can_connect_units(this%units, src_spec%units, _RC)
          can_connect_to = all ([ &
               this%ungridded_dims == src_spec%ungridded_dims, &
-              this%vertical_dim == src_spec%vertical_dim, &
+              match(this%vertical_dim,src_spec%vertical_dim), &
               this%ungridded_dims == src_spec%ungridded_dims, & 
               includes(this%attributes, src_spec%attributes), &
               can_convert_units_ &
@@ -589,12 +626,11 @@ end function match_geom
    logical function match_typekind(a, b) result(match)
       type(ESMF_TypeKind_Flag), intent(in) :: a, b
 
-      ! If both typekinds are MIRROR then must fail (but not here)
-      if (a /= b) then
-         match = any([a%dkind,b%dkind] == MAPL_TYPEKIND_MIRROR%dkind)
-      else
-         match = (a == b)
-      end if
+      integer :: n_mirror
+
+      n_mirror = count([a%dkind,b%dkind] == MAPL_TYPEKIND_MIRROR%dkind)
+      match = (n_mirror == 1) .or. (n_mirror == 0 .and. a == b)
+
    end function match_typekind
 
    logical function match_string(a, b) result(match)
@@ -615,6 +651,16 @@ logical function match_string(a, b) result(match)
       match = .false.
    end function match_string
 
+   logical function match_vertical_dim(a, b) result(match)
+      type(VerticalDimSpec), intent(in) :: a, b
+
+      integer :: n_mirror
+
+      n_mirror = count([a,b] == VERTICAL_DIM_MIRROR)
+      match = (n_mirror == 1) .or. (n_mirror == 0 .and. a == b)
+
+   end function match_vertical_dim
+
    logical function mirror(str)
       character(:), allocatable :: str
 

generic3g/specs/VerticalDimSpec.F90

@@ -11,11 +11,13 @@ module mapl3g_VerticalDimSpec
 
    public :: VerticalDimSpec
 
+   public :: VERTICAL_DIM_UNDEF
    public :: VERTICAL_DIM_NONE
    public :: VERTICAL_DIM_CENTER
    public :: VERTICAL_DIM_EDGE
+   public :: VERTICAL_DIM_MIRROR
 
-   public operator(==)
+   public :: operator(==)
 
    type :: VerticalDimSpec
       private
@@ -24,9 +26,11 @@ module mapl3g_VerticalDimSpec
       procedure :: make_info
    end type VerticalDimSpec
 
+   type(VerticalDimSpec), parameter :: VERTICAL_DIM_UNDEF = VerticalDimSpec(-1)
    type(VerticalDimSpec), parameter :: VERTICAL_DIM_NONE = VerticalDimSpec(0)
    type(VerticalDimSpec), parameter :: VERTICAL_DIM_CENTER = VerticalDimSpec(1)
    type(VerticalDimSpec), parameter :: VERTICAL_DIM_EDGE = VerticalDimSpec(2)
+   type(VerticalDimSpec), parameter :: VERTICAL_DIM_MIRROR = VerticalDimSpec(3)
 
    interface operator(==)
       procedure equal_to

generic3g/tests/Test_Scenarios.pf

@@ -297,7 +297,7 @@ contains
       substate = state ! unless
       if (idx /= 0) then
          call ESMF_StateGet(state, short_name(:idx-1), itemtype=itemtype, _RC)
-         @assert_that(itemtype == ESMF_STATEITEM_STATE, is(true()))
+         @assert_that('get item type of '//short_name, itemtype == ESMF_STATEITEM_STATE, is(true()))
          call ESMF_StateGet(state, short_name(:idx-1), substate, _RC)
       end if
       call ESMF_StateGet(substate, short_name(idx+1:), itemtype=itemtype, _RC)
@@ -322,7 +322,7 @@ contains
 
 
       itemtype=get_itemtype(state, short_name, _RC)
-      @assert_that(short_name, expected_itemtype == itemtype, is(true()))
+      @assert_that('check item type of '//short_name, expected_itemtype == itemtype, is(true()))
 
       rc = 0
 
@@ -479,21 +479,22 @@ contains
       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)
+      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(all(x2 == expected_field_value), is(true()))
+              @assert_that('value of '//short_name, all(x2 == expected_field_value), is(true()))
            case(3)
               call ESMF_FieldGet(field, farrayptr=x3, _RC)
-              @assert_that(all(x3 == expected_field_value), is(true()))
+              @assert_that('value of '//short_name, all(x3 == expected_field_value), is(true()))
            case(4)
               call ESMF_FieldGet(field, farrayptr=x4, _RC)
-              @assert_that(all(x4 == expected_field_value), is(true()))
+              @assert_that('value of '//short_name, all(x4 == expected_field_value), is(true()))
            end select
          end block
       elseif (typekind == ESMF_TYPEKIND_R8) then
@@ -506,13 +507,13 @@ contains
                  print*,'x2:',x2
                  print*,'expected:',expected_field_value
               end if
-              @assert_that(all(x2 == expected_field_value), is(true()))
+              @assert_that('value of '//short_name, all(x2 == expected_field_value), is(true()))
            case(3)
               call ESMF_FieldGet(field, farrayptr=x3, _RC)
-              @assert_that(all(x3 == expected_field_value), is(true()))
+              @assert_that('value of '//short_name, all(x3 == expected_field_value), is(true()))
            case(4)
               call ESMF_FieldGet(field, farrayptr=x4, _RC)
-              @assert_that(all(x4 == expected_field_value), is(true()))
+              @assert_that('value of '//short_name, all(x4 == expected_field_value), is(true()))
            end select
          end block
       else

generic3g/tests/scenarios/history_1/B.yaml

@@ -5,8 +5,13 @@ mapl:
       E_B1:
         standard_name:  'E_B1 standard name'
         units: 'm'
-        default_value: 1
+        default_value: 11.
       E_B2:
         standard_name:  'E_B2 standard name'
         units: 'furlong'
-        default_value: 1
+        default_value: 1.
+      E_B3:
+        standard_name:  'E_B3'
+        units: 'm'
+        default_value: 17.
+        vertical_dim_spec: CENTER

generic3g/tests/scenarios/history_1/collection_1.yaml

@@ -14,3 +14,6 @@ mapl:
         typekind: R8
       B/E_B2:
         typekind: mirror
+      B/E_B3:
+        typekind: mirror
+        vertical_dim_spec: MIRROR

generic3g/tests/scenarios/history_1/expectations.yaml

@@ -17,11 +17,13 @@
   export:
     E_B1: {status: gridset}
     E_B2: {status: complete}
+    E_B3: {status: complete, value: 17.}
 
 - component: root/B
   export:
     E_B1: {status: gridset}
     E_B2: {status: complete}
+    E_B3: {status: complete, value: 17.}
 
 - component: root/<user>
   export: {}
@@ -31,23 +33,26 @@
     A/E_A1: {status: complete, value: 1.}
     A/E_A2: {status: gridset}
     B/E_B1: {status: gridset}
-    B/E_B2: {status: complete}
+    B/E_B2: {status: complete, value: 1.}
+    B/E_B3: {status: complete, value: 17.}
 
 - component: history/collection_1/<user>
   import: {}
 
 - component: history/collection_1
   import:
     "A/E_A1": {status: complete, value: 100.} # m -> cm
-    "B/E_B2": {status: complete}
+    "B/E_B2": {status: complete, value: 1.}
+    "B/E_B3": {status: complete, value: 17.}
 
 - component: history/<user>
   import: {}
 
 - component: history
   import:
     "A/E_A1": {status: complete, value: 100.} # m -> cm
-    "B/E_B2": {status: complete}
+    "B/E_B2": {status: complete, value: 1.}
+    "B/E_B3": {status: complete, value: 17.}
 
 - component: <user>
   import: {}