Merge pull request #2975 from GEOS-ESM/feature/bmauer/fixes-#2969

Fixes  #2969

base/MAPL_VerticalMethods.F90

@@ -166,8 +166,7 @@ function skip_var(this,field,rc) result(skip)
         integer :: status
         character(len=ESMF_MAXSTR) :: name
 
-        call ESMF_FieldGet(field,name=name,rc=status)
-        _VERIFY(status)
+        call ESMF_FieldGet(field,name=name,_RC)
         skip = trim(name)==trim(this%vvar)
      end function skip_var
 
@@ -185,8 +184,7 @@ subroutine setup_eta_to_pressure(this,regrid_handle,output_grid,rc)
 
         if (allocated(this%ple3d)) deallocate(this%ple3d)
         if (allocated(this%pl3d)) deallocate(this%pl3d)
-        call ESMF_FieldGet(this%interp_var,localde=0,farrayptr=ptr3,rc=status)
-        _VERIFY(status)
+        call ESMF_FieldGet(this%interp_var,localde=0,farrayptr=ptr3,_RC)
 
         allocate(orig_surface_level(size(ptr3,1),size(ptr3,2)),stat=status)
         _VERIFY(status)
@@ -242,16 +240,14 @@ subroutine setup_eta_to_pressure(this,regrid_handle,output_grid,rc)
        end if
        if (present(output_grid)) then
           _ASSERT(present(regrid_handle),"Must provide regridding handle")
-          call MAPL_GridGet(output_grid,localCellCountPerDim=counts,rc=status)
-          _VERIFY(status)
+          call MAPL_GridGet(output_grid,localCellCountPerDim=counts,_RC)
           if (.not.allocated(this%surface_level)) then
               allocate(this%surface_level(counts(1),counts(2)),stat=status)
              _VERIFY(status)
           end if
        end if
        if (present(regrid_handle)) then
-          call regrid_handle%regrid(orig_surface_level,this%surface_level,rc=status)
-          _VERIFY(status)
+          call regrid_handle%regrid(orig_surface_level,this%surface_level,_RC)
        end if
        deallocate(orig_surface_level)
 
@@ -411,11 +407,9 @@ subroutine correct_topo(this,field,rc)
            call ESMF_FieldGet(field,grid=grid,_RC)
            has_de = MAPL_GridHasDE(grid,_RC)
            if (has_de) then
-              call ESMF_FieldGet(field,rank=rank,rc=status)
-              _VERIFY(status)
+              call ESMF_FieldGet(field,rank=rank,_RC)
               if (rank==3) then
-                 call ESMF_FieldGet(field,0,farrayptr=ptr,rc=status)
-                 _VERIFY(status)
+                 call ESMF_FieldGet(field,0,farrayptr=ptr,_RC)
                  do k=1,size(ptr,3)
                     if (this%ascending) then
                        where(this%surface_level<this%scaled_levels(k)) ptr(:,:,k)=MAPL_UNDEF
@@ -452,8 +446,7 @@ subroutine get_interpolating_variable(this,bundle,rc)
 
         integer :: status
 
-        call ESMF_FieldBundleGet(bundle,fieldName=trim(this%vvar),field=this%interp_var,rc=status)
-        _VERIFY(status)
+        call ESMF_FieldBundleGet(bundle,fieldName=trim(this%vvar),field=this%interp_var,_RC)
 
      end subroutine get_interpolating_variable
 
@@ -482,53 +475,49 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc)
         integer :: status
         type(Variable) :: v
         logical :: isPresent
+        character(len=4) :: positive
 
         ! loop over variables in file
-        call ESMF_FieldBundleGet(bundle,fieldCount=NumVars,rc=status)
-        _VERIFY(status)
+        call ESMF_FieldBundleGet(bundle,fieldCount=NumVars,_RC)
         allocate(VarDims(numVars),location(numVars))
 
         allocate(hasUngrid(NumVars))
         hasUngrid=.false.
-        allocate(ungridded_names(NumVars), stat=STATUS)
-        _VERIFY(STATUS)
+        allocate(ungridded_names(NumVars), _STAT)
         ungridded_names=""
-        allocate(ungridded_units(NumVars), stat=STATUS)
-        _VERIFY(STATUS)
+        allocate(ungridded_units(NumVars), _STAT)
         ungridded_units=""
 
         do i=1,numVars
-           call ESMF_FieldBundleGet(bundle,i,field,rc=status)
-           _VERIFY(status)
-           call ESMF_FieldGet(field,dimCount=FieldRank,rc=status)
-           _VERIFY(status)
-           call ESMF_AttributeGet(field,name="VLOCATION", value=location(i),rc=status)
+           call ESMF_FieldBundleGet(bundle,i,field,_RC)
+           call ESMF_AttributeGet(field,name="POSITIVE", value=positive, _RC)
+           if (i .eq. 1) this%positive=positive
+           if (i .gt. 1) then
+              _ASSERT(this%positive==positive,"Fields have mistmatched positive attributes")
+              this%positive=positive
+           end if
+           call ESMF_FieldGet(field,dimCount=FieldRank,_RC)
+           call ESMF_AttributeGet(field,name="VLOCATION", value=location(i),_RC)
            if (fieldRank==2) then
               varDims(i)=0
            else if (fieldRank==3) then
-              call ESMF_FieldGet(field,farrayPtr=ptr3d,rc=status)
-              _VERIFY(status)
+              call ESMF_FieldGet(field,farrayPtr=ptr3d,_RC)
               varDims(i)=size(ptr3d,3)
               if (location(i) == MAPL_VLocationNone) then
                  hasUngrid(I) = .true.
-                 call ESMF_AttributeGet(field,NAME="UNGRIDDED_UNIT",value=ungridded_unit,rc=status)
-                 _VERIFY(STATUS)
-                 call ESMF_AttributeGet(field,NAME="UNGRIDDED_NAME",value=ungridded_name,rc=status)
-                 _VERIFY(STATUS)
+                 call ESMF_AttributeGet(field,NAME="UNGRIDDED_UNIT",value=ungridded_unit,_RC)
+                 call ESMF_AttributeGet(field,NAME="UNGRIDDED_NAME",value=ungridded_name,_RC)
                  ungridded_names(i) = ungridded_name
                  ungridded_units(i) = ungridded_unit
-                 call ESMF_AttributeGet(field,NAME="UNGRIDDED_COORDS",isPresent=isPresent,rc=status)
-                 _VERIFY(STATUS)
+                 call ESMF_AttributeGet(field,NAME="UNGRIDDED_COORDS",isPresent=isPresent,_RC)
                  if (isPresent) then
-                    call ESMF_AttributeGet(field,NAME="UNGRIDDED_COORDS",itemcount=ungrdsize,rc=status)
-                    _VERIFY(STATUS)
+                    call ESMF_AttributeGet(field,NAME="UNGRIDDED_COORDS",itemcount=ungrdsize,_RC)
                     if (ungrdsize/=0) then
                        _ASSERT(varDims(i)==ungrdsize,"ungridded size does not match variable")
                        if (.not.allocated(ungridded_coord)) allocate(ungridded_coord(ungrdsize),stat=status)
                        if (.not.allocated(ungridded_coords)) allocate(ungridded_coords(NumVars,ungrdsize),stat=status)
                        _VERIFY(STATUS)
-                       call ESMF_AttributeGet(field,NAME="UNGRIDDED_COORDS",valuelist=ungridded_coord,rc=status)
-                       _VERIFY(STATUS)
+                       call ESMF_AttributeGet(field,NAME="UNGRIDDED_COORDS",valuelist=ungridded_coord,_RC)
                        ungridded_coords(i,:) = ungridded_coord
                     end if
                  end if
@@ -612,29 +601,27 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc)
                    this%levs=ungridded_coord
                  end if
 
-                 call metadata%add_dimension('lev', lm, rc=status)
+                 call metadata%add_dimension('lev', lm)
                  v = Variable(type=PFIO_REAL64, dimensions='lev')
                  call v%add_attribute('units',ungridded_unit)
                  call v%add_attribute('standard_name',ungridded_name)
                  call v%add_attribute('coordinate','N/A')
                  call v%add_const_value(UnlimitedEntity(this%levs))
-                 call metadata%add_variable('lev',v,rc=status)
-                 _VERIFY(status)
+                 call metadata%add_variable('lev',v,_RC)
               else
-                 call metadata%add_dimension('lev', lm, rc=status)
+                 call metadata%add_dimension('lev', lm)
                  v = Variable(type=PFIO_REAL64, dimensions='lev')
                  call v%add_attribute('long_name',this%long_name)
                  call v%add_attribute('units',this%vunit)
                  call v%add_attribute('positive',trim(this%positive))
                  call v%add_attribute('coordinate',this%vcoord)
                  call v%add_attribute('standard_name',this%standard_name)
                  call v%add_const_value(UnlimitedEntity(this%levs))
-                 call metadata%add_variable('lev',v,rc=status)
-                 _VERIFY(status)
+                 call metadata%add_variable('lev',v,_RC)
               end if
 
            else if (this%regrid_type == VERTICAL_METHOD_ETA2LEV) then
-              call metadata%add_dimension('lev', size(this%levs), rc=status)
+              call metadata%add_dimension('lev', size(this%levs))
               v = Variable(type=PFIO_REAL64, dimensions='lev')
               call v%add_attribute('long_name','vertical level')
               call v%add_attribute('units',trim(this%vunit))
@@ -646,20 +633,18 @@ subroutine append_vertical_metadata(this,metadata,bundle,rc)
               call v%add_attribute('coordinate',trim(this%vvar))
               call v%add_attribute('standard_name',trim(this%vvar)//"_level")
               call v%add_const_value(UnlimitedEntity(this%levs))
-              call metadata%add_variable('lev',v,rc=status)
-              _VERIFY(status)
+              call metadata%add_variable('lev',v,_RC)
 
            else if (this%regrid_type == VERTICAL_METHOD_SELECT) then
-              call metadata%add_dimension('lev', lm, rc=status)
+              call metadata%add_dimension('lev', lm)
               v = Variable(type=PFIO_REAL64, dimensions='lev')
               call v%add_attribute('long_name','vertical level')
               call v%add_attribute('units','layer')
               call v%add_attribute('positive','down')
               call v%add_attribute('coordinate','eta')
               call v%add_attribute('standard_name','model_layers')
               call v%add_const_value(UnlimitedEntity(this%levs))
-              call metadata%add_variable('lev',v,rc=status)
-              _VERIFY(status)
+              call metadata%add_variable('lev',v,_RC)
            end if
         end if
         _RETURN(_SUCCESS)

generic/CMakeLists.txt

@@ -22,7 +22,6 @@ set (srcs
   VarSpecPtr.F90
   VarConnPoint.F90
   VarConnType.F90
-  VariableSpecification.F90
   VarSpecMiscMod.F90
   VarSpecVector.F90
   VarConnPoint.F90

generic/ComponentSpecification.F90

@@ -1,5 +1,4 @@
 module mapl_ComponentSpecification
-   use mapl_VariableSpecification
    use mapl_StateSpecification
    implicit none
    private

generic/MAPL_Generic.F90

@@ -133,6 +133,7 @@ module MAPL_GenericMod
    use MaplShared, only: get_file_extension
    use MAPL_RunEntryPoint
    use MAPL_ResourceMod
+   use MAPL_VarSpecTypeMod, only: positive_length
    use, intrinsic :: ISO_C_BINDING
    use, intrinsic :: iso_fortran_env, only: REAL32, REAL64, int32, int64
    use, intrinsic :: iso_fortran_env, only: OUTPUT_UNIT
@@ -3452,7 +3453,7 @@ subroutine MAPL_StateAddExportSpec_(GC, SHORT_NAME, LONG_NAME,            &
         UNGRIDDED_UNIT, UNGRIDDED_NAME,     &
         UNGRIDDED_COORDS,                     &
         FIELD_TYPE, STAGGERING, ROTATION, &
-        DEPENDS_ON, DEPENDS_ON_CHILDREN, RC )
+        DEPENDS_ON, DEPENDS_ON_CHILDREN, POSITIVE, RC )
 
       !ARGUMENTS:
       type (ESMF_GridComp)            , intent(INOUT)   :: GC
@@ -3477,6 +3478,7 @@ subroutine MAPL_StateAddExportSpec_(GC, SHORT_NAME, LONG_NAME,            &
       integer            , optional   , intent(IN)      :: ROTATION
       logical            , optional   , intent(IN)      :: DEPENDS_ON_CHILDREN
       character (len=*)  , optional   , intent(IN)      :: DEPENDS_ON(:)
+      character(len=*)   , optional,    intent(IN)      :: positive
       integer            , optional   , intent(OUT)     :: RC
       !EOPI
 
@@ -3543,6 +3545,7 @@ subroutine MAPL_StateAddExportSpec_(GC, SHORT_NAME, LONG_NAME,            &
            ROTATION = ROTATION,                                                  &
            DEPENDS_ON = DEPENDS_ON, &
            DEPENDS_ON_CHILDREN = DEPENDS_ON_CHILDREN, &
+           positive = positive, &
            RC=status  )
       _VERIFY(status)
 
@@ -6439,6 +6442,7 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC)
       integer                                 :: rstReq
       logical                                 :: isPresent
       logical                                 :: isCreated
+      character(len=positive_length)          :: positive
 
       integer :: range_(2)
       type(MAPL_VarSpec), pointer :: varspec
@@ -6487,6 +6491,7 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC)
               FIELD_TYPE=FIELD_TYPE, &
               STAGGERING=STAGGERING, &
               ROTATION=ROTATION, &
+              positive=positive, &
               RC=status )
          _VERIFY(status)
 
@@ -6772,6 +6777,8 @@ subroutine MAPL_StateCreateFromSpecNew(STATE,SPEC,DEFER,range, RC)
          _VERIFY(status)
          call ESMF_AttributeSet(FIELD, NAME='UNITS', VALUE=UNITS, RC=status)
          _VERIFY(status)
+         call ESMF_AttributeSet(FIELD, NAME='POSITIVE', VALUE=positive, RC=status)
+         _VERIFY(status)
 
          call ESMF_AttributeSet(FIELD, NAME='REFRESH_INTERVAL', VALUE=REFRESH, RC=status)
          _VERIFY(status)

generic/MaplGeneric.F90

@@ -2,7 +2,6 @@ module MaplGeneric
    use mapl_AbstractComponent
    use mapl_MaplComponent
    use mapl_ComponentSpecification
-   use mapl_VariableSpecification
    use mapl_StateSpecification
    use mapl_VarSpecMiscMod
    use mapl_VarSpecVector

generic/StateSpecification.F90

@@ -7,7 +7,7 @@ module mapl_StateSpecification
    use mapl_ErrorHandlingMod
    use mapl_VarSpecVector
    use mapl_VarSpecMiscMod
-   use mapl_VariableSpecification
+   use MAPL_VarSpecTypeMod
    implicit none
 
    private
@@ -99,6 +99,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME,     &
                              ROTATION,   & 
                              GRID, &
                              DEPENDS_ON, DEPENDS_ON_CHILDREN, &
+                             POSITIVE, &
                                                                    RC  )
 
     type (StateSpecification), intent(inout):: SPEC
@@ -134,6 +135,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME,     &
     type(ESMF_Grid)    , optional   , intent(IN)      :: GRID
     logical            , optional   , intent(IN)      :: DEPENDS_ON_CHILDREN
     character (len=*)  , optional   , intent(IN)      :: DEPENDS_ON(:)
+    character(len=*)   , optional   , intent(IN)      :: positive
     integer            , optional   , intent(OUT)     :: RC
 
 
@@ -172,6 +174,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME,     &
     character(len=ESMF_MAXSTR) :: useableUngrd_Name
     real                      , pointer :: usableUNGRIDDED_COORDS(:) => NULL()
     logical                    :: usableDEPENDS_ON_CHILDREN
+    character(len=positive_length) :: usablePositive
 !    character (len=:), allocatable :: usableDEPENDS_ON(:)
 
     INTEGER :: I
@@ -413,6 +416,12 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME,     &
          usableUNGRIDDED_COORDS = UNGRIDDED_COORDS
       end if
 
+      if (present(POSITIVE)) then
+         usablePositive = positive
+      else
+         usablePositive = 'down'
+      end if
+
       I = spec%var_specs%size()
       allocate(tmp%specptr)
 
@@ -444,6 +453,7 @@ subroutine MAPL_VarSpecCreateInListNew(SPEC, SHORT_NAME, LONG_NAME,     &
       TMP%SPECPTR%ROTATION =  usableROTATION
       TMP%SPECPTR%doNotAllocate    =  .false.
       TMP%SPECPTR%alwaysAllocate   =  .false.
+      TMP%SPECPTR%positive = usablePositive
       if(associated(usableATTR_IVALUES)) then
          TMP%SPECPTR%ATTR_IVALUES  =>  usableATTR_IVALUES
       else