Merge pull request #331 from lawrencepj1/clm5_maxpftcft

Added code to put the PCT_NAT_PFT_MAX and PCT_CFT_MAX on the landuse.…

tools/mksurfdata_map/src/mkpctPftTypeMod.F90

@@ -46,6 +46,7 @@ module mkpctPftTypeMod
   end type pct_pft_type
 
   ! !PUBLIC MEMBER FUNCTIONS
+  public :: update_max_array ! given an array of pct_pft_type variables update the max_p2l values from pct_p2l
   public :: get_pct_p2l_array ! given an array of pct_pft_type variables, return a 2-d array of pct_p2l
   public :: get_pct_l2g_array ! given an array of pct_pft_type variables, return an array of pct_l2g
 
@@ -409,8 +410,6 @@ subroutine remove_small_cover(this, too_small, nsmall)
     deallocate(pct_p2g, is_small, is_zero)
   end subroutine remove_small_cover
 
-
-
   ! ========================================================================
   ! Private member functions
   ! ========================================================================
@@ -511,6 +510,54 @@ end subroutine check_vals
   ! Module-level routines (not member functions)
   ! ========================================================================
 
+  !-----------------------------------------------------------------------
+  subroutine update_max_array(pct_pft_max_arr,pct_pft_arr)
+    !
+    ! !DESCRIPTION:
+    ! Given an array of pct_pft_type variables, update all the max_p2l variables.
+    !
+    ! Assumes that all elements of pct_pft_max_arr and pct_pft_arr have the same 
+    ! size and lower bound for their pct_p2l array.
+    !
+    ! !ARGUMENTS:
+    ! workaround for gfortran bug (58043): declare this 'type' rather than 'class':
+    type(pct_pft_type), intent(inout) :: pct_pft_max_arr(:)
+    type(pct_pft_type), intent(in) :: pct_pft_arr(:)
+    !
+    ! !LOCAL VARIABLES:
+    integer :: pft_lbound
+    integer :: pft_ubound
+    integer :: arr_index
+    integer :: pft_index
+
+    character(len=*), parameter :: subname = 'update_max_array'
+    !-----------------------------------------------------------------------
+
+
+    pft_lbound = lbound(pct_pft_arr(1)%pct_p2l, 1)
+    pft_ubound = ubound(pct_pft_arr(1)%pct_p2l, 1)
+
+    do arr_index = 1, size(pct_pft_arr)
+       if (lbound(pct_pft_arr(arr_index)%pct_p2l, 1) /= pft_lbound .or. &
+            ubound(pct_pft_arr(arr_index)%pct_p2l, 1) /= pft_ubound) then
+          write(6,*) subname//' ERROR: all elements of pct_pft_arr must have'
+          write(6,*) 'the same size and lower bound for their pct_p2l array'
+          call abort()
+       end if
+
+       if (pct_pft_arr(arr_index)%pct_l2g > pct_pft_max_arr(arr_index)%pct_l2g) then
+          pct_pft_max_arr(arr_index)%pct_l2g = pct_pft_arr(arr_index)%pct_l2g
+       end if
+
+       do pft_index = pft_lbound, pft_ubound
+          if (pct_pft_arr(arr_index)%pct_p2l(pft_index) > pct_pft_max_arr(arr_index)%pct_p2l(pft_index)) then
+             pct_pft_max_arr(arr_index)%pct_p2l(pft_index) = pct_pft_arr(arr_index)%pct_p2l(pft_index)
+	  end if
+       end do
+    end do
+
+  end subroutine update_max_array
+
   !-----------------------------------------------------------------------
   function get_pct_p2l_array(pct_pft_arr) result(pct_p2l)
     !

tools/mksurfdata_map/src/mkpftMod.F90

@@ -1008,6 +1008,8 @@ subroutine mkpftAtt( ncid, dynlanduse, xtype )
      call ncd_def_spatial_var(ncid=ncid, varname='PCT_CROP', xtype=xtype, &
           lev1name='time', &
           long_name='total percent crop landunit', units='unitless')
+     call ncd_def_spatial_var(ncid=ncid, varname='PCT_CROP_MAX', xtype=xtype, &
+          long_name='maximum total percent crop landunit during time period', units='unitless')
   end if
 
   ! PCT_NAT_PFT
@@ -1019,6 +1021,9 @@ subroutine mkpftAtt( ncid, dynlanduse, xtype )
      call ncd_def_spatial_var(ncid=ncid, varname='PCT_NAT_PFT', xtype=xtype, &
           lev1name='natpft', lev2name='time', &
           long_name='percent plant functional type on the natural veg landunit (% of landunit)', units='unitless')
+     call ncd_def_spatial_var(ncid=ncid, varname='PCT_NAT_PFT_MAX', xtype=xtype, &
+          lev1name='natpft', &
+          long_name='maximum percent plant functional type during time period (% of landunit)', units='unitless')
   end if
 
   ! PCT_CFT
@@ -1031,6 +1036,9 @@ subroutine mkpftAtt( ncid, dynlanduse, xtype )
         call ncd_def_spatial_var(ncid=ncid, varname='PCT_CFT', xtype=xtype, &
              lev1name='cft', lev2name='time', &
              long_name='percent crop functional type on the crop landunit (% of landunit)', units='unitless')
+        call ncd_def_spatial_var(ncid=ncid, varname='PCT_CFT_MAX', xtype=xtype, &
+             lev1name='cft', &
+             long_name='maximum percent crop functional type during time period (% of landunit)', units='unitless')
      end if
   end if
 

tools/mksurfdata_map/src/mksurfdat.F90

@@ -15,7 +15,7 @@ program mksurfdat
     use shr_kind_mod       , only : r8 => shr_kind_r8, r4 => shr_kind_r4
     use fileutils          , only : opnfil, getavu
     use mklaiMod           , only : mklai
-    use mkpctPftTypeMod    , only : pct_pft_type, get_pct_p2l_array, get_pct_l2g_array
+    use mkpctPftTypeMod    , only : pct_pft_type, get_pct_p2l_array, get_pct_l2g_array, update_max_array
     use mkpftConstantsMod  , only : natpft_lb, natpft_ub, cft_lb, cft_ub, num_cft
     use mkpftMod           , only : pft_idx, pft_frc, mkpft, mkpftInit, mkpft_parse_oride
     use mksoilMod          , only : soil_sand, soil_clay, mksoiltex, mksoilInit, &
@@ -90,9 +90,11 @@ program mksurfdat
     real(r8), allocatable  :: pctlnd_pft(:)      ! PFT data: % of gridcell for PFTs
     real(r8), allocatable  :: pctlnd_pft_dyn(:)  ! PFT data: % of gridcell for dyn landuse PFTs
     integer , allocatable  :: pftdata_mask(:)    ! mask indicating real or fake land type
-    type(pct_pft_type), allocatable :: pctnatpft(:) ! % of grid cell that is nat veg, and breakdown into PFTs
-    type(pct_pft_type), allocatable :: pctcft(:)    ! % of grid cell that is crop, and breakdown into CFTs
-    type(pct_pft_type), allocatable :: pctcft_saved(:) ! version of pctcft saved from the initial call to mkpft
+    type(pct_pft_type), allocatable :: pctnatpft(:)     ! % of grid cell that is nat veg, and breakdown into PFTs
+    type(pct_pft_type), allocatable :: pctnatpft_max(:) ! % of grid cell maximum PFTs of the time series
+    type(pct_pft_type), allocatable :: pctcft(:)        ! % of grid cell that is crop, and breakdown into CFTs
+    type(pct_pft_type), allocatable :: pctcft_max(:)    ! % of grid cell maximum CFTs of the time series
+    type(pct_pft_type), allocatable :: pctcft_saved(:)  ! version of pctcft saved from the initial call to mkpft
     real(r8), pointer      :: harvest1D(:)       ! harvest 1D data: normalized harvesting
     real(r8), pointer      :: harvest2D(:,:)     ! harvest 1D data: normalized harvesting
     real(r8), allocatable  :: pctgla(:)          ! percent of grid cell that is glacier  
@@ -416,7 +418,9 @@ program mksurfdat
                pctlnd_pft(ns_o)                   , & 
                pftdata_mask(ns_o)                 , & 
                pctnatpft(ns_o)                    , &
+               pctnatpft_max(ns_o)                , &
                pctcft(ns_o)                       , &
+               pctcft_max(ns_o)                   , &
                pctcft_saved(ns_o)                 , &
                pctgla(ns_o)                       , & 
                pctlak(ns_o)                       , & 
@@ -1097,6 +1101,9 @@ program mksurfdat
 
        nfdyn = getavu(); call opnfil (mksrf_fdynuse, nfdyn, 'f')
 
+       pctnatpft_max = pctnatpft
+       pctcft_max = pctcft
+
        ntim = 0
        do 
           ! Read input pft data
@@ -1158,6 +1165,9 @@ program mksurfdat
           call change_landuse(ldomain, dynpft=.true.)
 
           call normalizencheck_landuse(ldomain)
+
+          call update_max_array(pctnatpft_max,pctnatpft)
+          call update_max_array(pctcft_max,pctcft)
 
           ! Output time-varying data for current year
 
@@ -1200,6 +1210,17 @@ program mksurfdat
 
        end do   ! end of read loop
 
+       call check_ret(nf_inq_varid(ncid, 'PCT_NAT_PFT_MAX', varid), subname)
+       call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctnatpft_max)), subname)
+
+       call check_ret(nf_inq_varid(ncid, 'PCT_CROP_MAX', varid), subname)
+       call check_ret(nf_put_var_double(ncid, varid, get_pct_l2g_array(pctcft_max)), subname)
+
+       if (num_cft > 0) then
+          call check_ret(nf_inq_varid(ncid, 'PCT_CFT_MAX', varid), subname)
+          call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctcft_max)), subname)
+       end if
+
        call check_ret(nf_close(ncid), subname)
 
     end if   ! end of if-create dynamic landust dataset