From ff3a5c6b670d3e9f6464bd9df860227fb9cf0027 Mon Sep 17 00:00:00 2001 From: Peter Lawrence Date: Tue, 27 Mar 2018 14:12:18 -0600 Subject: [PATCH 1/4] Added code to put the PCT_NAT_PFT_MAX and PCT_CFT_MAX on the landuse.timeseries file to register the maximum values for PCT_NAT_PFT and PCT_CFT through the time series. This is used to determine how many PFTs and CFTs are instantiated at run time in CLM5 --- tools/mksurfdata_map/src/mkpctPftTypeMod.F90 | 46 +++++++++++++++++++- tools/mksurfdata_map/src/mkpftMod.F90 | 6 +++ tools/mksurfdata_map/src/mksurfdat.F90 | 24 ++++++++-- 3 files changed, 70 insertions(+), 6 deletions(-) diff --git a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 index a47d67dd2a..67c839eea8 100644 --- a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 +++ b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 @@ -46,6 +46,7 @@ module mkpctPftTypeMod end type pct_pft_type ! !PUBLIC MEMBER FUNCTIONS + public :: set_max_p2l_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,49 @@ end subroutine check_vals ! Module-level routines (not member functions) ! ======================================================================== + !----------------------------------------------------------------------- + subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) + ! + ! !DESCRIPTION: + ! Given an array of pct_pft_type variables, set all max_p2l. + ! + ! Assumes that all elements of 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 = 'get_pct_p2l_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 + + 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 set_max_p2l_array + !----------------------------------------------------------------------- function get_pct_p2l_array(pct_pft_arr) result(pct_p2l) ! diff --git a/tools/mksurfdata_map/src/mkpftMod.F90 b/tools/mksurfdata_map/src/mkpftMod.F90 index 5a3686a0ae..4f1067c427 100644 --- a/tools/mksurfdata_map/src/mkpftMod.F90 +++ b/tools/mksurfdata_map/src/mkpftMod.F90 @@ -1019,6 +1019,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 +1034,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 diff --git a/tools/mksurfdata_map/src/mksurfdat.F90 b/tools/mksurfdata_map/src/mksurfdat.F90 index 97d53aac02..a4e94eee30 100644 --- a/tools/mksurfdata_map/src/mksurfdat.F90 +++ b/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, set_max_p2l_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 @@ -414,7 +416,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) , & @@ -802,6 +806,9 @@ program mksurfdat landfrac_pft(n) = pctlnd_pft(n)/100._r8 end do + pctnatpft_max = pctnatpft + pctcft_max = pctcft + ! ---------------------------------------------------------------------- ! Create surface dataset ! ---------------------------------------------------------------------- @@ -1156,6 +1163,9 @@ program mksurfdat call change_landuse(ldomain, dynpft=.true.) call normalizencheck_landuse(ldomain) + + call set_max_p2l_array(pctnatpft_max,pctnatpft) + call set_max_p2l_array(pctcft_max,pctcft) ! Output time-varying data for current year @@ -1198,6 +1208,12 @@ 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_CFT_MAX', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctcft_max)), subname) + call check_ret(nf_close(ncid), subname) end if ! end of if-create dynamic landust dataset From 4291c19ca1546b547a6229587e99efa7ee8422b7 Mon Sep 17 00:00:00 2001 From: Peter Lawrence Date: Mon, 2 Apr 2018 11:38:28 -0600 Subject: [PATCH 2/4] Following suggestions by Bill Sacks the code has been updated to output PCT_CROP_MAX in addition to PCT_NAT_PFT_MAX and PCT_CFT_MAX. This involved modifying the new subroutine to update both p2l and l2g and renaming it update_max_array. Additional changes were made to match Bill's suggestions of the sub_routine subname parameter and moving the initial assignment of the max array within the if (mksrf_fdynuse /= ' ') then code The code has been tested and produces the maximum PCT_CROP_MAX variable as expected. PJL --- tools/mksurfdata_map/src/mkpctPftTypeMod.F90 | 21 ++++++++++++-------- tools/mksurfdata_map/src/mkpftMod.F90 | 2 ++ tools/mksurfdata_map/src/mksurfdat.F90 | 21 ++++++++++++-------- 3 files changed, 28 insertions(+), 16 deletions(-) diff --git a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 index 67c839eea8..8c2c9b7c53 100644 --- a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 +++ b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 @@ -46,7 +46,7 @@ module mkpctPftTypeMod end type pct_pft_type ! !PUBLIC MEMBER FUNCTIONS - public :: set_max_p2l_array ! given an array of pct_pft_type variables update the max_p2l values from pct_p2l + 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 @@ -511,13 +511,13 @@ end subroutine check_vals ! ======================================================================== !----------------------------------------------------------------------- - subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) + subroutine update_max_array(pct_pft_max_arr,pct_pft_arr) ! ! !DESCRIPTION: - ! Given an array of pct_pft_type variables, set all max_p2l. + ! Given an array of pct_pft_type variables, update all the max_p2l variables. ! - ! Assumes that all elements of pct_pft_arr have the same size and lower bound for - ! their pct_p2l array. + ! 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': @@ -530,9 +530,10 @@ subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) integer :: arr_index integer :: pft_index - character(len=*), parameter :: subname = 'get_pct_p2l_array' + 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) @@ -544,6 +545,10 @@ subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) 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) @@ -551,7 +556,7 @@ subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) end do end do - end subroutine set_max_p2l_array + end subroutine update_max_array !----------------------------------------------------------------------- function get_pct_p2l_array(pct_pft_arr) result(pct_p2l) diff --git a/tools/mksurfdata_map/src/mkpftMod.F90 b/tools/mksurfdata_map/src/mkpftMod.F90 index 4f1067c427..c99d66c9ac 100644 --- a/tools/mksurfdata_map/src/mkpftMod.F90 +++ b/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 diff --git a/tools/mksurfdata_map/src/mksurfdat.F90 b/tools/mksurfdata_map/src/mksurfdat.F90 index a4e94eee30..981bfef03d 100644 --- a/tools/mksurfdata_map/src/mksurfdat.F90 +++ b/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, set_max_p2l_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, & @@ -806,9 +806,6 @@ program mksurfdat landfrac_pft(n) = pctlnd_pft(n)/100._r8 end do - pctnatpft_max = pctnatpft - pctcft_max = pctcft - ! ---------------------------------------------------------------------- ! Create surface dataset ! ---------------------------------------------------------------------- @@ -1102,6 +1099,9 @@ program mksurfdat nfdyn = getavu(); call opnfil (mksrf_fdynuse, nfdyn, 'f') + pctnatpft_max = pctnatpft + pctcft_max = pctcft + ntim = 0 do ! Read input pft data @@ -1164,8 +1164,8 @@ program mksurfdat call normalizencheck_landuse(ldomain) - call set_max_p2l_array(pctnatpft_max,pctnatpft) - call set_max_p2l_array(pctcft_max,pctcft) + call update_max_array(pctnatpft_max,pctnatpft) + call update_max_array(pctcft_max,pctcft) ! Output time-varying data for current year @@ -1211,8 +1211,13 @@ program mksurfdat 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_CFT_MAX', varid), subname) - call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctcft_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) From 8e96f42e73817d0adf8276f3f565e77023abf21d Mon Sep 17 00:00:00 2001 From: Peter Lawrence Date: Tue, 27 Mar 2018 14:12:18 -0600 Subject: [PATCH 3/4] Added code to put the PCT_NAT_PFT_MAX and PCT_CFT_MAX on the landuse.timeseries file to register the maximum values for PCT_NAT_PFT and PCT_CFT through the time series. This is used to determine how many PFTs and CFTs are instantiated at run time in CLM5 --- tools/mksurfdata_map/src/mkpctPftTypeMod.F90 | 46 +++++++++++++++++++- tools/mksurfdata_map/src/mkpftMod.F90 | 6 +++ tools/mksurfdata_map/src/mksurfdat.F90 | 24 ++++++++-- 3 files changed, 70 insertions(+), 6 deletions(-) diff --git a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 index a47d67dd2a..67c839eea8 100644 --- a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 +++ b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 @@ -46,6 +46,7 @@ module mkpctPftTypeMod end type pct_pft_type ! !PUBLIC MEMBER FUNCTIONS + public :: set_max_p2l_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,49 @@ end subroutine check_vals ! Module-level routines (not member functions) ! ======================================================================== + !----------------------------------------------------------------------- + subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) + ! + ! !DESCRIPTION: + ! Given an array of pct_pft_type variables, set all max_p2l. + ! + ! Assumes that all elements of 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 = 'get_pct_p2l_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 + + 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 set_max_p2l_array + !----------------------------------------------------------------------- function get_pct_p2l_array(pct_pft_arr) result(pct_p2l) ! diff --git a/tools/mksurfdata_map/src/mkpftMod.F90 b/tools/mksurfdata_map/src/mkpftMod.F90 index 5a3686a0ae..4f1067c427 100644 --- a/tools/mksurfdata_map/src/mkpftMod.F90 +++ b/tools/mksurfdata_map/src/mkpftMod.F90 @@ -1019,6 +1019,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 +1034,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 diff --git a/tools/mksurfdata_map/src/mksurfdat.F90 b/tools/mksurfdata_map/src/mksurfdat.F90 index 28a46165f9..01925a0d74 100644 --- a/tools/mksurfdata_map/src/mksurfdat.F90 +++ b/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, set_max_p2l_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) , & @@ -804,6 +808,9 @@ program mksurfdat landfrac_pft(n) = pctlnd_pft(n)/100._r8 end do + pctnatpft_max = pctnatpft + pctcft_max = pctcft + ! ---------------------------------------------------------------------- ! Create surface dataset ! ---------------------------------------------------------------------- @@ -1158,6 +1165,9 @@ program mksurfdat call change_landuse(ldomain, dynpft=.true.) call normalizencheck_landuse(ldomain) + + call set_max_p2l_array(pctnatpft_max,pctnatpft) + call set_max_p2l_array(pctcft_max,pctcft) ! Output time-varying data for current year @@ -1200,6 +1210,12 @@ 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_CFT_MAX', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctcft_max)), subname) + call check_ret(nf_close(ncid), subname) end if ! end of if-create dynamic landust dataset From 668370a5b5dfc5774d16fe71522194a9f840d93c Mon Sep 17 00:00:00 2001 From: Peter Lawrence Date: Mon, 2 Apr 2018 11:38:28 -0600 Subject: [PATCH 4/4] Following suggestions by Bill Sacks the code has been updated to output PCT_CROP_MAX in addition to PCT_NAT_PFT_MAX and PCT_CFT_MAX. This involved modifying the new subroutine to update both p2l and l2g and renaming it update_max_array. Additional changes were made to match Bill's suggestions of the sub_routine subname parameter and moving the initial assignment of the max array within the if (mksrf_fdynuse /= ' ') then code The code has been tested and produces the maximum PCT_CROP_MAX variable as expected. PJL --- tools/mksurfdata_map/src/mkpctPftTypeMod.F90 | 21 ++++++++++++-------- tools/mksurfdata_map/src/mkpftMod.F90 | 2 ++ tools/mksurfdata_map/src/mksurfdat.F90 | 21 ++++++++++++-------- 3 files changed, 28 insertions(+), 16 deletions(-) diff --git a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 index 67c839eea8..8c2c9b7c53 100644 --- a/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 +++ b/tools/mksurfdata_map/src/mkpctPftTypeMod.F90 @@ -46,7 +46,7 @@ module mkpctPftTypeMod end type pct_pft_type ! !PUBLIC MEMBER FUNCTIONS - public :: set_max_p2l_array ! given an array of pct_pft_type variables update the max_p2l values from pct_p2l + 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 @@ -511,13 +511,13 @@ end subroutine check_vals ! ======================================================================== !----------------------------------------------------------------------- - subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) + subroutine update_max_array(pct_pft_max_arr,pct_pft_arr) ! ! !DESCRIPTION: - ! Given an array of pct_pft_type variables, set all max_p2l. + ! Given an array of pct_pft_type variables, update all the max_p2l variables. ! - ! Assumes that all elements of pct_pft_arr have the same size and lower bound for - ! their pct_p2l array. + ! 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': @@ -530,9 +530,10 @@ subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) integer :: arr_index integer :: pft_index - character(len=*), parameter :: subname = 'get_pct_p2l_array' + 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) @@ -544,6 +545,10 @@ subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) 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) @@ -551,7 +556,7 @@ subroutine set_max_p2l_array(pct_pft_max_arr,pct_pft_arr) end do end do - end subroutine set_max_p2l_array + end subroutine update_max_array !----------------------------------------------------------------------- function get_pct_p2l_array(pct_pft_arr) result(pct_p2l) diff --git a/tools/mksurfdata_map/src/mkpftMod.F90 b/tools/mksurfdata_map/src/mkpftMod.F90 index 4f1067c427..c99d66c9ac 100644 --- a/tools/mksurfdata_map/src/mkpftMod.F90 +++ b/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 diff --git a/tools/mksurfdata_map/src/mksurfdat.F90 b/tools/mksurfdata_map/src/mksurfdat.F90 index 01925a0d74..fbbf57171a 100644 --- a/tools/mksurfdata_map/src/mksurfdat.F90 +++ b/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, set_max_p2l_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, & @@ -808,9 +808,6 @@ program mksurfdat landfrac_pft(n) = pctlnd_pft(n)/100._r8 end do - pctnatpft_max = pctnatpft - pctcft_max = pctcft - ! ---------------------------------------------------------------------- ! Create surface dataset ! ---------------------------------------------------------------------- @@ -1104,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 @@ -1166,8 +1166,8 @@ program mksurfdat call normalizencheck_landuse(ldomain) - call set_max_p2l_array(pctnatpft_max,pctnatpft) - call set_max_p2l_array(pctcft_max,pctcft) + call update_max_array(pctnatpft_max,pctnatpft) + call update_max_array(pctcft_max,pctcft) ! Output time-varying data for current year @@ -1213,8 +1213,13 @@ program mksurfdat 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_CFT_MAX', varid), subname) - call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctcft_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)