diff --git a/core/biogeochem/CASAONLY_LUC.F90 b/core/biogeochem/CASAONLY_LUC.F90 index b3bac104c..9b8e8978a 100644 --- a/core/biogeochem/CASAONLY_LUC.F90 +++ b/core/biogeochem/CASAONLY_LUC.F90 @@ -190,11 +190,16 @@ SUBROUTINE CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & IF (idoy==1) THEN ! (assumes 70% of wood NPP is allocated above ground) casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(mdyear,dp) / 1000._dp casabal%Crootmean = casapool%cplant(:,3) / real(mdyear,dp) / 1000._dp ELSE casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + & + casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(mdyear,dp) / 1000._dp casabal%Crootmean = casabal%Crootmean + casapool%cplant(:,3) / real(mdyear,dp) / 1000._dp diff --git a/core/biogeochem/POP.F90 b/core/biogeochem/POP.F90 index 65abf018e..13c568975 100755 --- a/core/biogeochem/POP.F90 +++ b/core/biogeochem/POP.F90 @@ -30,41 +30,41 @@ ! http://creativecommons.org/licenses/by-sa/3.0/ !******************************************************************************* -MODULE TypeDef +module TypeDef !------------------------------------------------------------------------------- ! This module explicitly defines the sizes of variable types !------------------------------------------------------------------------------- - IMPLICIT NONE + implicit none - SAVE + save ! Define integer kind parameters to accommodate the range of numbers usually ! associated with 4, 2, and 1 byte integers. - INTEGER,PARAMETER :: i4b = SELECTED_INT_KIND(9) - INTEGER,PARAMETER :: i2b = SELECTED_INT_KIND(4) - INTEGER,PARAMETER :: i1b = SELECTED_INT_KIND(2) + integer,parameter :: i4b = selected_int_kind(9) + integer,parameter :: i2b = selected_int_kind(4) + integer,parameter :: i1b = selected_int_kind(2) ! Define single and double precision real kind parameters: ! * Kind(1.0) defines sp as the machine's default size for single precision ! * Kind(1.0d0) defines dp as the machine's default size for double precision - INTEGER,PARAMETER :: sp = KIND(1.0) - INTEGER,PARAMETER :: dp = KIND(1.0d0) + integer,parameter :: sp = kind(1.0) + integer,parameter :: dp = kind(1.0d0) ! lgt is set to the default kind required for representing logical values. - INTEGER,PARAMETER :: lgt = KIND(.TRUE.) + integer,parameter :: lgt = kind(.true.) -END MODULE TypeDef +end module TypeDef !******************************************************************************* -MODULE POP_Constants +module POP_Constants - USE TYPEdef, ONLY: dp, i4b + use TYPEdef, only: dp, i4b - IMPLICIT NONE + implicit none ! REAL(dp),PARAMETER:: FULTON_ALPHA= 5.6 ! recruitment scalar alpha in Fulton (1991) ! REAL(dp),PARAMETER:: DENSINDIV_MAX=2 ! 0.5 ! Maximum density of individuals within a cohort indiv/m2 @@ -82,264 +82,265 @@ MODULE POP_Constants ! REAL(dp),PARAMETER:: CrowdingFactor = 0.0128 ! REAL(dp),PARAMETER:: ALPHA_CPC = 3.0 - REAL(dp), PARAMETER :: FULTON_ALPHA = 3.5_dp ! recruitment scalar alpha in Fulton (1991) - REAL(dp), PARAMETER :: DENSINDIV_MAX = 0.2_dp ! 0.5 ! Maximum density of individuals within a cohort indiv/m2 - REAL(dp), PARAMETER :: DENSINDIV_MIN = 1.0e-9_dp ! - REAL(dp), PARAMETER :: Kbiometric = 50.0_dp ! Constant in height-diameter relationship - REAL(dp), PARAMETER :: WD = 300.0_dp ! Wood density kgC/m3 + real(dp), parameter :: FULTON_ALPHA = 3.5_dp ! recruitment scalar alpha in Fulton (1991) + real(dp), parameter :: DENSINDIV_MAX = 0.2_dp ! 0.5 ! Maximum density of individuals within a cohort indiv/m2 + real(dp), parameter :: DENSINDIV_MIN = 1.0e-9_dp ! + real(dp), parameter :: Kbiometric = 50.0_dp ! Constant in height-diameter relationship + real(dp), parameter :: WD = 300.0_dp ! Wood density kgC/m3 ! threshold growth efficiency for enhanced mortality (higher value gives higher biomass turnover) - REAL(dp), PARAMETER :: GROWTH_EFFICIENCY_MIN = 0.009_dp ! 0.0095 ! 0.0089 ! 0.0084 - REAL(dp), PARAMETER :: Pmort = 5.0_dp ! exponent in mortality formula - REAL(dp), PARAMETER :: MORT_MAX = 0.3_dp ! upper asymptote for enhanced mortality - REAL(dp), PARAMETER :: THETA_recruit = 0.95_dp ! shape parameter in recruitment equation - REAL(dp), PARAMETER :: CMASS_STEM_INIT = 1.0e-4_dp ! initial biomass kgC/m2 - REAL(dp), PARAMETER :: POWERbiomass = 0.67_dp ! exponent for biomass in proportion to which cohorts preempt resources - REAL(dp), PARAMETER :: POWERGrowthEfficiency = 0.67_dp - REAL(dp), PARAMETER :: CrowdingFactor = 0.043_dp ! 0.043 ! 0.039 !0.029 ! 0.033 - REAL(dp), PARAMETER :: ALPHA_CPC = 3.5_dp - REAL(dp), PARAMETER :: k_allom1 = 200.0_dp ! crown area = k_allom1 * diam ** k_rp - REAL(dp), PARAMETER :: k_rp = 1.67_dp ! constant in crown area relation to tree diameter - REAL(dp), PARAMETER :: ksapwood = 0.05_dp ! rate constant for conversion of sapwood to heartwood (y-1) - REAL(dp), PARAMETER :: Q=7.0_dp ! governs rate of increase of mortality with age (2=exponential) - REAL, PARAMETER :: rshootfrac = 0.63 - REAL(dp), PARAMETER :: shootfrac = real(rshootfrac,dp) - REAL(dp), PARAMETER :: CtoNw = 400.0_dp - REAL(dp), PARAMETER :: CtoNl = 60.0_dp - REAL(dp), PARAMETER :: CtoNr = 70.0_dp - REAL(dp), PARAMETER :: N_EXTENT = 2.0_dp ! multiple of crown diameters within which tree competes with other cohorts - REAL(dp), PARAMETER :: EPS = 1.0e-12_dp - INTEGER(i4b), PARAMETER :: NLAYER = 1 ! number of vertical veg layers (1 is currently the only option) - INTEGER(i4b), PARAMETER :: NCOHORT_MAX = 20 ! maximum number of cohorts - INTEGER(i4b), PARAMETER :: NDISTURB = 1 ! number of disturbance regimes (1 (total only) or 2 (partial and total)) - INTEGER(i4b), PARAMETER :: PATCH_REPS = 10 ! higher number reduces 'noise' - INTEGER(i4b), PARAMETER :: NAGE_MAX = 1 ! number of maxium ages - INTEGER(i4b), PARAMETER :: PATCH_REPS1 = 60 ! number of first dist years - INTEGER(i4b), PARAMETER :: PATCH_REPS2 = 1 ! number of second dist years - INTEGER(i4b), PARAMETER :: NPATCH = PATCH_REPS1*PATCH_REPS2 - INTEGER(i4b), PARAMETER :: NPATCH1D = NPATCH - INTEGER(i4b), PARAMETER :: NPATCH2D = NPATCH - INTEGER(i4b), PARAMETER :: HEIGHT_BINS = 12 ! number of height categories to keep track of for diagnostics - REAL(dp), PARAMETER :: BIN_POWER = 1.4_dp ! bins have muscles + real(dp), parameter :: GROWTH_EFFICIENCY_MIN = 0.009_dp ! 0.0095 ! 0.0089 ! 0.0084 + real(dp), parameter :: Pmort = 5.0_dp ! exponent in mortality formula + real(dp), parameter :: MORT_MAX = 0.3_dp ! upper asymptote for enhanced mortality + real(dp), parameter :: THETA_recruit = 0.95_dp ! shape parameter in recruitment equation + real(dp), parameter :: CMASS_STEM_INIT = 1.0e-4_dp ! initial biomass kgC/m2 + real(dp), parameter :: POWERbiomass = 0.67_dp ! exponent for biomass in proportion to which cohorts preempt resources + real(dp), parameter :: POWERGrowthEfficiency = 0.67_dp + real(dp), parameter :: CrowdingFactor = 0.043_dp ! 0.043 ! 0.039 !0.029 ! 0.033 + real(dp), parameter :: ALPHA_CPC = 3.5_dp + real(dp), parameter :: k_allom1 = 200.0_dp ! crown area = k_allom1 * diam ** k_rp + real(dp), parameter :: k_rp = 1.67_dp ! constant in crown area relation to tree diameter + real(dp), parameter :: ksapwood = 0.05_dp ! rate constant for conversion of sapwood to heartwood (y-1) + real(dp), parameter :: Q=7.0_dp ! governs rate of increase of mortality with age (2=exponential) + real, parameter :: rshootfrac = 0.63 + real(dp), parameter :: shootfrac = real(rshootfrac,dp) + real(dp), parameter :: CtoNw = 400.0_dp + real(dp), parameter :: CtoNl = 60.0_dp + real(dp), parameter :: CtoNr = 70.0_dp + real(dp), parameter :: N_EXTENT = 2.0_dp ! multiple of crown diameters within which tree competes with other cohorts + real(dp), parameter :: EPS = 1.0e-12_dp + integer(i4b), parameter :: NLAYER = 1 ! number of vertical veg layers (1 is currently the only option) + integer(i4b), parameter :: NCOHORT_MAX = 20 ! maximum number of cohorts + integer(i4b), parameter :: NDISTURB = 1 ! number of disturbance regimes (1 (total only) or 2 (partial and total)) + integer(i4b), parameter :: PATCH_REPS = 10 ! higher number reduces 'noise' + integer(i4b), parameter :: NAGE_MAX = 1 ! number of maxium ages + integer(i4b), parameter :: PATCH_REPS1 = 60 ! number of first dist years + integer(i4b), parameter :: PATCH_REPS2 = 1 ! number of second dist years + integer(i4b), parameter :: NPATCH = PATCH_REPS1*PATCH_REPS2 + integer(i4b), parameter :: NPATCH1D = NPATCH + integer(i4b), parameter :: NPATCH2D = NPATCH + integer(i4b), parameter :: HEIGHT_BINS = 12 ! number of height categories to keep track of for diagnostics + real(dp), parameter :: BIN_POWER = 1.4_dp ! bins have muscles ! Time base factor (to be multiplied by mean dist interval to give TIMEBASE) ! for sampling disturbance probabilities from Poisson distribution - INTEGER(i4b), PARAMETER :: TIMEBASE_FACTOR=50 - REAL(dp), PARAMETER :: PI=3.14159265358979323846264_dp + integer(i4b), parameter :: TIMEBASE_FACTOR=50 + real(dp), parameter :: PI=3.14159265358979323846264_dp ! 0 == default; 1 = top-end allometry (requires precip as input to POPSTEP); 2 = Allometry following Williams 2005, Model 5b - INTEGER(i4b), PARAMETER :: ALLOM_SWITCH = 2 + integer(i4b), parameter :: ALLOM_SWITCH = 2 ! 0 == binnned max height variable; 1 = continuous (needs lots of memory); 2 = binned by integer heights - INTEGER(i4b), PARAMETER :: MAX_HEIGHT_SWITCH = 2 - INTEGER(i4b), PARAMETER :: RESOURCE_SWITCH = 1 ! 0 = default; 1 fraction net resource uptake - INTEGER(i4b), PARAMETER :: RECRUIT_SWITCH = 1 ! 0 = default, 1 = Pgap-dependence - INTEGER(i4b), PARAMETER :: INTERP_SWITCH = 1 ! 0 = sum over weighted patches, 1 = sum over interpolated patches - INTEGER(i4b), PARAMETER :: SMOOTH_SWITCH = 0 ! smooth disturbance flux - INTEGER(i4b), PARAMETER :: NYEAR_WINDOW = 5 ! one-side of smoothing window (y) - INTEGER(i4b), PARAMETER :: NYEAR_SMOOTH = 2*NYEAR_WINDOW + 1 ! smoothing window (y) - INTEGER(i4b), PARAMETER :: NYEAR_HISTORY = NYEAR_SMOOTH-NYEAR_WINDOW - INTEGER(i4b), PARAMETER :: AGEMAX = 1000 + integer(i4b), parameter :: MAX_HEIGHT_SWITCH = 2 + integer(i4b), parameter :: RESOURCE_SWITCH = 1 ! 0 = default; 1 fraction net resource uptake + integer(i4b), parameter :: RECRUIT_SWITCH = 1 ! 0 = default, 1 = Pgap-dependence + integer(i4b), parameter :: INTERP_SWITCH = 1 ! 0 = sum over weighted patches, 1 = sum over interpolated patches + integer(i4b), parameter :: SMOOTH_SWITCH = 0 ! smooth disturbance flux + integer(i4b), parameter :: NYEAR_WINDOW = 5 ! one-side of smoothing window (y) + integer(i4b), parameter :: NYEAR_SMOOTH = 2*NYEAR_WINDOW + 1 ! smoothing window (y) + integer(i4b), parameter :: NYEAR_HISTORY = NYEAR_SMOOTH-NYEAR_WINDOW + integer(i4b), parameter :: AGEMAX = 1000 -END MODULE POP_Constants +end module POP_Constants !******************************************************************************* -MODULE POP_Types +module POP_Types - USE TYPEdef, ONLY: dp, i4b - USE POP_Constants, ONLY: NCOHORT_MAX, NLAYER, HEIGHT_BINS, NDISTURB, NPATCH, NPATCH2D, & + use TYPEdef, only: dp, i4b + use POP_Constants, only: NCOHORT_MAX, NLAYER, HEIGHT_BINS, NDISTURB, NPATCH, NPATCH2D, & NYEAR_HISTORY, AGEMAX - IMPLICIT NONE - - TYPE Cohort - INTEGER(i4b) :: id - INTEGER(i4b) :: age ! cohort age - REAL(dp) :: biomass ! cohort biomass - REAL(dp) :: density ! landscape tree density (weighted mean over patches) - REAL(dp) :: frac_resource_uptake - REAL(dp) :: frac_light_uptake - REAL(dp) :: frac_interception - REAL(dp) :: frac_respiration - REAL(dp) :: frac_NPP - REAL(dp) :: respiration_scalar - REAL(dp) :: crown_area - REAL(dp) :: Pgap - REAL(dp) :: height - REAL(dp) :: diameter - REAL(dp) :: sapwood - REAL(dp) :: heartwood - REAL(dp) :: sapwood_area - REAL(dp) :: basal_area - REAL(dp) :: LAI - REAL(dp) :: Cleaf - REAL(dp) :: Croot - END TYPE Cohort - - TYPE Layer - TYPE(Cohort), DIMENSION(NCOHORT_MAX) :: Cohort - INTEGER(i4b) :: ncohort ! number of cohorts with density >0 - REAL(dp) :: biomass ! layer biomass - REAL(dp) :: density ! layer tree density - REAL(dp) :: hmean ! layer mean tree height (weighted mean over patches) - REAL(dp) :: hmax ! layer max tree height - END TYPE Layer - - TYPE Patch - TYPE(Layer), DIMENSION(NLAYER) :: Layer - REAL(dp) :: factor_recruit - REAL(dp) :: pgap - REAL(dp) :: lai - REAL(dp) :: biomass ! total biomass in patch - REAL(dp) :: biomass_old ! total biomass in patch - REAL(dp) :: sapwood ! total sapwood biomass in patch - REAL(dp) :: heartwood ! total heartwood biomass in patch - REAL(dp) :: sapwood_old ! total sapwood biomass in patch - REAL(dp) :: sapwood_area ! total sapwood area in patch - REAL(dp) :: sapwood_area_old ! total sapwood area in patch - REAL(dp) :: stress_mortality ! biomass lost in each patch due to stress - REAL(dp) :: fire_mortality ! biomass lost in each patch due partial fire disturbance - REAL(dp) :: cat_mortality ! biomass lost in each patch due partial fire disturbance - REAL(dp) :: crowding_mortality ! biomass lost to crowding mortality - REAL(dp) :: cpc - REAL(dp) :: mortality ! - REAL(dp) :: sapwood_loss - REAL(dp) :: sapwood_area_loss - REAL(dp) :: growth ! biomass growth in each patch due to stem increment - REAL(dp) :: area_growth ! basal area growth in each patch due to stem increment - INTEGER(i4b) :: disturbance_interval(NDISTURB) ! prescribed disturbance(s) interval for this patch - INTEGER(i4b) :: first_disturbance_year(NDISTURB) - INTEGER(i4b) :: age(NDISTURB) ! number of years since last disturbance(s) - INTEGER(i4b) :: id - REAL(dp) :: frac_NPP - REAL(dp) :: frac_respiration - REAL(dp) :: frac_light_uptake - REAL(dp) :: fire_top_kill_density - END TYPE Patch - - TYPE Landscape - TYPE(Patch), DIMENSION(NPATCH2D) :: patch - REAL(dp), DIMENSION(NPATCH2D) :: freq ! patch weighting - REAL(dp), DIMENSION(NPATCH2D) :: freq_old ! patch weighting (previous time-step) - REAL(dp), DIMENSION(NPATCH2D) :: fire_freq ! - REAL(dp), DIMENSION(NPATCH2D) :: fire_freq_old ! - REAL(dp), DIMENSION(NPATCH2D) :: cat_freq ! - REAL(dp), DIMENSION(NPATCH2D) :: cat_freq_old ! - REAL(dp), DIMENSION(NPATCH2D,NDISTURB) :: freq_ranked_age_unique ! unique age weighting - INTEGER(i4b), DIMENSION(NPATCH2D, NDISTURB) :: ranked_age_unique ! unique age - INTEGER(i4b), DIMENSION(NDISTURB) :: n_age ! number of unique ages - REAL(dp), DIMENSION(NLAYER) :: biomass ! landscape stem biomass (weighted mean over patches) - REAL(dp), DIMENSION(NLAYER) :: density ! landscape tree density (weighted mean over patches) - REAL(dp), DIMENSION(NLAYER) :: hmean ! landscape mean treen height (weighted mean over patches) - REAL(dp), DIMENSION(NLAYER) :: hmax ! landscape max tree height - REAL(dp), DIMENSION(HEIGHT_BINS) :: cmass_stem_bin ! biomass by height bin - REAL(dp), DIMENSION(HEIGHT_BINS) :: densindiv_bin ! density by height bin - REAL(dp), DIMENSION(HEIGHT_BINS) :: height_bin ! mean height in each bin - REAL(dp), DIMENSION(HEIGHT_BINS) :: diameter_bin ! mean diameter in each bin - CHARACTER(100), DIMENSION(HEIGHT_BINS) :: bin_labels ! text strings for bin bounds - REAL(dp) :: cmass_sum ! landscape biomass - REAL(dp) :: cmass_sum_old ! landscape biomass - REAL(dp) :: cheartwood_sum ! landscape biomass (heart wood) - REAL(dp) :: csapwood_sum ! landscape biomass (sap wood) - REAL(dp) :: csapwood_sum_old ! landscape biomass - REAL(dp) :: densindiv ! landscape density of individuals - REAL(dp) :: height_mean - REAL(dp) :: height_max - REAL(dp) :: basal_area - REAL(dp) :: sapwood_loss ! (kg C m-2 y-1) ! total sapwood loss (turnover + mortality) - REAL(dp) :: sapwood_area_loss ! ( m2/m-2 y-1) sapwood area loss (mortality only) - REAL(dp) :: stress_mortality ! (kg C m-2 y-1) - REAL(dp) :: crowding_mortality ! (kg C m-2 y-1) - REAL(dp) :: fire_mortality ! (kg C m-2 y-1) - REAL(dp) :: cat_mortality ! (kg C m-2 y-1) - REAL(dp) :: res_mortality ! (kg C m-2 y-1) - REAL(dp) :: growth - REAL(dp) :: area_growth ! m2/ha - REAL(dp) :: crown_cover - REAL(dp) :: crown_area - REAL(dp) :: crown_volume - REAL(dp) :: sapwood_area - REAL(dp) :: sapwood_area_old - REAL(dp) :: Kclump ! clumping factor - INTEGER(i4b) :: npatch_active - INTEGER(i4b) :: LU - REAL(dp) :: smoothing_buffer - REAL(dp) :: smoothing_buffer_cat - REAL(dp) :: fire_mortality_smoothed - REAL(dp) :: cat_mortality_smoothed - REAL(dp), DIMENSION(NYEAR_HISTORY) :: fire_mortality_history - REAL(dp), DIMENSION(NYEAR_HISTORY) :: cat_mortality_history - REAL(dp), DIMENSION(AGEMAX) :: freq_age ! age weighting (by age in y: 0:AGE_MAX-1) - REAL(dp), DIMENSION(AGEMAX) :: biomass_age - END TYPE Landscape - - TYPE POP_TYPE - TYPE(Landscape), DIMENSION(:), ALLOCATABLE :: pop_grid - INTEGER, DIMENSION(:), Allocatable :: it_pop - INTEGER :: np - INTEGER, DIMENSION(:), Allocatable :: Iwood ! , LU - END TYPE POP_TYPE - -END MODULE POP_Types + implicit none + + type Cohort + integer(i4b) :: id + integer(i4b) :: age ! cohort age + real(dp) :: biomass ! cohort biomass + real(dp) :: density ! landscape tree density (weighted mean over patches) + real(dp) :: frac_resource_uptake + real(dp) :: frac_light_uptake + real(dp) :: frac_interception + real(dp) :: frac_respiration + real(dp) :: frac_NPP + real(dp) :: respiration_scalar + real(dp) :: crown_area + real(dp) :: Pgap + real(dp) :: height + real(dp) :: diameter + real(dp) :: sapwood + real(dp) :: heartwood + real(dp) :: sapwood_area + real(dp) :: basal_area + real(dp) :: LAI + real(dp) :: Cleaf + real(dp) :: Croot + end type Cohort + + type Layer + type(Cohort), dimension(NCOHORT_MAX) :: Cohort + integer(i4b) :: ncohort ! number of cohorts with density >0 + real(dp) :: biomass ! layer biomass + real(dp) :: density ! layer tree density + real(dp) :: hmean ! layer mean tree height (weighted mean over patches) + real(dp) :: hmax ! layer max tree height + end type Layer + + type Patch + type(Layer), dimension(NLAYER) :: Layer + real(dp) :: factor_recruit + real(dp) :: pgap + real(dp) :: lai + real(dp) :: biomass ! total biomass in patch + real(dp) :: biomass_old ! total biomass in patch + real(dp) :: sapwood ! total sapwood biomass in patch + real(dp) :: heartwood ! total heartwood biomass in patch + real(dp) :: sapwood_old ! total sapwood biomass in patch + real(dp) :: sapwood_area ! total sapwood area in patch + real(dp) :: sapwood_area_old ! total sapwood area in patch + real(dp) :: stress_mortality ! biomass lost in each patch due to stress + real(dp) :: fire_mortality ! biomass lost in each patch due partial fire disturbance + real(dp) :: cat_mortality ! biomass lost in each patch due partial fire disturbance + real(dp) :: crowding_mortality ! biomass lost to crowding mortality + real(dp) :: cpc + real(dp) :: mortality ! + real(dp) :: sapwood_loss + real(dp) :: sapwood_area_loss + real(dp) :: growth ! biomass growth in each patch due to stem increment + real(dp) :: area_growth ! basal area growth in each patch due to stem increment + integer(i4b) :: disturbance_interval(NDISTURB) ! prescribed disturbance(s) interval for this patch + integer(i4b) :: first_disturbance_year(NDISTURB) + integer(i4b) :: age(NDISTURB) ! number of years since last disturbance(s) + integer(i4b) :: id + real(dp) :: frac_NPP + real(dp) :: frac_respiration + real(dp) :: frac_light_uptake + real(dp) :: fire_top_kill_density + end type Patch + + type Landscape + type(Patch), dimension(NPATCH2D) :: patch + real(dp), dimension(NPATCH2D) :: freq ! patch weighting + real(dp), dimension(NPATCH2D) :: freq_old ! patch weighting (previous time-step) + real(dp), dimension(NPATCH2D) :: fire_freq ! + real(dp), dimension(NPATCH2D) :: fire_freq_old ! + real(dp), dimension(NPATCH2D) :: cat_freq ! + real(dp), dimension(NPATCH2D) :: cat_freq_old ! + real(dp), dimension(NPATCH2D,NDISTURB) :: freq_ranked_age_unique ! unique age weighting + integer(i4b), dimension(NPATCH2D, NDISTURB) :: ranked_age_unique ! unique age + integer(i4b), dimension(NDISTURB) :: n_age ! number of unique ages + real(dp), dimension(NLAYER) :: biomass ! landscape stem biomass (weighted mean over patches) + real(dp), dimension(NLAYER) :: density ! landscape tree density (weighted mean over patches) + real(dp), dimension(NLAYER) :: hmean ! landscape mean treen height (weighted mean over patches) + real(dp), dimension(NLAYER) :: hmax ! landscape max tree height + real(dp), dimension(HEIGHT_BINS) :: cmass_stem_bin ! biomass by height bin + real(dp), dimension(HEIGHT_BINS) :: densindiv_bin ! density by height bin + real(dp), dimension(HEIGHT_BINS) :: height_bin ! mean height in each bin + real(dp), dimension(HEIGHT_BINS) :: diameter_bin ! mean diameter in each bin + character(100), dimension(HEIGHT_BINS) :: bin_labels ! text strings for bin bounds + real(dp) :: cmass_sum ! landscape biomass + real(dp) :: cmass_sum_old ! landscape biomass + real(dp) :: cheartwood_sum ! landscape biomass (heart wood) + real(dp) :: csapwood_sum ! landscape biomass (sap wood) + real(dp) :: csapwood_sum_old ! landscape biomass + real(dp) :: densindiv ! landscape density of individuals + real(dp) :: height_mean + real(dp) :: height_max + real(dp) :: basal_area + real(dp) :: sapwood_loss ! (kg C m-2 y-1) ! total sapwood loss (turnover + mortality) + real(dp) :: sapwood_area_loss ! ( m2/m-2 y-1) sapwood area loss (mortality only) + real(dp) :: stress_mortality ! (kg C m-2 y-1) + real(dp) :: crowding_mortality ! (kg C m-2 y-1) + real(dp) :: fire_mortality ! (kg C m-2 y-1) + real(dp) :: cat_mortality ! (kg C m-2 y-1) + real(dp) :: res_mortality ! (kg C m-2 y-1) + real(dp) :: growth + real(dp) :: area_growth ! m2/ha + real(dp) :: crown_cover + real(dp) :: crown_area + real(dp) :: crown_volume + real(dp) :: sapwood_area + real(dp) :: sapwood_area_old + real(dp) :: Kclump ! clumping factor + integer(i4b) :: npatch_active + integer(i4b) :: LU + real(dp) :: smoothing_buffer + real(dp) :: smoothing_buffer_cat + real(dp) :: fire_mortality_smoothed + real(dp) :: cat_mortality_smoothed + real(dp), dimension(NYEAR_HISTORY) :: fire_mortality_history + real(dp), dimension(NYEAR_HISTORY) :: cat_mortality_history + real(dp), dimension(AGEMAX) :: freq_age ! age weighting (by age in y: 0:AGE_MAX-1) + real(dp), dimension(AGEMAX) :: biomass_age + real(dp) :: rkill + end type Landscape + + type POP_TYPE + type(Landscape), dimension(:), allocatable :: pop_grid + integer, dimension(:), allocatable :: it_pop + integer :: np + integer, dimension(:), allocatable :: Iwood ! , LU + end type POP_TYPE + +end module POP_Types !******************************************************************************* -MODULE POPModule +module POPModule !------------------------------------------------------------------------------- ! * This module contains all subroutines for POP calcs at a single time step. !------------------------------------------------------------------------------- - USE TYPEdef, ONLY: sp, i4b - USE POP_Types - USE POP_Constants + use TYPEdef, only: sp, i4b + use POP_Types + use POP_Constants - IMPLICIT NONE + implicit none -CONTAINS +contains !******************************************************************************* - SUBROUTINE ZeroPOP(POP,n) + subroutine ZeroPOP(POP,n) #ifdef __MPI__ use mpi, only: MPI_Abort #endif - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER, OPTIONAL, INTENT(IN) :: n + type(POP_TYPE), intent(INOUT) :: POP + integer, optional, intent(IN) :: n - INTEGER:: g, k, l, c, np, a, b + integer:: g, k, l, c, np, a, b #ifdef __MPI__ integer :: ierr #endif - IF (.NOT. ALLOCATED(pop%pop_grid)) THEN - WRITE(*,*)" POP not allocated! Abort in ZeroPOP." + if (.not. allocated(pop%pop_grid)) then + write(*,*)" POP not allocated! Abort in ZeroPOP." #ifdef __MPI__ call MPI_Abort(0, 84, ierr) ! Do not know comm nor rank here #else stop 84 #endif - ENDIF + endif - np = SIZE(pop%pop_grid) + np = size(pop%pop_grid) ! optional integer n intended for zeroing secondary forest tiles - IF (PRESENT(n)) THEN + if (present(n)) then a = n b = n !pop%LU(n) = 2 POP%pop_grid(n)%LU = 2 - ELSE + else a = 1 b = np !pop%LU = 1 POP%pop_grid%LU = 1 endif - DO g=a, b + do g=a, b POP%pop_grid(g)%freq = 0.0_dp ! patch weighting POP%pop_grid(g)%freq_old = 0.0_dp ! patch weighting POP%pop_grid(g)%fire_freq = 0.0_dp @@ -390,12 +391,13 @@ SUBROUTINE ZeroPOP(POP,n) POP%pop_grid(g)%fire_mortality_history = 0.0_dp POP%pop_grid(g)%cat_mortality_history = 0.0_dp POP%pop_grid(g)%freq_age = 0.0_dp - IF (PRESENT(n)) THEN + POP%pop_grid(g)%rkill = 0.0_dp + if (present(n)) then POP%pop_grid(g)%freq_age(1) = 1.0_dp - ENDIF + endif POP%pop_grid(g)%biomass_age = 0.0_dp - DO k=1, NPATCH2D + do k=1, NPATCH2D POP%pop_grid(g)%patch(k)%factor_recruit = 0.0_dp POP%pop_grid(g)%patch(k)%pgap = 0.0_dp POP%pop_grid(g)%patch(k)%lai = 0.0_dp @@ -425,14 +427,14 @@ SUBROUTINE ZeroPOP(POP,n) POP%pop_grid(g)%patch(k)%frac_light_uptake = 0.0_dp POP%pop_grid(g)%patch(k)%fire_top_kill_density = 0.0_dp - DO l=1, NLAYER + do l=1, NLAYER POP%pop_grid(g)%patch(k)%Layer(L)%ncohort = 0 ! number of cohorts with density >0.0_dp POP%pop_grid(g)%patch(k)%Layer(L)%biomass = 0.0_dp ! layer biomass POP%pop_grid(g)%patch(k)%Layer(L)%density = 0.0_dp ! layer tree density POP%pop_grid(g)%patch(k)%Layer(L)%hmean = 0.0_dp ! layer mean tree height (weighted mean over patches) POP%pop_grid(g)%patch(k)%Layer(L)%hmax = 0.0_dp ! layer max tree height - DO c=1, NCOHORT_MAX + do c=1, NCOHORT_MAX POP%pop_grid(g)%patch(k)%Layer(L)%cohort(c)%id = 0 POP%pop_grid(g)%patch(k)%Layer(L)%cohort(c)%age = 0 ! cohort age POP%pop_grid(g)%patch(k)%Layer(L)%cohort(c)%biomass = 0.0_dp ! cohort biomass @@ -455,72 +457,72 @@ SUBROUTINE ZeroPOP(POP,n) POP%pop_grid(g)%patch(k)%Layer(L)%cohort(c)%LAI = 0.0_dp POP%pop_grid(g)%patch(k)%Layer(L)%cohort(c)%Cleaf = 0.0_dp POP%pop_grid(g)%patch(k)%Layer(L)%cohort(c)%Croot = 0.0_dp - ENDDO ! NCOHORT_MAX + enddo ! NCOHORT_MAX - ENDDO ! NLAYER + enddo ! NLAYER - ENDDO ! NPATCH2D + enddo ! NPATCH2D - ENDDO ! pop_grid%np + enddo ! pop_grid%np - END SUBROUTINE ZeroPOP + end subroutine ZeroPOP !******************************************************************************* - SUBROUTINE InitPOP2D_Poisson(POP, mean_disturbance_interval, m) + subroutine InitPOP2D_Poisson(POP, mean_disturbance_interval, m) ! Initialises vector of patches with maximum age correpondding to 95% of pdf ! Starting year: uniform distribution up to maximum age - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: mean_disturbance_interval(:,:) - INTEGER(i4b), INTENT(IN), optional :: m + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: mean_disturbance_interval(:,:) + integer(i4b), intent(IN), optional :: m - INTEGER(i4b) :: j, k, g, ipatch, idist, p, c, i - INTEGER(i4b) :: disturbance_interval - INTEGER(i4b):: Poisson_age(1000) - REAL(dp):: Poisson_weight(1000), CumPoisson_weight(1000) - INTEGER:: i_max - INTEGER:: np - REAL(dp):: disturbance_freq - INTEGER:: tmp2(PATCH_REPS1), tmp3(PATCH_REPS2) - INTEGER:: a,b + integer(i4b) :: j, k, g, ipatch, idist, p, c, i + integer(i4b) :: disturbance_interval + integer(i4b):: Poisson_age(1000) + real(dp):: Poisson_weight(1000), CumPoisson_weight(1000) + integer:: i_max + integer:: np + real(dp):: disturbance_freq + integer:: tmp2(PATCH_REPS1), tmp3(PATCH_REPS2) + integer:: a,b - np = SIZE(POP%pop_grid) + np = size(POP%pop_grid) a = 1 b = np - IF (PRESENT(m)) THEN + if (present(m)) then a = m b = m - ENDIF + endif - DO g=a,b + do g=a,b ! calculate Poisson weights for each of the 2 mean disturbance intervals - IF (NPATCH.gt.1) THEN - DO idist=1,NDISTURB - disturbance_freq=1.0_dp/REAL(mean_disturbance_interval(g,idist),dp) - DO p = 1,1000 + if (NPATCH.gt.1) then + do idist=1,NDISTURB + disturbance_freq=1.0_dp/real(mean_disturbance_interval(g,idist),dp) + do p = 1,1000 Poisson_age(p) = p Poisson_weight(p) = Exponential(disturbance_freq,p) - CumPoisson_weight(p) = CumExponential(disturbance_freq,REAL(p,dp)) - ENDDO + CumPoisson_weight(p) = CumExponential(disturbance_freq,real(p,dp)) + enddo ! set max age to correspond to 95% percentile of cum pdf - DO k =1,NPATCH2D - i_max = MAXLOC(Poisson_age,1,CumPoisson_weight.LE.0.95_dp) + do k =1,NPATCH2D + i_max = maxloc(Poisson_age,1,CumPoisson_weight.le.0.95_dp) POP%pop_grid(g)%patch(k)%disturbance_interval(idist) = Poisson_age(i_max) POP%pop_grid(g)%patch(k)%id = k POP%pop_grid(g)%patch(k)%age = 0 - ENDDO - ENDDO + enddo + enddo - DO idist =1,ndisturb + do idist =1,ndisturb ! set first disturbance year for first dist interval class if (idist .eq. 1) then disturbance_interval = POP%pop_grid(g)%patch(1)%disturbance_interval(idist) - DO c = 1,PATCH_REPS1 + do c = 1,PATCH_REPS1 if (c==1) then tmp2(1) = 1 else @@ -529,15 +531,15 @@ SUBROUTINE InitPOP2D_Poisson(POP, mean_disturbance_interval, m) tmp2(2) = max(disturbance_interval*c/(PATCH_REPS1),1) tmp2(3) = tmp2(1) ! write(*,*) 'tmp2', c, disturbance_interval, tmp2(1),tmp2(2) - DO j = 1,PATCH_REPS2 + do j = 1,PATCH_REPS2 ipatch = (c-1)*PATCH_REPS2 + j POP%pop_grid(g)%patch(ipatch)%first_disturbance_year(idist) = tmp2(3) tmp2(3)=tmp2(3)+1 if (tmp2(3)>tmp2(2)) then tmp2(3) = tmp2(1) - ENDIF - ENDDO - ENDDO + endif + enddo + enddo ! ! set first disturbance year for first dist interval class ! idist = 1 @@ -568,70 +570,70 @@ SUBROUTINE InitPOP2D_Poisson(POP, mean_disturbance_interval, m) ! ENDDO ! set first disturbance year for first 2nd interval class - ELSEIF (idist.eq.2) then + elseif (idist.eq.2) then disturbance_interval = POP%pop_grid(g)%patch(1)%disturbance_interval(idist) - DO c = 1,PATCH_REPS2 + do c = 1,PATCH_REPS2 tmp3(c) = max(disturbance_interval*(c-1)/(PATCH_REPS2),1) - ENDDO + enddo - DO c = 1,PATCH_REPS2 + do c = 1,PATCH_REPS2 i = 0 - DO j = 1,PATCH_REPS1 + do j = 1,PATCH_REPS1 ipatch = (j-1)*PATCH_REPS2 + c POP%pop_grid(g)%patch(ipatch)%first_disturbance_year(idist) = & tmp3(c) +(j-1)*max((tmp3(idist)-tmp3(1))/PATCH_REPS1,1) ! i = i+1 ! if (i.gt.(tmp3(2)-tmp3(1))) i = 0 - ENDDO - ENDDO - ENDIF + enddo + enddo + endif - ENDDO + enddo - ELSE ! NPATCH =1 (single patch mode) + else ! NPATCH =1 (single patch mode) k = 1 - DO idist=1,NDISTURB + do idist=1,NDISTURB POP%pop_grid(g)%patch(k)%disturbance_interval(idist) = mean_disturbance_interval(g,idist) POP%pop_grid(g)%patch(k)%first_disturbance_year(idist) = 113 POP%pop_grid(g)%patch(k)%age = 0 POP%pop_grid(g)%patch(k)%id = k - ENDDO - ENDIF + enddo + endif POP%pop_grid(g)%npatch_active = NPATCH - ENDDO + enddo - END SUBROUTINE InitPOP2D_Poisson + end subroutine InitPOP2D_Poisson !******************************************************************************* + !NB changes in here due to svn 9635 - replacing StemNPP_av with StemNPP_pot 5/4/2024 + subroutine POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI,Cleaf,Croot, & + NPPtoGPP, StemNPP_pot,frac_intensity1,precip) - SUBROUTINE POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI,Cleaf,Croot, & - NPPtoGPP, StemNPP_av,frac_intensity1,precip) - - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - REAL(dp), INTENT(IN) :: StemNPP(:,:) - REAL(dp), INTENT(IN) :: disturbance_intensity(:,:) - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) - REAL(dp), INTENT(IN) :: LAI(:) - REAL(dp), INTENT(IN) :: Cleaf(:) - REAL(dp), INTENT(IN) :: Croot(:) - REAL(dp), INTENT(IN) :: NPPtoGPP(:) - REAL(dp), INTENT(IN), OPTIONAL :: frac_intensity1(:), precip(:) - REAL(dp), INTENT(IN), OPTIONAL :: StemNPP_av(:) + type(POP_TYPE), intent(INOUT) :: POP + real(dp), intent(IN) :: StemNPP(:,:) + real(dp), intent(IN) :: disturbance_intensity(:,:) + integer(i4b), intent(IN) :: disturbance_interval(:,:) + real(dp), intent(IN) :: LAI(:) + real(dp), intent(IN) :: Cleaf(:) + real(dp), intent(IN) :: Croot(:) + real(dp), intent(IN) :: NPPtoGPP(:) + real(dp), intent(IN), optional :: frac_intensity1(:), precip(:) + real(dp), intent(IN), optional :: StemNPP_pot(:) - INTEGER(i4b) :: idisturb,np,g - INTEGER(i4b), allocatable :: it(:) + integer(i4b) :: idisturb,np,g + integer(i4b), allocatable :: it(:) !INTEGER, INTENT(IN) :: wlogn pop%it_pop = pop%it_pop + 1 !it = pop%it_pop(1) - np = SIZE(POP%POP_grid) + np = size(POP%POP_grid) allocate(it(np)) do g=1, np @@ -644,89 +646,89 @@ SUBROUTINE POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI ! CALL GetPatchFrequencies(POP) !call flush(wlogn) - IF (PRESENT(precip)) THEN - IF(PRESENT(StemNPP_av)) THEN - CALL PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it, precip=precip, StemNPP_av=StemNPP_av) - ELSE - CALL PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it, precip=precip) - ENDIF - ELSE - IF(PRESENT(StemNPP_av)) THEN - CALL PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it, StemNPP_av=StemNPP_av) - ELSE - CALL PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it) - ENDIF - ENDIF - - IF (NDISTURB.EQ.1) THEN - IF (PRESENT(precip)) THEN + if (present(precip)) then + if(present(StemNPP_pot)) then + call PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it, precip=precip, StemNPP_pot=StemNPP_pot) + else + call PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it, precip=precip) + endif + else + if(present(StemNPP_pot)) then + call PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it, StemNPP_pot=StemNPP_pot) + else + call PatchAnnualDynamics(POP, StemNPP, NPPtoGPP, it) + endif + endif + + if (NDISTURB.eq.1) then + if (present(precip)) then ! CALL Patch_disturb(POP,it,1,precip) - CALL Patch_partial_disturb2(POP,1) - ELSE - CALL Patch_disturb(POP,1) + call Patch_partial_disturb2(POP,1) + else + call Patch_disturb(POP,1) ! CALL Patch_partial_disturb2(POP,it) - ENDIF - ELSEIF (NDISTURB.EQ.2) THEN - IF (PRESENT(frac_intensity1)) THEN - CALL Patch_partial_disturb(POP,1,disturbance_intensity,frac_intensity1=frac_intensity1) - ELSE - CALL Patch_partial_disturb(POP,1,disturbance_intensity) - ENDIF - IF (PRESENT(precip)) THEN + endif + elseif (NDISTURB.eq.2) then + if (present(frac_intensity1)) then + call Patch_partial_disturb(POP,1,disturbance_intensity,frac_intensity1=frac_intensity1) + else + call Patch_partial_disturb(POP,1,disturbance_intensity) + endif + if (present(precip)) then !CALL Patch_partial_disturb2(POP,it,2) - CALL Patch_disturb(POP,2,precip) - ELSE + call Patch_disturb(POP,2,precip) + else ! CALL Patch_partial_disturb2(POP,it,2) - CALL Patch_disturb(POP,2) - ENDIF - ENDIF + call Patch_disturb(POP,2) + endif + endif - DO idisturb = 1,NDISTURB - CALL GetUniqueAgeFrequencies(POP, disturbance_interval, idisturb) - ENDDO + do idisturb = 1,NDISTURB + call GetUniqueAgeFrequencies(POP, disturbance_interval, idisturb) + enddo - CALL GetPatchFrequencies(POP) + call GetPatchFrequencies(POP) - IF (PRESENT(precip)) THEN - CALL GetDiagnostics(pop, LAI,Cleaf,Croot, disturbance_interval, it,precip) - ELSE - CALL GetDiagnostics(pop, LAI,Cleaf,Croot, disturbance_interval, it) - ENDIF + if (present(precip)) then + call GetDiagnostics(pop, LAI,Cleaf,Croot, disturbance_interval, it,precip) + else + call GetDiagnostics(pop, LAI,Cleaf,Croot, disturbance_interval, it) + endif - END SUBROUTINE POPStep + end subroutine POPStep !******************************************************************************* + !NB changes in here due to svn 9635 - replacing StemNPP_av with StemNPP_pot 5/4/2024 + subroutine PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_pot, precip) - SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) + implicit none - IMPLICIT NONE + type( POP_TYPE ), intent(INOUT) :: pop + real(dp), intent(IN) :: StemNPP(:,:) + real(dp), intent(IN) :: NPPtoGPP(:) + real(dp), intent(IN), optional :: precip(:) + real(dp), optional, intent(IN) :: StemNPP_pot(:) + integer(i4b), intent(IN) :: it(:) - TYPE( POP_TYPE ), INTENT(INOUT) :: pop - REAL(dp), INTENT(IN) :: StemNPP(:,:) - REAL(dp), INTENT(IN) :: NPPtoGPP(:) - REAL(dp), INTENT(IN), OPTIONAL :: precip(:) - REAL(dp), OPTIONAL, INTENT(IN) :: StemNPP_av(:) - INTEGER(i4b), INTENT(IN) :: it(:) + real(dp) :: densindiv + real(dp) :: tmp,tmp_light,tmp_respiration,tmp_fracnpp, cmass_stem_inc + integer(i4b) :: j, k,c, idist + integer(i4b) :: ivec(NCOHORT_MAX), nc, np + real(dp) :: growth_efficiency,cmass_stem + real(dp) :: mort + real(dp) :: cpc, crown_area + real(dp) :: mort_cpc + real(dp) :: ht, diam, area_growth_grid , basal_grid, basal_new, basal_old + real(dp) :: tmp2(NCOHORT_MAX), freq - REAL(dp) :: densindiv - REAL(dp) :: tmp,tmp_light,tmp_respiration,tmp_fracnpp, cmass_stem_inc - INTEGER(i4b) :: j, k,c, idist - INTEGER(i4b) :: ivec(NCOHORT_MAX), nc, np - REAL(dp) :: growth_efficiency,cmass_stem - REAL(dp) :: mort - REAL(dp) :: cpc, crown_area - REAL(dp) :: mort_cpc - REAL(dp) :: ht, diam, area_growth_grid , basal_grid, basal_new, basal_old - REAL(dp) :: tmp2(NCOHORT_MAX), freq - - np = SIZE(POP%POP_grid) + np = size(POP%POP_grid) ! growth ! Distributes layer biomass increment among cohorts and increments age ! calculate fractional resource uptake by each cohort - DO j=1,np + do j=1,np basal_grid = 0.0_dp area_growth_grid = 0.0_dp pop%pop_grid(j)%sapwood_area_old = pop%pop_grid(j)%sapwood_area @@ -742,20 +744,20 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) tmp_fracNPP = 0.0_dp if (NPATCH2D >1 .and. it(j) > 1 .and. RESOURCE_SWITCH>0) then - DO k=1,NPATCH2D + do k=1,NPATCH2D freq = pop%pop_grid(j)%freq(pop%pop_grid(j)%patch(k)%id) nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort - DO c=1,nc + do c=1,nc pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_light_uptake = & pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%frac_interception ! defined in terms of Pgap ! total autotrophic resp, summed over all cohorts and patches tmp_respiration = tmp_respiration + & freq*pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%respiration_scalar - ENDDO + enddo tmp_light = tmp_light + freq*(1.0_dp - pop%pop_grid(j)%patch(k)%Pgap) - ENDDO - IF (tmp_respiration .gt. 1.0e-8_dp .and. tmp_light .gt. 1.0e-8_dp) then - DO k=1,NPATCH2D + enddo + if (tmp_respiration .gt. 1.0e-8_dp .and. tmp_light .gt. 1.0e-8_dp) then + do k=1,NPATCH2D ! fraction respiration and un-normalised NPP for each patch nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort freq = pop%pop_grid(j)%freq(pop%pop_grid(j)%patch(k)%id) @@ -774,21 +776,21 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) tmp_fracNPP = tmp_fracNPP + freq*pop%pop_grid(j)%patch(k)%frac_NPP - ENDDO + enddo ! normalised fraction NPP - DO k=1,NPATCH2D + do k=1,NPATCH2D pop%pop_grid(j)%patch(k)%frac_NPP = & pop%pop_grid(j)%patch(k)%frac_NPP/tmp_fracNPP - ENDDO - ELSE + enddo + else pop%pop_grid(j)%patch(:)%frac_NPP = 1.0_dp pop%pop_grid(j)%patch(:)%frac_respiration = 1.0_dp pop%pop_grid(j)%patch(:)%frac_light_uptake = 1.0_dp - ENDIF + endif else pop%pop_grid(j)%patch(:)%frac_NPP = 1.0_dp pop%pop_grid(j)%patch(:)%frac_respiration = 1.0_dp @@ -796,25 +798,25 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) endif ! End Get fraction allocation for each patch ! Get fraction allocation for each cohort in each patch - DO k=1,NPATCH2D + do k=1,NPATCH2D tmp = 0.0_dp tmp_light = 0.0_dp tmp_respiration = 0.0_dp tmp_fracNPP = 0.0_dp if (pop%pop_grid(j)%patch(k)%Layer(1)%ncohort>1) then nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort cmass_stem = pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%biomass densindiv = pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%density ! get initial basal area - IF ( PRESENT(precip) ) THEN - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old, precip(j)) - ELSE - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old ) - ENDIF + if ( present(precip) ) then + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old, precip(j)) + else + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old ) + endif if (ALLOM_SWITCH.eq.1) then !! assumes crown radius (m) = 0.1492 * dbh (cm) (from G. Cook, pers. comm.) @@ -835,11 +837,11 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c:nc)%density)**POWERbiomass * & pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c:nc)%density) - ENDDO + enddo ! un-normalised fractional gross resource uptake: weighted combination of components ! where cohort competes with older cohorts and where it does not - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort if (RESOURCE_SWITCH ==1) then pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_interception = & @@ -848,20 +850,20 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_interception = 1.0_dp endif - ENDDO + enddo !normalised fractional gross resource uptake nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort !normalised fractional gross resource uptake pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_light_uptake = & pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_interception/ & sum(pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)%frac_interception) - ENDDO + enddo ! fraction respiration and un-normalised NPP - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_respiration = & pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%respiration_scalar/tmp_respiration @@ -873,19 +875,19 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) tmp_fracNPP = tmp_fracNPP + pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_NPP - ENDDO + enddo ! normalised fraction NPP - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_NPP = & pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_NPP/tmp_fracNPP - ENDDO + enddo ! fraction net resource uptake - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort if (RESOURCE_SWITCH==0) then @@ -906,7 +908,7 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) endif - ENDDO + enddo else c = 1 @@ -923,10 +925,10 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) endif - ENDDO + enddo tmp = 0 - DO k=1,NPATCH2D + do k=1,NPATCH2D pop%pop_grid(j)%patch(k)%sapwood_loss = 0.0_dp pop%pop_grid(j)%patch(k)%sapwood_area_loss = 0.0_dp pop%pop_grid(j)%patch(k)%sapwood_old = pop%pop_grid(j)%patch(k)%sapwood @@ -936,18 +938,18 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%area_growth = 0.0_dp nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort freq = pop%pop_grid(j)%freq(pop%pop_grid(j)%patch(k)%id) - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort cmass_stem = pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%biomass densindiv = pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%density ! get initial basal area - IF ( PRESENT(precip) ) THEN - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old, precip(j)) - ELSE - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old ) - ENDIF + if ( present(precip) ) then + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old, precip(j)) + else + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_old ) + endif ! increment biomass in cohort pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%biomass = & @@ -958,12 +960,12 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) tmp = tmp + freq*pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_resource_uptake ! get incremented basal area - IF ( PRESENT(precip) ) THEN - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_new, precip(j)) - ELSE + if ( present(precip) ) then + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_new, precip(j)) + else - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_new ) - ENDIF + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal_new ) + endif ! increment sapwood in cohort @@ -1001,35 +1003,35 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%age = & pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%age + 1 - ENDDO + enddo ! Layer biomass (summed over cohorts) nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort - pop%pop_grid(j)%patch(k)%Layer(1)%biomass = SUM(pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)%biomass) + pop%pop_grid(j)%patch(k)%Layer(1)%biomass = sum(pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)%biomass) - ENDDO + enddo - ENDDO + enddo ! Mortality !Implements resource stress mortality and crowding mortality for all cohorts in layer - DO j=1,np - DO k=1,NPATCH2D + do j=1,np + do k=1,NPATCH2D nc = 0 ivec = 0 pop%pop_grid(j)%patch(k)%stress_mortality = 0.0_dp pop%pop_grid(j)%patch(k)%crowding_mortality = 0.0_dp pop%pop_grid(j)%patch(k)%mortality = 0.0_dp crown_area = 0.0_dp - DO c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + do c=1,pop%pop_grid(j)%patch(k)%Layer(1)%ncohort cmass_stem = pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%biomass cmass_stem_inc=StemNPP(j,1)*pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_resource_uptake - if (present(StemNPP_av)) then + if (present(StemNPP_pot)) then growth_efficiency=pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%frac_resource_uptake* & - StemNPP_av(j) /(cmass_stem**(POWERGrowthEfficiency)) + StemNPP_pot(j) /(cmass_stem**(POWERGrowthEfficiency)) else growth_efficiency=cmass_stem_inc/(cmass_stem**(POWERGrowthEfficiency)) endif @@ -1040,7 +1042,7 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%stress_mortality = pop%pop_grid(j)%patch(k)%stress_mortality & + mort*cmass_stem - IF (pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%diameter*100_dp .GT. 1.0_dp) THEN + if (pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%diameter*100_dp .gt. 1.0_dp) then if (ALLOM_SWITCH.eq.1) then ! assumes crown radius (m) = 0.14 * dbh (cm) crown_area = crown_area + pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density* & @@ -1049,9 +1051,9 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) crown_area = crown_area + pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density* & k_allom1 * pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%diameter ** k_rp endif - ELSE + else crown_area = crown_area + 0.5_dp*pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%LAI - ENDIF + endif cpc = 1.0_dp - exp(-crown_area) pop%pop_grid(j)%patch(k)%cpc = cpc @@ -1084,7 +1086,7 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density = & pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density*(1.0_dp-mort) - IF (pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density.LT.DENSINDIV_MIN) THEN + if (pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density.lt.DENSINDIV_MIN) then ! remove cohort pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%id = 0 @@ -1098,15 +1100,15 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%sapwood = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%heartwood = 0.0_dp - ELSE + else pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%id = 1 !COMMLN Why is id here 1 instead of c or sth useful? Call it differently nc = nc+1 ivec(nc)=c - ENDIF - ENDDO + endif + enddo ! SHUFFLE if necessary to remove zero-density cohorts - IF (nc.LT.pop%pop_grid(j)%patch(k)%Layer(1)%ncohort) THEN + if (nc.lt.pop%pop_grid(j)%patch(k)%Layer(1)%ncohort) then pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)=pop%pop_grid(j)%patch(k)%Layer(1)%cohort(ivec(1:nc)) pop%pop_grid(j)%patch(k)%Layer(1)%ncohort = nc @@ -1117,75 +1119,75 @@ SUBROUTINE PatchAnnualDynamics(pop, StemNPP, NPPtoGPP, it, StemNPP_av, precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%sapwood_area = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%basal_area = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%heartwood = 0.0_dp - ENDIF + endif ! Layer biomass (summed over cohorts) nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort - pop%pop_grid(j)%patch(k)%Layer(1)%biomass = SUM(pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)%biomass) - ENDDO - ENDDO + pop%pop_grid(j)%patch(k)%Layer(1)%biomass = sum(pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)%biomass) + enddo + enddo ! recruitment - IF (PRESENT(precip)) THEN - CALL layer_recruitment(pop, precip) - ELSE - CALL layer_recruitment(pop) - ENDIF + if (present(precip)) then + call layer_recruitment(pop, precip) + else + call layer_recruitment(pop) + endif ! Update time since last patch disturbance - DO j=1,np - DO k=1,NPATCH2D + do j=1,np + do k=1,NPATCH2D - DO idist =1, NDISTURB + do idist =1, NDISTURB pop%pop_grid(j)%patch(k)%age(idist) = pop%pop_grid(j)%patch(k)%age(idist) + 1 - ENDDO + enddo - ENDDO + enddo - ENDDO + enddo - END SUBROUTINE PatchAnnualDynamics + end subroutine PatchAnnualDynamics !******************************************************************************* - SUBROUTINE GetUniqueAgeFrequencies(pop, disturbance_interval, idisturb) + subroutine GetUniqueAgeFrequencies(pop, disturbance_interval, idisturb) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:), idisturb + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: disturbance_interval(:,:), idisturb - INTEGER(i4b) :: g, i,j,k,agecopy,idcopy - REAL(dp), ALLOCATABLE :: midpoint(:) - INTEGER(i4b), ALLOCATABLE :: ranked_age(:), ranked_age_init(:) - INTEGER(i4b) :: age_tmp - INTEGER(i4b), ALLOCATABLE :: ranked_age_unique_id(:), ranked_age_id(:), counter(:) - REAL(dp), ALLOCATABLE :: tmp(:), freq_tmp(:), freq_tmp1(:) - REAL(dp) :: freq - INTEGER(i4b) :: n_age ! number of unique ages - INTEGER(i4b) :: npatch_active ! number of active patches - REAL(dp):: disturbance_freq - INTEGER(i4b) :: i_max, Poisson_age(1000), np - REAL(dp):: CumPoisson_weight(1000) - INTEGER(i4b), ALLOCATABLE :: bound(:,:), unique_age(:) + integer(i4b) :: g, i,j,k,agecopy,idcopy + real(dp), allocatable :: midpoint(:) + integer(i4b), allocatable :: ranked_age(:), ranked_age_init(:) + integer(i4b) :: age_tmp + integer(i4b), allocatable :: ranked_age_unique_id(:), ranked_age_id(:), counter(:) + real(dp), allocatable :: tmp(:), freq_tmp(:), freq_tmp1(:) + real(dp) :: freq + integer(i4b) :: n_age ! number of unique ages + integer(i4b) :: npatch_active ! number of active patches + real(dp):: disturbance_freq + integer(i4b) :: i_max, Poisson_age(1000), np + real(dp):: CumPoisson_weight(1000) + integer(i4b), allocatable :: bound(:,:), unique_age(:) !Fills array freq with weights (frequencies across landscape) for each unique age ! given specified mean disturbance interval - np = SIZE(POP%POP_grid) - DO g=1,np + np = size(POP%POP_grid) + do g=1,np npatch_active = NPATCH2D - IF (.NOT.ALLOCATED(midpoint)) ALLOCATE(midpoint(npatch_active)) - IF (.NOT.ALLOCATED(counter)) ALLOCATE(counter(npatch_active)) - IF (.NOT.ALLOCATED(ranked_age)) ALLOCATE(ranked_age(npatch_active)) - IF (.NOT.ALLOCATED(ranked_age_init)) ALLOCATE(ranked_age_init(npatch_active)) - IF (.NOT.ALLOCATED(ranked_age_id)) ALLOCATE(ranked_age_id(npatch_active)) - IF (.NOT.ALLOCATED(ranked_age_unique_id)) ALLOCATE(ranked_age_unique_id(npatch_active)) - IF (.NOT.ALLOCATED(tmp)) ALLOCATE(tmp(npatch_active)) - IF (.NOT.ALLOCATED(freq_tmp)) ALLOCATE(freq_tmp(npatch_active)) - IF (.NOT.ALLOCATED(freq_tmp1)) ALLOCATE(freq_tmp1(npatch_active)) + if (.not.allocated(midpoint)) allocate(midpoint(npatch_active)) + if (.not.allocated(counter)) allocate(counter(npatch_active)) + if (.not.allocated(ranked_age)) allocate(ranked_age(npatch_active)) + if (.not.allocated(ranked_age_init)) allocate(ranked_age_init(npatch_active)) + if (.not.allocated(ranked_age_id)) allocate(ranked_age_id(npatch_active)) + if (.not.allocated(ranked_age_unique_id)) allocate(ranked_age_unique_id(npatch_active)) + if (.not.allocated(tmp)) allocate(tmp(npatch_active)) + if (.not.allocated(freq_tmp)) allocate(freq_tmp(npatch_active)) + if (.not.allocated(freq_tmp1)) allocate(freq_tmp1(npatch_active)) ! rank patches in order of age @@ -1200,226 +1202,226 @@ SUBROUTINE GetUniqueAgeFrequencies(pop, disturbance_interval, idisturb) midpoint = 0.0_dp - DO i = 1, npatch_active -1 - DO j = i+1, npatch_active - IF (ranked_age(i).GT.ranked_age(j)) THEN + do i = 1, npatch_active -1 + do j = i+1, npatch_active + if (ranked_age(i).gt.ranked_age(j)) then agecopy = ranked_age(i) idcopy = ranked_age_id(i) ranked_age(i) = ranked_age(j) ranked_age_id(i) = ranked_age_id(j) ranked_age(j) = agecopy ranked_age_id(j) = idcopy - ENDIF - ENDDO - ENDDO + endif + enddo + enddo ! subset to unique ages k=0 age_tmp = -1 - DO i = 1, npatch_active - IF (ranked_age(i).NE.age_tmp) k = k+1 + do i = 1, npatch_active + if (ranked_age(i).ne.age_tmp) k = k+1 pop%pop_grid(g)%ranked_age_unique(k, idisturb) = ranked_age(i) ranked_age_unique_id(k) = ranked_age_id(i) age_tmp = ranked_age(i) n_age = k - ENDDO + enddo - disturbance_freq=1.0_dp/REAL(disturbance_interval(g,idisturb),dp) - DO i =1,1000 + disturbance_freq=1.0_dp/real(disturbance_interval(g,idisturb),dp) + do i =1,1000 Poisson_age(i) = i - CumPoisson_weight(i) = CumExponential(disturbance_freq,REAL(i,dp)) + CumPoisson_weight(i) = CumExponential(disturbance_freq,real(i,dp)) - ENDDO + enddo ! construct upper and lower bounds for each unique age: these set the range of ages to be ! represented by an unique age - ALLOCATE(bound(n_age,2)) - ALLOCATE (unique_age(n_age)) + allocate(bound(n_age,2)) + allocate (unique_age(n_age)) bound = 0 unique_age = pop%pop_grid(g)%ranked_age_unique(1:n_age,idisturb) - DO i=1,n_age - IF (unique_age(i).EQ.0) THEN + do i=1,n_age + if (unique_age(i).eq.0) then bound(i,1) = 0 bound(i,2) = 0 - ELSEIF ((i.EQ.1).AND.(unique_age(i).GT.0)) THEN + elseif ((i.eq.1).and.(unique_age(i).gt.0)) then bound(i,1) = 0 bound(i,2) = unique_age(i) - ELSEIF ((unique_age(i).GT.0).AND.(i.GT.1).AND.(unique_age(i-1).EQ.unique_age(i)-1)) THEN + elseif ((unique_age(i).gt.0).and.(i.gt.1).and.(unique_age(i-1).eq.unique_age(i)-1)) then bound(i,1) = unique_age(i) - IF (i.LT.n_age) THEN + if (i.lt.n_age) then bound(i,2) = unique_age(i) - ELSE - i_max = MAXLOC(Poisson_age, 1, CumPoisson_weight.LE.0.99_dp) + else + i_max = maxloc(Poisson_age, 1, CumPoisson_weight.le.0.99_dp) bound(i, 2) = Poisson_age(i_max) - ENDIF - ELSEIF ((unique_age(i).GT.0).AND.(i.GT.1).AND.(unique_age(i-1).NE.unique_age(i)-1)) THEN + endif + elseif ((unique_age(i).gt.0).and.(i.gt.1).and.(unique_age(i-1).ne.unique_age(i)-1)) then bound(i,1) = bound(i-1,2)+1 - IF (i.LT.n_age) THEN + if (i.lt.n_age) then bound(i,2) = (unique_age(i)+ unique_age(i+1))/2 - ELSE - i_max = MAXLOC(Poisson_age, 1, CumPoisson_weight.LE.0.99_dp) + else + i_max = maxloc(Poisson_age, 1, CumPoisson_weight.le.0.99_dp) bound(i, 2) = Poisson_age(i_max) - ENDIF - ENDIF + endif + endif - ENDDO + enddo ! calculate weighting for each unique age - DO i=1,n_age - DO j = bound(i,1),bound(i,2) + do i=1,n_age + do j = bound(i,1),bound(i,2) !IF (pop%LU(g)==2) THEN ! secondary forest - IF (POP%pop_grid(g)%LU ==2) THEN + if (POP%pop_grid(g)%LU ==2) then freq_tmp(i) = freq_tmp(i) + pop%pop_grid(g)%freq_age(j+1) - ELSE - freq_tmp(i) = freq_tmp(i) + REALExponential(disturbance_freq,REAL(j,dp)) - ENDIF + else + freq_tmp(i) = freq_tmp(i) + REALExponential(disturbance_freq,real(j,dp)) + endif - ENDDO - ENDDO + enddo + enddo pop%pop_grid(g)%freq_ranked_age_unique(1:npatch_active,idisturb) = freq_tmp pop%pop_grid(g)%n_age(idisturb) = n_age - DEALLOCATE (bound) - DEALLOCATE (unique_age) + deallocate (bound) + deallocate (unique_age) - ENDDO + enddo - END SUBROUTINE GetUniqueAgeFrequencies + end subroutine GetUniqueAgeFrequencies !******************************************************************************* - SUBROUTINE GetPatchFrequencies(pop) + subroutine GetPatchFrequencies(pop) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP + type(POP_TYPE), intent(INOUT) :: POP - INTEGER(i4b) :: n1, n2, g, REPCOUNT, np, idist - REAL(dp) :: sum_freq + integer(i4b) :: n1, n2, g, REPCOUNT, np, idist + real(dp) :: sum_freq - np = SIZE(Pop%pop_grid) - DO g=1,np + np = size(Pop%pop_grid) + do g=1,np pop%pop_grid(g)%freq = 0.0_dp - DO idist = 1, NDISTURB - IF (idist.EQ.1) THEN - DO n1=1,pop%pop_grid(g)%n_age(1) - repcount = COUNT(pop%pop_grid(g)%patch(:)%age(1).EQ.pop%pop_grid(g)%ranked_age_unique(n1,1)) - WHERE (pop%pop_grid(g)%patch(:)%age(1).EQ.pop%pop_grid(g)%ranked_age_unique(n1,1)) - pop%pop_grid(g)%freq = pop%pop_grid(g)%freq_ranked_age_unique(n1,1) /REAL(repcount,dp) + do idist = 1, NDISTURB + if (idist.eq.1) then + do n1=1,pop%pop_grid(g)%n_age(1) + repcount = count(pop%pop_grid(g)%patch(:)%age(1).eq.pop%pop_grid(g)%ranked_age_unique(n1,1)) + where (pop%pop_grid(g)%patch(:)%age(1).eq.pop%pop_grid(g)%ranked_age_unique(n1,1)) + pop%pop_grid(g)%freq = pop%pop_grid(g)%freq_ranked_age_unique(n1,1) /real(repcount,dp) ENDWHERE - ENDDO + enddo - ELSEIF (idist.EQ.2) THEN + elseif (idist.eq.2) then ! first calculate weights for patches with age(2)>age(1) - DO n1=1,pop%pop_grid(g)%n_age(1) + do n1=1,pop%pop_grid(g)%n_age(1) - DO n2=1,pop%pop_grid(g)%n_age(idist) - repcount = COUNT((pop%pop_grid(g)%patch(1:NPATCH)%age(1) .EQ. & - pop%pop_grid(g)%ranked_age_unique(n1,1)).AND. & - (pop%pop_grid(g)%patch(1:NPATCH)%age(idist) .EQ. & + do n2=1,pop%pop_grid(g)%n_age(idist) + repcount = count((pop%pop_grid(g)%patch(1:NPATCH)%age(1) .eq. & + pop%pop_grid(g)%ranked_age_unique(n1,1)).and. & + (pop%pop_grid(g)%patch(1:NPATCH)%age(idist) .eq. & pop%pop_grid(g)%ranked_age_unique(n2,idist))) - WHERE ((pop%pop_grid(g)%patch(1:NPATCH)%age(1).EQ.pop%pop_grid(g)%ranked_age_unique(n1,1)).AND. & - (pop%pop_grid(g)%patch(1:NPATCH)%age(idist).EQ.pop%pop_grid(g)%ranked_age_unique(n2,idist))) + where ((pop%pop_grid(g)%patch(1:NPATCH)%age(1).eq.pop%pop_grid(g)%ranked_age_unique(n1,1)).and. & + (pop%pop_grid(g)%patch(1:NPATCH)%age(idist).eq.pop%pop_grid(g)%ranked_age_unique(n2,idist))) pop%pop_grid(g)%freq(1:NPATCH) = pop%pop_grid(g)%freq_ranked_age_unique(n1,1)* & pop%pop_grid(g)%freq_ranked_age_unique(n2,idist) & - /REAL(repcount,dp) + /real(repcount,dp) ENDWHERE - ENDDO - ENDDO + enddo + enddo - ENDIF - ENDDO ! end loop over idist + endif + enddo ! end loop over idist - sum_freq = SUM(pop%pop_grid(g)%freq) + sum_freq = sum(pop%pop_grid(g)%freq) if (sum_freq.gt.0.0_dp) pop%pop_grid(g)%freq = pop%pop_grid(g)%freq/sum_freq - ENDDO + enddo - END SUBROUTINE GetPatchFrequencies + end subroutine GetPatchFrequencies !******************************************************************************* - SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) + subroutine GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) ! Gets diagnostic data for current landscape structure - IMPLICIT NONE - - TYPE(POP_TYPE), INTENT(INOUT) :: POP - REAL(dp), INTENT(IN) :: LAI(:) - REAL(dp), INTENT(IN) :: Cleaf(:) - REAL(dp), INTENT(IN) :: Croot(:) - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) - REAL(dp), INTENT(IN), OPTIONAL :: precip(:) - INTEGER(i4b), INTENT(IN) :: it(:) - INTEGER(i4b) :: P, g,i,j,ct, ct_highres - REAL(dp) :: limits(HEIGHT_BINS+1) - REAL(dp) :: ht, cmass_stem,densindiv, freq, freq_old - CHARACTER(len=12) :: string1, string2 - CHARACTER(len=9) :: fmt - INTEGER(i4b) :: npatch_active ! number of active patches - INTEGER(i4b) :: np, nc, i_height - REAL(dp) :: diam,basal, cump - REAL(dp) :: patch_crown_area(NPATCH2D), patch_crown_cover(NPATCH2D) - REAL(dp), ALLOCATABLE :: height_list(:), height_list_weight(:) - REAL(dp) :: height_copy, weight_copy, Pwc, FAVD - INTEGER(i4b), PARAMETER :: HEIGHT_BINS_highres=100 ! bins for assessing height_max - REAL(dp), ALLOCATABLE :: limits_highres(:), DENSINDIV_HIGHRES(:) - REAL(dp) :: tmp2 + implicit none + + type(POP_TYPE), intent(INOUT) :: POP + real(dp), intent(IN) :: LAI(:) + real(dp), intent(IN) :: Cleaf(:) + real(dp), intent(IN) :: Croot(:) + integer(i4b), intent(IN) :: disturbance_interval(:,:) + real(dp), intent(IN), optional :: precip(:) + integer(i4b), intent(IN) :: it(:) + integer(i4b) :: P, g,i,j,ct, ct_highres + real(dp) :: limits(HEIGHT_BINS+1) + real(dp) :: ht, cmass_stem,densindiv, freq, freq_old + character(len=12) :: string1, string2 + character(len=9) :: fmt + integer(i4b) :: npatch_active ! number of active patches + integer(i4b) :: np, nc, i_height + real(dp) :: diam,basal, cump + real(dp) :: patch_crown_area(NPATCH2D), patch_crown_cover(NPATCH2D) + real(dp), allocatable :: height_list(:), height_list_weight(:) + real(dp) :: height_copy, weight_copy, Pwc, FAVD + integer(i4b), parameter :: HEIGHT_BINS_highres=100 ! bins for assessing height_max + real(dp), allocatable :: limits_highres(:), DENSINDIV_HIGHRES(:) + real(dp) :: tmp2 integer :: arg1 fmt = '(f5.1)' limits(1) = 0.0_dp - IF(.NOT.ALLOCATED(limits_highres)) ALLOCATE(limits_highres(HEIGHT_BINS_highres+1)) - IF(.NOT.ALLOCATED(DENSINDIV_HIGHRES)) ALLOCATE(DENSINDIV_HIGHRES(HEIGHT_BINS_highres)) + if(.not.allocated(limits_highres)) allocate(limits_highres(HEIGHT_BINS_highres+1)) + if(.not.allocated(DENSINDIV_HIGHRES)) allocate(DENSINDIV_HIGHRES(HEIGHT_BINS_highres)) limits_highres(1) = 0.0_dp - np = SIZE(Pop%pop_grid) + np = size(Pop%pop_grid) - DO g=1, np + do g=1, np npatch_active = NPATCH2D - IF (MAX_HEIGHT_SWITCH.EQ.1) THEN - ALLOCATE(height_list(NPATCH2D*NCOHORT_MAX)) - ALLOCATE(height_list_weight(NPATCH2D*NCOHORT_MAX)) - ENDIF + if (MAX_HEIGHT_SWITCH.eq.1) then + allocate(height_list(NPATCH2D*NCOHORT_MAX)) + allocate(height_list_weight(NPATCH2D*NCOHORT_MAX)) + endif ! IF(.NOT.ALLOCATED(MASK)) ALLOCATE(MASK(POP%pop_grid%npatch_active)) - DO i=1,HEIGHT_BINS - limits(i+1) = BIN_POWER**REAL(i,dp) - WRITE(string1,fmt) (limits(i)) - WRITE(string2,fmt) (limits(i+1)) - pop%pop_grid(g)%bin_labels(i) = 'Height_'//TRIM(ADJUSTL(string1))//'-'//TRIM(ADJUSTL(string2))//'m' + do i=1,HEIGHT_BINS + limits(i+1) = BIN_POWER**real(i,dp) + write(string1,fmt) (limits(i)) + write(string2,fmt) (limits(i+1)) + pop%pop_grid(g)%bin_labels(i) = 'Height_'//trim(adjustl(string1))//'-'//trim(adjustl(string2))//'m' pop%pop_grid(g)%cmass_stem_bin(i) = 0.0_dp pop%pop_grid(g)%densindiv_bin(i) = 0.0_dp pop%pop_grid(g)%cmass_stem_bin(i) = 0.0_dp - pop%pop_grid(g)%height_bin(i) = REAL(limits(i)+limits(i+1),dp)/2.0_dp - pop%pop_grid(g)%diameter_bin(i) = ( (REAL(limits(i),dp)/Kbiometric)**(3.0_dp/2.0_dp) + & - (REAL(limits(i+1),dp)/Kbiometric)**(3.0_dp/2.0_dp) ) / 2.0_dp - ENDDO + pop%pop_grid(g)%height_bin(i) = real(limits(i)+limits(i+1),dp)/2.0_dp + pop%pop_grid(g)%diameter_bin(i) = ( (real(limits(i),dp)/Kbiometric)**(3.0_dp/2.0_dp) + & + (real(limits(i+1),dp)/Kbiometric)**(3.0_dp/2.0_dp) ) / 2.0_dp + enddo - DO i=1,HEIGHT_BINS_highres - limits_highres(i+1) = REAL(i,dp) - ENDDO + do i=1,HEIGHT_BINS_highres + limits_highres(i+1) = real(i,dp) + enddo - IF (MAX_HEIGHT_SWITCH.EQ.1) THEN + if (MAX_HEIGHT_SWITCH.eq.1) then height_list = 0.0_dp height_list_weight = 0.0_dp - ENDIF + endif i_height = 0 pop%pop_grid(g)%cmass_sum_old = pop%pop_grid(g)%cmass_sum pop%pop_grid(g)%csapwood_sum_old = pop%pop_grid(g)%csapwood_sum @@ -1445,7 +1447,7 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) pop%pop_grid(g)%crown_volume = 0.0_dp densindiv_highres = 0.0_dp ! loop through patches - DO P = 1, npatch_active + do P = 1, npatch_active pop%pop_grid(g)%patch(p)%biomass = 0.0_dp pop%pop_grid(g)%patch(p)%sapwood = 0.0_dp pop%pop_grid(g)%patch(p)%sapwood_area = 0.0_dp @@ -1460,16 +1462,16 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) freq_old = pop%pop_grid(g)%freq_old(pop%pop_grid(g)%patch(p)%id) ! loop through cohorts - DO i = 1, pop%pop_grid(g)%patch(p)%layer(1)%ncohort + do i = 1, pop%pop_grid(g)%patch(p)%layer(1)%ncohort cmass_stem = pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%biomass densindiv = pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%density - IF ( PRESENT(precip) ) THEN - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal, precip(g)) - ELSE - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal ) + if ( present(precip) ) then + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal, precip(g)) + else + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal ) - ENDIF + endif pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%height = ht pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%diameter = diam @@ -1486,27 +1488,27 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) ! get bin ct = 1 - DO j=1,HEIGHT_BINS - IF (ht.GT.limits(j)) ct = j - ENDDO ! bins + do j=1,HEIGHT_BINS + if (ht.gt.limits(j)) ct = j + enddo ! bins ! get high res bin ct_highres = 1 - DO j=1,HEIGHT_BINS_highres - IF (ht.GT.limits_highres(j)) ct_highres = j - ENDDO ! bins + do j=1,HEIGHT_BINS_highres + if (ht.gt.limits_highres(j)) ct_highres = j + enddo ! bins pop%pop_grid(g)%patch(p)%layer(1)%biomass = pop%pop_grid(g)%patch(p)%layer(1)%biomass + cmass_stem pop%pop_grid(g)%patch(p)%layer(1)%density = pop%pop_grid(g)%patch(p)%layer(1)%density + densindiv - IF (diam*100.0_dp .GT. 1.0_dp) THEN + if (diam*100.0_dp .gt. 1.0_dp) then patch_crown_area(p) = patch_crown_area(p) + densindiv*PI*(diam*100.0_dp*0.1492_dp)**2 ! uses GC relationship pop%pop_grid(g)%crown_volume = pop%pop_grid(g)%crown_volume + & freq*densindiv*(4.0_dp/3.0_dp)*PI*(diam*100.0_dp*0.1492_dp)**2*(1.5_dp*(diam*100.0_dp*0.1492_dp)) ! assumes vertical radius = 1.5 * horizontal radius - ENDIF + endif - IF (diam*100.0_dp .GT. 5.0_dp) THEN + if (diam*100.0_dp .gt. 5.0_dp) then if (ALLOM_SWITCH.eq.1) then !! assumes crown radius (m) = 0.1492 * dbh (cm) (from G. Cook, pers. comm.) ! assumes vertical radius = 1.5 * horizontal radius @@ -1519,7 +1521,7 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) freq*densindiv*(4.0_dp/3.0_dp)*PI*1.5_dp*((k_allom1 * diam ** k_rp )/PI)**1.5_dp endif - ENDIF + endif pop%pop_grid(g)%patch(p)%sapwood = pop%pop_grid(g)%patch(p)%sapwood + & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%sapwood @@ -1540,12 +1542,12 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) pop%pop_grid(g)%height_mean = pop%pop_grid(g)%height_mean + ht*freq*densindiv pop%pop_grid(g)%basal_area = pop%pop_grid(g)%basal_area +basal*freq densindiv_highres(ct_highres) = densindiv_highres(ct_highres) + freq*densindiv - IF (MAX_HEIGHT_SWITCH.EQ.1) THEN + if (MAX_HEIGHT_SWITCH.eq.1) then i_height = i_height+1 height_list(i_height) = ht height_list_weight(i_height) = densindiv*freq - ENDIF - ENDDO ! cohorts + endif + enddo ! cohorts pop%pop_grid(g)%stress_mortality = pop%pop_grid(g)%stress_mortality + & freq*pop%pop_grid(g)%patch(p)%stress_mortality @@ -1580,30 +1582,30 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) pop%pop_grid(g)%area_growth = pop%pop_grid(g)%area_growth + & freq*pop%pop_grid(g)%patch(p)%area_growth - ENDDO ! patches + enddo ! patches - IF (INTERP_SWITCH==1.and.NDISTURB.eq.2) then + if (INTERP_SWITCH==1.and.NDISTURB.eq.2) then !CALL INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it) - CALL INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it(g),g) - ELSEIF (INTERP_SWITCH==1.and.NDISTURB.eq.1) then - CALL INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it(g),g) - ENDIF + call INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it(g),g) + elseif (INTERP_SWITCH==1.and.NDISTURB.eq.1) then + call INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it(g),g) + endif arg1 = NYEAR_HISTORY - IF (SMOOTH_SWITCH==1) THEN - IF (it(g).LE.NYEAR_HISTORY) THEN - CALL SMOOTH_FLUX(POP,g,it(g)) - ELSE - CALL SMOOTH_FLUX(POP,g,int(arg1,i4b)) - ENDIF - ENDIF + if (SMOOTH_SWITCH==1) then + if (it(g).le.NYEAR_HISTORY) then + call SMOOTH_FLUX(POP,g,it(g)) + else + call SMOOTH_FLUX(POP,g,int(arg1,i4b)) + endif + endif ! leaf area index in each cohort - DO P = 1, npatch_active + do P = 1, npatch_active freq = pop%pop_grid(g)%freq(pop%pop_grid(g)%patch(p)%id) ! loop through cohorts - DO i = 1, pop%pop_grid(g)%patch(p)%layer(1)%ncohort + do i = 1, pop%pop_grid(g)%patch(p)%layer(1)%ncohort cmass_stem = pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%biomass densindiv = pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%density basal=PI*(pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%diameter/2.0_dp)* & @@ -1618,10 +1620,10 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%Croot = Croot(g) * & min(pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%sapwood_area & /max(pop%pop_grid(g)%sapwood_area,1.0e-3_dp), 10.0_dp) - ENDDO ! cohorts + enddo ! cohorts pop%pop_grid(g)%patch(p)%LAI = sum(pop%pop_grid(g)%patch(p)%layer(1)% & cohort(1:pop%pop_grid(g)%patch(p)%layer(1)%ncohort)%LAI) - ENDDO ! patches + enddo ! patches ! PGap = (1-fcover) calculation @@ -1631,27 +1633,27 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) FAVD = 0.0_dp endif - DO P = 1, npatch_active + do P = 1, npatch_active freq = pop%pop_grid(g)%freq(pop%pop_grid(g)%patch(p)%id) nc = pop%pop_grid(g)%patch(p)%layer(1)%ncohort ! loop through cohorts - DO i = 1, nc + do i = 1, nc cmass_stem = pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%biomass densindiv = pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%density - IF ( PRESENT(precip) ) THEN - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal, precip(g)) - ELSE - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal ) - ENDIF + if ( present(precip) ) then + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal, precip(g)) + else + call GET_ALLOMETRY( ALLOM_SWITCH, cmass_stem, densindiv, ht, diam, basal ) + endif - IF (diam*100.0_dp .GT. 1.0_dp) THEN + if (diam*100.0_dp .gt. 1.0_dp) then if (ALLOM_SWITCH.eq.1) then !! assumes crown radius (m) = 0.1492 * dbh (cm) (from G. Cook, pers. comm.) pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area = densindiv*PI*(diam*100.0_dp*0.1492_dp)**2 - Pwc = EXP(-0.5_dp * pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%LAI/ & + Pwc = exp(-0.5_dp * pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%LAI/ & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area) pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area = & densindiv*PI*(diam*100.0_dp*0.1492_dp)**2*(1.0_dp-Pwc) @@ -1660,185 +1662,185 @@ SUBROUTINE GetDiagnostics(pop,LAI,Cleaf,Croot,disturbance_interval, it, precip) !! global allometry pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area = & densindiv*PI*(((k_allom1 * diam ** k_rp )/PI)**0.5_dp)**2 - Pwc = EXP(max(-0.5_dp * pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%LAI/ & + Pwc = exp(max(-0.5_dp * pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%LAI/ & max(pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area,1.e-3_dp),-20.0_dp)) pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area = & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area*(1.0_dp-Pwc) !*1.4142 endif - ELSE + else pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area = & 0.5_dp*pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%LAI !*1.4142 - ENDIF + endif pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area= & max(pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area,0.01_dp) pop%pop_grid(g)%crown_area = pop%pop_grid(g)%crown_area + & freq*pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area - IF (i.eq.1) THEN ! top cohort + if (i.eq.1) then ! top cohort pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%Pgap = & exp(-pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area) pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%frac_interception = & 1- exp(-pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area) - ELSE + else pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%Pgap = & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i-1)%Pgap* & exp(-pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%crown_area) pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%frac_interception = & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i-1)%Pgap - & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%Pgap - ENDIF + endif pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%respiration_scalar = & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%sapwood/shootfrac/CtoNw + & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%Cleaf/CtoNl + & pop%pop_grid(g)%patch(p)%layer(1)%cohort(i)%Croot/CtoNr - ENDDO ! cohorts + enddo ! cohorts - IF (nc>0) THEN + if (nc>0) then pop%pop_grid(g)%patch(p)%pgap = & pop%pop_grid(g)%patch(p)%layer(1)%cohort(nc)%Pgap - ELSE + else pop%pop_grid(g)%patch(p)%pgap = 1 - ENDIF + endif - ENDDO ! patches + enddo ! patches pop%pop_grid(g)%Kclump = max(pop%pop_grid(g)%crown_area/(0.5_dp*LAI(g)),0.1_dp) - pop%pop_grid(g)%crown_cover = 1.0_dp-EXP(-pop%pop_grid(g)%crown_area) + pop%pop_grid(g)%crown_cover = 1.0_dp-exp(-pop%pop_grid(g)%crown_area) pop%pop_grid(g)%height_mean = pop%pop_grid(g)%height_mean/max(pop%pop_grid(g)%densindiv,1.0e-5_dp) ! Height Diagnostics - IF (MAX_HEIGHT_SWITCH.EQ.0) THEN + if (MAX_HEIGHT_SWITCH.eq.0) then ! Set landscape maximum height to centre of bin with <5% of trees in a bin of higher size classes cump = 0.0_dp j = 1 - DO WHILE (cump.LT.0.95_dp) + do while (cump.lt.0.95_dp) cump = cump + pop%pop_grid(g)%densindiv_bin(j)/max(pop%pop_grid(g)%densindiv,1.0e-5_dp) pop%pop_grid(g)%height_max = pop%pop_grid(g)%height_bin(j) j = j+1 - ENDDO - ELSEIF (MAX_HEIGHT_SWITCH.EQ.1) THEN + enddo + elseif (MAX_HEIGHT_SWITCH.eq.1) then ! sort height list - DO i = 1, i_height -1 - DO j = i+1, i_height - IF (height_list(i).GT.height_list(j)) THEN + do i = 1, i_height -1 + do j = i+1, i_height + if (height_list(i).gt.height_list(j)) then height_copy = height_list(i) weight_copy = height_list_weight(i) height_list(i) = height_list(j) height_list_weight(i) = height_list_weight(j) height_list(j) = height_copy height_list_weight(j) = weight_copy - ENDIF - ENDDO - ENDDO ! end sort height list + endif + enddo + enddo ! end sort height list ! normailse height list weights - height_list_weight=height_list_weight/SUM(height_list_weight(1:i_height)) + height_list_weight=height_list_weight/sum(height_list_weight(1:i_height)) cump = 0.0_dp j = 1 - DO WHILE (cump.LT.0.95_dp) + do while (cump.lt.0.95_dp) cump = cump + height_list_weight(j) pop%pop_grid(g)%height_max = height_list(j) j = j+1 - ENDDO - DEALLOCATE(height_list) - DEALLOCATE(height_list_weight) + enddo + deallocate(height_list) + deallocate(height_list_weight) - ELSEIF (MAX_HEIGHT_SWITCH.EQ.2) THEN + elseif (MAX_HEIGHT_SWITCH.eq.2) then cump = 0.0_dp j = 1 - densindiv_highres= densindiv_highres/max(SUM(densindiv_highres),1.0e-5_dp) - DO WHILE ((cump.LT.0.95_dp).AND.(j.LE.HEIGHT_BINS_highres)) + densindiv_highres= densindiv_highres/max(sum(densindiv_highres),1.0e-5_dp) + do while ((cump.lt.0.95_dp).and.(j.le.HEIGHT_BINS_highres)) cump = cump + densindiv_highres(j) pop%pop_grid(g)%height_max = (limits_highres(j+1) + limits_highres(j))/2.0_dp j = j+1 - ENDDO - ENDIF + enddo + endif !deallocate(MASK) - ENDDO ! end loop over grid cells + enddo ! end loop over grid cells - END SUBROUTINE GetDiagnostics + end subroutine GetDiagnostics !******************************************************************************* - SUBROUTINE Patch_partial_disturb(pop,idisturb,intensity,frac_intensity1) + subroutine Patch_partial_disturb(pop,idisturb,intensity,frac_intensity1) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: idisturb - REAL(dp), INTENT(IN) :: intensity(:,:) - REAL(dp), INTENT(IN), OPTIONAL :: frac_intensity1(:) + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: idisturb + real(dp), intent(IN) :: intensity(:,:) + real(dp), intent(IN), optional :: frac_intensity1(:) - INTEGER(i4b) :: j, k, c, nc, np - INTEGER(i4b) :: ivec(NCOHORT_MAX) - REAL(dp) :: ht, diam - REAL(dp) :: Psurvival_s, Psurvival, char_height + integer(i4b) :: j, k, c, nc, np + integer(i4b) :: ivec(NCOHORT_MAX) + real(dp) :: ht, diam + real(dp) :: Psurvival_s, Psurvival, char_height - np = SIZE(Pop%pop_grid) + np = size(Pop%pop_grid) ! Kills a fraction of biomass in patch when prescribed disturbance interval is reached - DO j=1,np - DO k=1,NPATCH + do j=1,np + do k=1,NPATCH pop%pop_grid(j)%patch(k)%fire_mortality = 0.0_dp - IF (((pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).NE.0).AND. & - (pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).EQ.pop%pop_grid(j)%patch(k)%age(idisturb))).OR. & - (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).EQ.pop%pop_grid(j)%patch(k)%age(idisturb))) THEN + if (((pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).ne.0).and. & + (pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).eq.pop%pop_grid(j)%patch(k)%age(idisturb))).or. & + (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).eq.pop%pop_grid(j)%patch(k)%age(idisturb))) then ! loop through cohorts ivec = 0 nc = 0 - DO c = 1, pop%pop_grid(j)%patch(k)%layer(1)%ncohort + do c = 1, pop%pop_grid(j)%patch(k)%layer(1)%ncohort ! kill fraction of each cohort - char_height = 3.7_dp*(1.0_dp-EXP(-0.19_dp*Intensity(j,1))) + char_height = 3.7_dp*(1.0_dp-exp(-0.19_dp*Intensity(j,1))) ht = pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%height diam = pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%diameter*100.0_dp ! diameter in cm - IF ((ht.GT.8.5_dp).AND.(ht.GT.char_height)) THEN + if ((ht.gt.8.5_dp).and.(ht.gt.char_height)) then Psurvival_s =(-0.0011_dp*Intensity(j,1) -0.00002_dp)*ht & +(0.0075_dp*Intensity(j,1)+1.0_dp) - ELSEIF ((ht.LE.8.5_dp).AND.(ht.GT.char_height)) THEN + elseif ((ht.le.8.5_dp).and.(ht.gt.char_height)) then Psurvival_s =(0.0178_dp*Intensity(j,1) + 0.0144_dp)*ht & + (-0.1174_dp*Intensity(j,1)+0.9158_dp) - ELSE + else Psurvival_s = 0.0_dp - ENDIF - Psurvival_s = MIN(Psurvival_s,1.0_dp) - Psurvival_s = MAX(Psurvival_s,1.0e-3_dp) + endif + Psurvival_s = min(Psurvival_s,1.0_dp) + Psurvival_s = max(Psurvival_s,1.0e-3_dp) Psurvival = Psurvival_s - IF (PRESENT(frac_intensity1)) THEN - char_height = 3.7_dp*(1.0_dp-EXP(-0.19_dp*Intensity(j,2))) + if (present(frac_intensity1)) then + char_height = 3.7_dp*(1.0_dp-exp(-0.19_dp*Intensity(j,2))) ht = pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%height - IF ((ht.GT.8.5_dp).AND.(ht.GT.char_height)) THEN + if ((ht.gt.8.5_dp).and.(ht.gt.char_height)) then Psurvival_s =(-0.0011_dp*Intensity(j,2) -0.00002_dp)*ht & +(0.0075_dp*Intensity(j,2)+1.0_dp) - ELSEIF ((ht.LE.8.5_dp).AND.(ht.GT.char_height)) THEN + elseif ((ht.le.8.5_dp).and.(ht.gt.char_height)) then Psurvival_s =(0.0178_dp*Intensity(j,2) + 0.0144_dp)*ht & + (-0.1174_dp*Intensity(j,2)+0.9158_dp) - ELSE + else Psurvival_s = 0.0_dp - ENDIF - Psurvival_s = MIN(Psurvival_s,1.0_dp) - Psurvival_s = MAX(Psurvival_s,1.0e-3_dp) + endif + Psurvival_s = min(Psurvival_s,1.0_dp) + Psurvival_s = max(Psurvival_s,1.0e-3_dp) Psurvival = Psurvival_s*(1.0_dp-frac_intensity1(j)) + Psurvival*frac_intensity1(j) - ENDIF + endif ! Psurvival = 1.0_dp ! test pop%pop_grid(j)%patch(k)%fire_mortality = pop%pop_grid(j)%patch(k)%fire_mortality + & (1.0_dp-Psurvival)*pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%biomass @@ -1854,7 +1856,7 @@ SUBROUTINE Patch_partial_disturb(pop,idisturb,intensity,frac_intensity1) Psurvival*pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%heartwood pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%density = & Psurvival*pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%density - IF (pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density.LT.DENSINDIV_MIN) THEN + if (pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density.lt.DENSINDIV_MIN) then ! remove cohort pop%pop_grid(j)%patch(k)%fire_mortality = pop%pop_grid(j)%patch(k)%fire_mortality + & pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%biomass @@ -1869,15 +1871,15 @@ SUBROUTINE Patch_partial_disturb(pop,idisturb,intensity,frac_intensity1) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%sapwood = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%sapwood_area = 0.0_dp - ELSE + else pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%id = 1 nc = nc+1 ivec(nc)=c - ENDIF - ENDDO + endif + enddo ! SHUFFLE if necessary to remove zero-density cohorts - IF (nc.LT.pop%pop_grid(j)%patch(k)%Layer(1)%ncohort) THEN + if (nc.lt.pop%pop_grid(j)%patch(k)%Layer(1)%ncohort) then pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)=pop%pop_grid(j)%patch(k)%Layer(1)%cohort(ivec(1:nc)) pop%pop_grid(j)%patch(k)%Layer(1)%ncohort = nc @@ -1887,47 +1889,47 @@ SUBROUTINE Patch_partial_disturb(pop,idisturb,intensity,frac_intensity1) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%sapwood = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%sapwood_area = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%heartwood = 0.0_dp - ENDIF + endif pop%pop_grid(j)%patch(k)%age(idisturb) = 0 pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb) = 0 - ENDIF + endif - ENDDO - ENDDO + enddo + enddo - END SUBROUTINE Patch_partial_disturb + end subroutine Patch_partial_disturb !******************************************************************************* - SUBROUTINE Patch_partial_disturb2(pop,idisturb) + subroutine Patch_partial_disturb2(pop,idisturb) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: idisturb + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: idisturb - INTEGER(i4b) :: j, k, c, nc, np - INTEGER(i4b) :: ivec(NCOHORT_MAX) - REAL(dp) :: Psurvival, frac_mort, Pmort + integer(i4b) :: j, k, c, nc, np + integer(i4b) :: ivec(NCOHORT_MAX) + real(dp) :: Psurvival, frac_mort, Pmort - np = SIZE(Pop%pop_grid) + np = size(Pop%pop_grid) ! Kills a fraction (80%) biomass in patch when prescribed disturbance interval is reached - DO j=1,np - DO k=1,NPATCH2D + do j=1,np + do k=1,NPATCH2D pop%pop_grid(j)%patch(k)%cat_mortality = 0.0_dp ! Layer biomass (summed over cohorts) nc = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort - pop%pop_grid(j)%patch(k)%Layer(1)%biomass = SUM(pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)%biomass) + pop%pop_grid(j)%patch(k)%Layer(1)%biomass = sum(pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)%biomass) - IF (((pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).NE.0).AND. & - (pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).EQ.pop%pop_grid(j)%patch(k)%age(idisturb))).OR. & - (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).EQ.pop%pop_grid(j)%patch(k)%age(idisturb))) THEN + if (((pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).ne.0).and. & + (pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).eq.pop%pop_grid(j)%patch(k)%age(idisturb))).or. & + (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).eq.pop%pop_grid(j)%patch(k)%age(idisturb))) then ! loop through cohorts @@ -1935,7 +1937,7 @@ SUBROUTINE Patch_partial_disturb2(pop,idisturb) nc = 0 frac_mort = 0.0_dp pop%pop_grid(j)%patch(k)%cat_mortality = 0.0_dp - DO c = 1, pop%pop_grid(j)%patch(k)%layer(1)%ncohort + do c = 1, pop%pop_grid(j)%patch(k)%layer(1)%ncohort ! kill fraction of each cohort, up to 80% of patch biomass if (pop%pop_grid(j)%patch(k)%cat_mortality < 0.8_dp * pop%pop_grid(j)%patch(k)%Layer(1)%biomass ) then Pmort = min( (0.8_dp*pop%pop_grid(j)%patch(k)%Layer(1)%biomass-pop%pop_grid(j)%patch(k)%fire_mortality) & @@ -1959,7 +1961,7 @@ SUBROUTINE Patch_partial_disturb2(pop,idisturb) Psurvival*pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%heartwood pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%density = & Psurvival*pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%density - IF (pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density.LT.DENSINDIV_MIN) THEN + if (pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%density.lt.DENSINDIV_MIN) then ! remove cohort pop%pop_grid(j)%patch(k)%cat_mortality = pop%pop_grid(j)%patch(k)%cat_mortality + & pop%pop_grid(j)%patch(k)%layer(1)%cohort(c)%biomass @@ -1974,15 +1976,15 @@ SUBROUTINE Patch_partial_disturb2(pop,idisturb) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%sapwood = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%sapwood_area = 0.0_dp - ELSE + else pop%pop_grid(j)%patch(k)%Layer(1)%cohort(c)%id = 1 nc = nc+1 ivec(nc)=c - ENDIF - ENDDO + endif + enddo ! SHUFFLE if necessary to remove zero-density cohorts - IF (nc.LT.pop%pop_grid(j)%patch(k)%Layer(1)%ncohort) THEN + if (nc.lt.pop%pop_grid(j)%patch(k)%Layer(1)%ncohort) then pop%pop_grid(j)%patch(k)%Layer(1)%cohort(1:nc)=pop%pop_grid(j)%patch(k)%Layer(1)%cohort(ivec(1:nc)) pop%pop_grid(j)%patch(k)%Layer(1)%ncohort = nc @@ -1992,51 +1994,51 @@ SUBROUTINE Patch_partial_disturb2(pop,idisturb) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%sapwood = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%sapwood_area = 0.0_dp pop%pop_grid(j)%patch(k)%Layer(1)%cohort(nc+1:NCOHORT_MAX)%heartwood = 0.0_dp - ENDIF + endif pop%pop_grid(j)%patch(k)%age(idisturb) = 0 pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb) = 0 - ENDIF + endif - ENDDO - ENDDO + enddo + enddo - END SUBROUTINE Patch_partial_disturb2 + end subroutine Patch_partial_disturb2 !******************************************************************************* - SUBROUTINE Patch_disturb(pop,idisturb,precip) - IMPLICIT NONE + subroutine Patch_disturb(pop,idisturb,precip) + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - REAL(dp), INTENT(IN), OPTIONAL :: precip(:) + type(POP_TYPE), intent(INOUT) :: POP + real(dp), intent(IN), optional :: precip(:) !INTEGER(i4b), INTENT(IN) :: it(:),idisturb - INTEGER(i4b), INTENT(IN) :: idisturb - INTEGER(i4b) :: j, k, np, nc + integer(i4b), intent(IN) :: idisturb + integer(i4b) :: j, k, np, nc - np = SIZE(Pop%pop_grid) + np = size(Pop%pop_grid) ! Kills all biomass in patch when prescribed disturbance interval is reached ! Should be called after accounting for this year - DO j=1,np - DO k=1,NPATCH2D + do j=1,np + do k=1,NPATCH2D pop%pop_grid(j)%patch(k)%cat_mortality = 0.0_dp - IF (pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).NE.0) THEN - IF ((pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).EQ.pop%pop_grid(j)%patch(k)%age(idisturb)).or. & - (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).EQ.pop%pop_grid(j)%patch(k)%age(idisturb)) ) THEN + if (pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).ne.0) then + if ((pop%pop_grid(j)%patch(k)%first_disturbance_year(idisturb).eq.pop%pop_grid(j)%patch(k)%age(idisturb)).or. & + (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).eq.pop%pop_grid(j)%patch(k)%age(idisturb)) ) then ! kill entire layer nc = pop%pop_grid(j)%patch(k)%layer(1)%ncohort ! pop%pop_grid(j)%patch(k)%fire_mortality = SUM(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%biomass) - pop%pop_grid(j)%patch(k)%cat_mortality = SUM(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%biomass) + pop%pop_grid(j)%patch(k)%cat_mortality = sum(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%biomass) pop%pop_grid(j)%patch(k)%sapwood_loss = pop%pop_grid(j)%patch(k)%sapwood_loss + & - SUM(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood) + sum(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood) pop%pop_grid(j)%patch(k)%sapwood_area_loss = pop%pop_grid(j)%patch(k)%sapwood_area_loss + & - SUM(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood_area) + sum(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood_area) pop%pop_grid(j)%patch(k)%layer(1:NLayer)%ncohort = 0 pop%pop_grid(j)%patch(k)%layer(1:NLayer)%biomass = 0.0_dp pop%pop_grid(j)%patch(k)%layer(1:NLayer)%density = 0.0_dp @@ -2063,21 +2065,21 @@ SUBROUTINE Patch_disturb(pop,idisturb,precip) pop%pop_grid(j)%patch(k)%area_growth = 0.0_dp pop%pop_grid(j)%patch(k)%pgap = 1.0_dp ! understorey recruitment - IF (PRESENT(precip)) THEN - CALL layer_recruitment_single_patch(pop,k,j,precip) - ELSE - CALL layer_recruitment_single_patch(pop,k,j) - - ENDIF - ENDIF - ELSEIF (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).EQ.pop%pop_grid(j)%patch(k)%age(idisturb)) THEN + if (present(precip)) then + call layer_recruitment_single_patch(pop,k,j,precip) + else + call layer_recruitment_single_patch(pop,k,j) + + endif + endif + elseif (pop%pop_grid(j)%patch(k)%disturbance_interval(idisturb).eq.pop%pop_grid(j)%patch(k)%age(idisturb)) then ! kill entire layer nc = pop%pop_grid(j)%patch(k)%layer(1)%ncohort pop%pop_grid(j)%patch(k)%sapwood_loss = pop%pop_grid(j)%patch(k)%sapwood_loss + & - SUM(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood) + sum(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood) pop%pop_grid(j)%patch(k)%sapwood_area_loss = pop%pop_grid(j)%patch(k)%sapwood_area_loss + & - SUM(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood_area) - pop%pop_grid(j)%patch(k)%cat_mortality = SUM(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%biomass) + sum(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%sapwood_area) + pop%pop_grid(j)%patch(k)%cat_mortality = sum(pop%pop_grid(j)%patch(k)%layer(1)%cohort(1:nc)%biomass) pop%pop_grid(j)%patch(k)%layer(1:NLayer)%ncohort = 0 pop%pop_grid(j)%patch(k)%layer(1:NLayer)%biomass = 0.0_dp pop%pop_grid(j)%patch(k)%layer(1:NLayer)%density = 0.0_dp @@ -2104,55 +2106,55 @@ SUBROUTINE Patch_disturb(pop,idisturb,precip) pop%pop_grid(j)%patch(k)%area_growth = 0.0_dp pop%pop_grid(j)%patch(k)%pgap = 1.0_dp ! understorey recruitment - IF (PRESENT(precip)) THEN - CALL layer_recruitment_single_patch(pop,k,j,precip) - ELSE - CALL layer_recruitment_single_patch(pop,k,j) + if (present(precip)) then + call layer_recruitment_single_patch(pop,k,j,precip) + else + call layer_recruitment_single_patch(pop,k,j) - ENDIF - ENDIF + endif + endif - ENDDO + enddo - ENDDO + enddo - END SUBROUTINE Patch_disturb + end subroutine Patch_disturb !******************************************************************************* - SUBROUTINE layer_recruitment(pop,precip) + subroutine layer_recruitment(pop,precip) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - REAL(dp), INTENT(IN), OPTIONAL :: precip(:) + type(POP_TYPE), intent(INOUT) :: POP + real(dp), intent(IN), optional :: precip(:) - REAL(dp) :: f, mu, densindiv, cmass, ht - INTEGER(i4b) :: j, k, ncohort, np - REAL(dp) :: diam, basal + real(dp) :: f, mu, densindiv, cmass, ht + integer(i4b) :: j, k, ncohort, np + real(dp) :: diam, basal - np = SIZE(Pop%pop_grid) + np = size(Pop%pop_grid) - DO j=1,np - DO k=1,NPATCH2D - IF (RECRUIT_SWITCH==0) THEN - pop%pop_grid(j)%patch(k)%factor_recruit = EXP(-0.6_dp*((pop%pop_grid(j)%patch(k)%Layer(1)%biomass)**(0.6667_dp))) - ELSEIF (RECRUIT_SWITCH==1) THEN + do j=1,np + do k=1,NPATCH2D + if (RECRUIT_SWITCH==0) then + pop%pop_grid(j)%patch(k)%factor_recruit = exp(-0.6_dp*((pop%pop_grid(j)%patch(k)%Layer(1)%biomass)**(0.6667_dp))) + elseif (RECRUIT_SWITCH==1) then pop%pop_grid(j)%patch(k)%factor_recruit = max(pop%pop_grid(j)%patch(k)%pgap,1.0e-3_dp) - ENDIF + endif f = pop%pop_grid(j)%patch(k)%factor_recruit - mu=EXP(max(FULTON_ALPHA*(1.0_dp-2.0_dp*THETA_recruit/ & - (f+1.0_dp-SQRT((f+1.0_dp)*(f+1.0_dp)-4.0_dp*THETA_recruit*f))), & + mu=exp(max(FULTON_ALPHA*(1.0_dp-2.0_dp*THETA_recruit/ & + (f+1.0_dp-sqrt((f+1.0_dp)*(f+1.0_dp)-4.0_dp*THETA_recruit*f))), & -50.0_dp)) densindiv=DENSINDIV_MAX*mu + pop%pop_grid(j)%patch(k)%fire_top_kill_density cmass=CMASS_STEM_INIT*densindiv/DENSINDIV_MAX !write(5599,*), pop%pop_grid(j)%patch(k)%fire_top_kill_density, densindiv, pop%pop_grid(j)%patch(k)%Layer(1)%ncohort !COMMLN below: should not be cohort +1 or .LE. ! - IF (cmass>EPS*10.0_dp .AND. densindiv>DENSINDIV_MIN .AND. & - (pop%pop_grid(j)%patch(k)%Layer(1)%ncohort+1).LT.NCOHORT_MAX) THEN + if (cmass>EPS*10.0_dp .and. densindiv>DENSINDIV_MIN .and. & + (pop%pop_grid(j)%patch(k)%Layer(1)%ncohort+1).lt.NCOHORT_MAX) then ! create a new cohort pop%pop_grid(j)%patch(k)%Layer(1)%ncohort = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + 1 @@ -2161,54 +2163,54 @@ SUBROUTINE layer_recruitment(pop,precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(ncohort)%density = densindiv pop%pop_grid(j)%patch(k)%Layer(1)%cohort(ncohort)%sapwood = cmass - IF ( PRESENT(precip) ) THEN - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal, precip(j)) - ELSE - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal ) - ENDIF + if ( present(precip) ) then + call GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal, precip(j)) + else + call GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal ) + endif pop%pop_grid(j)%patch(k)%layer(1)%cohort(ncohort)%height = ht pop%pop_grid(j)%patch(k)%layer(1)%cohort(ncohort)%diameter = diam - ENDIF + endif pop%pop_grid(j)%patch(k)%fire_top_kill_density = 0.0_dp - ENDDO - ENDDO + enddo + enddo - END SUBROUTINE layer_recruitment + end subroutine layer_recruitment !******************************************************************************* - SUBROUTINE layer_recruitment_single_patch(pop, index, grid_index,precip) + subroutine layer_recruitment_single_patch(pop, index, grid_index,precip) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - REAL(dp), INTENT(IN), OPTIONAL :: precip(:) - INTEGER(i4b), INTENT(IN) :: index, grid_index + type(POP_TYPE), intent(INOUT) :: POP + real(dp), intent(IN), optional :: precip(:) + integer(i4b), intent(IN) :: index, grid_index - REAL(dp) :: f, mu, densindiv, cmass, ht - INTEGER(i4b) :: j, k, ncohort, np - REAL(dp) :: diam,basal + real(dp) :: f, mu, densindiv, cmass, ht + integer(i4b) :: j, k, ncohort, np + real(dp) :: diam,basal - np = SIZE(Pop%pop_grid) - DO j=grid_index,grid_index - DO k=index,index - IF (RECRUIT_SWITCH==0) THEN - pop%pop_grid(j)%patch(k)%factor_recruit = EXP(-0.6_dp*((pop%pop_grid(j)%patch(k)%Layer(1)%biomass)**(0.6667_dp))) - ELSEIF (RECRUIT_SWITCH==1) THEN + np = size(Pop%pop_grid) + do j=grid_index,grid_index + do k=index,index + if (RECRUIT_SWITCH==0) then + pop%pop_grid(j)%patch(k)%factor_recruit = exp(-0.6_dp*((pop%pop_grid(j)%patch(k)%Layer(1)%biomass)**(0.6667_dp))) + elseif (RECRUIT_SWITCH==1) then !pop%pop_grid(j)%patch(k)%factor_recruit = pop%pop_grid(j)%patch(k)%pgap pop%pop_grid(j)%patch(k)%factor_recruit = 1 - ENDIF + endif f = pop%pop_grid(j)%patch(k)%factor_recruit - mu=EXP(FULTON_ALPHA*(1.0_dp-2.0_dp*THETA_recruit/(f+1.0_dp-SQRT((f+1.0_dp)*(f+1.0_dp)-4.0_dp*THETA_recruit*f)))) + mu=exp(FULTON_ALPHA*(1.0_dp-2.0_dp*THETA_recruit/(f+1.0_dp-sqrt((f+1.0_dp)*(f+1.0_dp)-4.0_dp*THETA_recruit*f)))) densindiv=DENSINDIV_MAX*mu cmass=CMASS_STEM_INIT*densindiv/DENSINDIV_MAX - IF (cmass>EPS*10.0_dp .AND. densindiv>DENSINDIV_MIN .AND. & - (pop%pop_grid(j)%patch(k)%Layer(1)%ncohort+1).LT.NCOHORT_MAX) THEN + if (cmass>EPS*10.0_dp .and. densindiv>DENSINDIV_MIN .and. & + (pop%pop_grid(j)%patch(k)%Layer(1)%ncohort+1).lt.NCOHORT_MAX) then ! create a new cohort pop%pop_grid(j)%patch(k)%Layer(1)%ncohort = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort + 1 ncohort = pop%pop_grid(j)%patch(k)%Layer(1)%ncohort @@ -2216,23 +2218,23 @@ SUBROUTINE layer_recruitment_single_patch(pop, index, grid_index,precip) pop%pop_grid(j)%patch(k)%Layer(1)%cohort(ncohort)%density = densindiv pop%pop_grid(j)%patch(k)%Layer(1)%cohort(ncohort)%sapwood = cmass - IF ( PRESENT(precip) ) THEN - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal, precip(j)) - ELSE - CALL GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal ) - ENDIF + if ( present(precip) ) then + call GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal, precip(j)) + else + call GET_ALLOMETRY( ALLOM_SWITCH, cmass, densindiv, ht, diam, basal ) + endif pop%pop_grid(j)%patch(k)%layer(1)%cohort(ncohort)%height = ht pop%pop_grid(j)%patch(k)%layer(1)%cohort(ncohort)%diameter = diam - ENDIF + endif - ENDDO - ENDDO + enddo + enddo - END SUBROUTINE layer_recruitment_single_patch + end subroutine layer_recruitment_single_patch !******************************************************************************* ! Exponential distribution @@ -2242,20 +2244,20 @@ END SUBROUTINE layer_recruitment_single_patch ! Use to determine average age (x, years) of patches with a given random disturbance ! frequency lambda (disturbances per year) - REAL(dp) FUNCTION Exponential(lambda, x) + real(dp) function Exponential(lambda, x) - IMPLICIT NONE + implicit none - INTEGER(i4b), INTENT(IN) :: x - REAL(dp), INTENT(IN) :: lambda + integer(i4b), intent(IN) :: x + real(dp), intent(IN) :: lambda - IF (x .LT. 0.0_dp) THEN ! Shouldn't happen but ... + if (x .lt. 0.0_dp) then ! Shouldn't happen but ... Exponential = 0.0_dp - ELSE - Exponential = lambda*EXP(-lambda*x) - ENDIF + else + Exponential = lambda*exp(-lambda*x) + endif - END FUNCTION Exponential + end function Exponential !******************************************************************************* ! Exponential distribution @@ -2265,107 +2267,107 @@ END FUNCTION Exponential ! Use to determine average age (x, years) of patches with a given random disturbance ! frequency lambda (disturbances per year) - REAL(dp) FUNCTION REALExponential(lambda, x) + real(dp) function REALExponential(lambda, x) - IMPLICIT NONE + implicit none - REAL(dp), INTENT(IN) :: x - REAL(dp), INTENT(IN) :: lambda + real(dp), intent(IN) :: x + real(dp), intent(IN) :: lambda - IF (x .LT. 0.0_dp) THEN ! Shouldn't happen but ... + if (x .lt. 0.0_dp) then ! Shouldn't happen but ... REALExponential = 0.0_dp - ELSE - REALExponential = lambda*EXP(-lambda*x) - ENDIF + else + REALExponential = lambda*exp(-lambda*x) + endif - END FUNCTION REALExponential + end function REALExponential !******************************************************************************* - REAL(dp) FUNCTION CumExponential(lambda, x) + real(dp) function CumExponential(lambda, x) - IMPLICIT NONE + implicit none - REAL(dp), INTENT(IN) :: x - REAL(dp), INTENT(IN) :: lambda + real(dp), intent(IN) :: x + real(dp), intent(IN) :: lambda - IF (x .LT. 0.0_dp) THEN ! Shouldn't happen but ... + if (x .lt. 0.0_dp) then ! Shouldn't happen but ... CumExponential = 0.0_dp - ELSE - CumExponential = 1.0_dp - EXP(-lambda*x) - ENDIF + else + CumExponential = 1.0_dp - exp(-lambda*x) + endif - END FUNCTION CumExponential + end function CumExponential !******************************************************************************* - REAL(dp) FUNCTION Factorial(n) + real(dp) function Factorial(n) - IMPLICIT NONE + implicit none - INTEGER, INTENT(IN) :: n + integer, intent(IN) :: n - INTEGER :: i - REAL(dp) :: Ans + integer :: i + real(dp) :: Ans Ans = 1.0_dp - DO i = 1, n - Ans = Ans * REAL(i,dp) - END DO + do i = 1, n + Ans = Ans * real(i,dp) + end do Factorial = Ans - END FUNCTION Factorial + end function Factorial !******************************************************************************* ! ALLOMETRY !******************************************************************************* - SUBROUTINE GET_ALLOMETRY( ALLOM_SWITCH, biomass, density, ht, diam, basal, precip ) + subroutine GET_ALLOMETRY( ALLOM_SWITCH, biomass, density, ht, diam, basal, precip ) #ifdef __MPI__ use mpi, only: MPI_Abort #endif - IMPLICIT NONE + implicit none - INTEGER(i4b), INTENT(IN) :: ALLOM_SWITCH - REAL(dp), INTENT(IN) :: biomass - REAL(dp), INTENT(IN) :: density - REAL(dp), INTENT(IN), OPTIONAL :: precip - REAL(dp), INTENT(OUT):: ht, diam, basal + integer(i4b), intent(IN) :: ALLOM_SWITCH + real(dp), intent(IN) :: biomass + real(dp), intent(IN) :: density + real(dp), intent(IN), optional :: precip + real(dp), intent(OUT):: ht, diam, basal #ifdef __MPI__ integer :: ierr #endif ! Standard Allometry - IF (ALLOM_SWITCH.EQ.0) THEN + if (ALLOM_SWITCH.eq.0) then ht = (Kbiometric**(3.0_dp/4.0_dp))*(4.0_dp*biomass/(max(density,1.0e-5_dp)*WD*PI))**(1.0_dp/4.0_dp) diam = (ht/Kbiometric)**(1.5_dp) basal= PI * (diam/2.0_dp) * (diam/2.0_dp) * density * 1.0e4_dp ! Top-End Allometry following G.Cook - ELSEIF (ALLOM_SWITCH.EQ.1.AND.PRESENT(precip)) THEN + elseif (ALLOM_SWITCH.eq.1.and.present(precip)) then ht =GetHeight(precip,biomass,density) - CALL Allometry(ht,biomass,density,diam,basal) + call Allometry(ht,biomass,density,diam,basal) ! Allometry following Williams 2005, Model 5b - ELSEIF ( ALLOM_SWITCH.EQ.2 ) THEN - CALL Williams_Allometry(biomass,density,ht,diam,basal) + elseif ( ALLOM_SWITCH.eq.2 ) then + call Williams_Allometry(biomass,density,ht,diam,basal) - ELSE - WRITE(*,*)"Invalid Allometry settings in POP!" - WRITE(*,*)"ALLOM_SWITCH = ",ALLOM_SWITCH - WRITE(*,*)"Precip present = ",PRESENT(precip) + else + write(*,*)"Invalid Allometry settings in POP!" + write(*,*)"ALLOM_SWITCH = ",ALLOM_SWITCH + write(*,*)"Precip present = ",present(precip) #ifdef __MPI__ call MPI_Abort(0, 85, ierr) ! Do not know comm nor rank here #else stop 85 #endif - ENDIF + endif - END SUBROUTINE GET_ALLOMETRY + end subroutine GET_ALLOMETRY !******************************************************************************* ! TOP-END ALLOMETRY STARTS HERE !******************************************************************************* @@ -2381,26 +2383,26 @@ END SUBROUTINE GET_ALLOMETRY ! biomass = tree stem C biomass across patch (kgC/m2) ! density = tree density (indiv/m2) - REAL(dp) FUNCTION GetHeight(precip,biomass,density) + real(dp) function GetHeight(precip,biomass,density) - IMPLICIT NONE + implicit none - REAL(dp), INTENT(IN) :: precip - REAL(dp), INTENT(IN) :: biomass - REAL(dp), INTENT(IN) :: density + real(dp), intent(IN) :: precip + real(dp), intent(IN) :: biomass + real(dp), intent(IN) :: density - REAL(dp),PARAMETER:: THETA=0.99_dp ! Shape parameter, should be slightly <1 - REAL(dp),PARAMETER:: HMIN=0.001_dp ! min bound for tree height - REAL(dp),PARAMETER:: HMAX=100.0_dp ! max bound for tree height - REAL(dp),PARAMETER:: EPS=0.01_dp ! precision of the root - INTEGER(i4b), PARAMETER :: MAXTRIES=25 + real(dp),parameter:: THETA=0.99_dp ! Shape parameter, should be slightly <1 + real(dp),parameter:: HMIN=0.001_dp ! min bound for tree height + real(dp),parameter:: HMAX=100.0_dp ! max bound for tree height + real(dp),parameter:: EPS=0.01_dp ! precision of the root + integer(i4b), parameter :: MAXTRIES=25 - REAL(dp) :: alpha,beta,delta,rh,st,x1,x2,rtbis,dx,fmid,xmid,lhs,rhs - INTEGER(i4b) :: b + real(dp) :: alpha,beta,delta,rh,st,x1,x2,rtbis,dx,fmid,xmid,lhs,rhs + integer(i4b) :: b - alpha=4.05_dp*EXP(-0.00032_dp*precip) - beta=5.4_dp*EXP(0.0014_dp*precip) - delta=2.0_dp*SQRT(biomass/density/WD/PI) + alpha=4.05_dp*exp(-0.00032_dp*precip) + beta=5.4_dp*exp(0.0014_dp*precip) + delta=2.0_dp*sqrt(biomass/density/WD/PI) x1=HMIN x2=HMAX @@ -2409,7 +2411,7 @@ REAL(dp) FUNCTION GetHeight(precip,biomass,density) b=0 fmid=EPS+1.0_dp - DO WHILE (ABS(dx).GT.EPS.AND.b.LE.MAXTRIES) + do while (abs(dx).gt.EPS.and.b.le.MAXTRIES) b=b+1 dx=dx*0.5_dp xmid=rtbis+dx @@ -2418,45 +2420,45 @@ REAL(dp) FUNCTION GetHeight(precip,biomass,density) ! LHS-RHS should increase with increasing height lhs=xmid - rh=1.0_dp/SQRT(xmid) + rh=1.0_dp/sqrt(xmid) st=alpha+beta*delta*rh+100.0_dp*delta*rh rhs=1.0_dp/2.0_dp/THETA* & - (st-SQRT(st*st-400.0_dp*THETA*alpha*delta*rh- & + (st-sqrt(st*st-400.0_dp*THETA*alpha*delta*rh- & 400.0_dp*THETA*beta*delta*delta/xmid)) fmid=lhs-rhs - IF (fmid.LT.0.0_dp) rtbis=xmid + if (fmid.lt.0.0_dp) rtbis=xmid - ENDDO + enddo GetHeight=xmid - END FUNCTION GetHeight + end function GetHeight !******************************************************************************* - SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) - IMPLICIT NONE + subroutine INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) - INTEGER(i4b), INTENT(IN) :: it,g + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: disturbance_interval(:,:) + integer(i4b), intent(IN) :: it,g - INTEGER(i4b) :: nage,iage, i_min, i_max - INTEGER(i4b) :: i_min_growth, i_max_growth - REAL(dp) :: disturbance_freq, tmp_min, tmp_max, tmp1_min, tmp1_max, tmp_array(NPATCH2D) - REAL(dp) :: tmp2_min, tmp2_max - REAL(dp) :: tmp3_min, tmp3_max - REAL(dp) :: tmp4_min, tmp4_max - LOGICAL :: MASK(NPATCH2D) - INTEGER(i4b) :: age_min, age_max - INTEGER(i4b) :: age_min_growth, age_max_growth - INTEGER(i4b), ALLOCATABLE :: age(:) - REAL(dp), ALLOCATABLE ::cmass_age(:), stress_mort_age(:), crowd_mort_age(:) - REAL(dp), ALLOCATABLE ::csapwood_age(:), sapwood_area_age(:), growth_age(:) - REAL(dp), ALLOCATABLE ::freq_age(:) + integer(i4b) :: nage,iage, i_min, i_max + integer(i4b) :: i_min_growth, i_max_growth + real(dp) :: disturbance_freq, tmp_min, tmp_max, tmp1_min, tmp1_max, tmp_array(NPATCH2D) + real(dp) :: tmp2_min, tmp2_max + real(dp) :: tmp3_min, tmp3_max + real(dp) :: tmp4_min, tmp4_max + logical :: MASK(NPATCH2D) + integer(i4b) :: age_min, age_max + integer(i4b) :: age_min_growth, age_max_growth + integer(i4b), allocatable :: age(:) + real(dp), allocatable ::cmass_age(:), stress_mort_age(:), crowd_mort_age(:) + real(dp), allocatable ::csapwood_age(:), sapwood_area_age(:), growth_age(:) + real(dp), allocatable ::freq_age(:) ! get interpolated biomass,sapwood, stress mortality, crowding mortality, disturbance mortality POP%pop_grid(g)%cmass_sum= 0.0_dp @@ -2469,27 +2471,27 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) nage = min(POP%pop_grid(g)%patch(1)%disturbance_interval(1),it)+1 ! maximum age !nage = maxval(pop%pop_grid(g)%patch(:)%age(1)) - IF (POP%pop_grid(g)%LU==2) then ! secondary forest + if (POP%pop_grid(g)%LU==2) then ! secondary forest nage = AGEMAX - DO iage=AGEMAX,1,-1 - IF (pop%pop_grid(g)%freq_age(iage)>0) THEN - EXIT - ELSE + do iage=AGEMAX,1,-1 + if (pop%pop_grid(g)%freq_age(iage)>0) then + exit + else nage = nage - 1 - ENDIF - ENDDO - ENDIF - - - disturbance_freq=1.0_dp/REAL(disturbance_interval(g,1),dp) - IF(.NOT.ALLOCATED(age)) ALLOCATE(age(nage)) - IF(.NOT.ALLOCATED(freq_age)) ALLOCATE(freq_age(nage)) - IF(.NOT.ALLOCATED(cmass_age)) ALLOCATE(cmass_age(nage)) - IF(.NOT.ALLOCATED(growth_age)) ALLOCATE(growth_age(nage)) - IF(.NOT.ALLOCATED(csapwood_age)) ALLOCATE(csapwood_age(nage)) - IF(.NOT.ALLOCATED(sapwood_area_age)) ALLOCATE(sapwood_area_age(nage)) - IF(.NOT.ALLOCATED(stress_mort_age)) ALLOCATE(stress_mort_age(nage)) - IF(.NOT.ALLOCATED(crowd_mort_age)) ALLOCATE(crowd_mort_age(nage)) + endif + enddo + endif + + + disturbance_freq=1.0_dp/real(disturbance_interval(g,1),dp) + if(.not.allocated(age)) allocate(age(nage)) + if(.not.allocated(freq_age)) allocate(freq_age(nage)) + if(.not.allocated(cmass_age)) allocate(cmass_age(nage)) + if(.not.allocated(growth_age)) allocate(growth_age(nage)) + if(.not.allocated(csapwood_age)) allocate(csapwood_age(nage)) + if(.not.allocated(sapwood_area_age)) allocate(sapwood_area_age(nage)) + if(.not.allocated(stress_mort_age)) allocate(stress_mort_age(nage)) + if(.not.allocated(crowd_mort_age)) allocate(crowd_mort_age(nage)) !pop%pop_grid(g)%biomass_age(2:agemax) = pop%pop_grid(g)%biomass_age(1:agemax-1) !pop%pop_grid(g)%biomass_age(1) = 0.0 !cmass_age = pop%pop_grid(g)%biomass_age @@ -2499,36 +2501,36 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) !IF (pop%LU(g)==2) THEN ! secondary forest - IF (POP%pop_grid(g)%LU==2) then ! secondary forest - DO iage = 1, nage + if (POP%pop_grid(g)%LU==2) then ! secondary forest + do iage = 1, nage age(iage) = iage-1 freq_age(iage) = pop%pop_grid(g)%freq_age(iage) - ENDDO - ELSE - DO iage = 1, nage + enddo + else + do iage = 1, nage age(iage) = iage-1 - freq_age(iage) = REALExponential(disturbance_freq,REAL(age(iage),dp)) + freq_age(iage) = REALExponential(disturbance_freq,real(age(iage),dp)) pop%pop_grid(g)%freq_age(iage) = freq_age(iage) - END DO - ENDIF + end do + endif if (sum(freq_age)>0.0_dp) freq_age = freq_age/sum(freq_age) - DO iage = 1, nage + do iage = 1, nage ! get nearest ages bracketing age(iage) - if (any(pop%pop_grid(g)%patch(:)%age(1).LE.age(iage))) then - age_min = MAXVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).LE.age(iage)) - i_min = MAXLOC(pop%pop_grid(g)%patch(:)%age(1), 1, & - pop%pop_grid(g)%patch(:)%age(1).LE.age(iage)) + if (any(pop%pop_grid(g)%patch(:)%age(1).le.age(iage))) then + age_min = maxval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).le.age(iage)) + i_min = maxloc(pop%pop_grid(g)%patch(:)%age(1), 1, & + pop%pop_grid(g)%patch(:)%age(1).le.age(iage)) else age_min = 0 i_min = 0 endif - if (any(pop%pop_grid(g)%patch(:)%age(1).GE.age(iage))) then - age_max = MINVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).GE.age(iage)) - i_max = MINLOC(pop%pop_grid(g)%patch(:)%age(1), 1, & - pop%pop_grid(g)%patch(:)%age(1).GE.age(iage)) + if (any(pop%pop_grid(g)%patch(:)%age(1).ge.age(iage))) then + age_max = minval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).ge.age(iage)) + i_max = minloc(pop%pop_grid(g)%patch(:)%age(1), 1, & + pop%pop_grid(g)%patch(:)%age(1).ge.age(iage)) else age_max = 0 i_max = 0 @@ -2548,16 +2550,16 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) tmp_array = 0.0_dp endwhere cmass_age(iage) = & - SUM(pop%pop_grid(g)%patch(:)%layer(1)%biomass,MASK)/SUM(tmp_array) + sum(pop%pop_grid(g)%patch(:)%layer(1)%biomass,MASK)/sum(tmp_array) growth_age(iage) = & - SUM(pop%pop_grid(g)%patch(:)%growth,MASK)/SUM(tmp_array) - csapwood_age(iage) = SUM(pop%pop_grid(g)%patch(:)%sapwood,MASK)/SUM(tmp_array) + sum(pop%pop_grid(g)%patch(:)%growth,MASK)/sum(tmp_array) + csapwood_age(iage) = sum(pop%pop_grid(g)%patch(:)%sapwood,MASK)/sum(tmp_array) sapwood_area_age(iage) = & - SUM(pop%pop_grid(g)%patch(:)%sapwood_area,MASK)/SUM(tmp_array) + sum(pop%pop_grid(g)%patch(:)%sapwood_area,MASK)/sum(tmp_array) stress_mort_age(iage)= & - SUM(pop%pop_grid(g)%patch(:)%stress_mortality,MASK)/SUM(tmp_array) + sum(pop%pop_grid(g)%patch(:)%stress_mortality,MASK)/sum(tmp_array) crowd_mort_age(iage)= & - SUM(pop%pop_grid(g)%patch(:)%crowding_mortality,MASK)/SUM(tmp_array) + sum(pop%pop_grid(g)%patch(:)%crowding_mortality,MASK)/sum(tmp_array) else ! interpolate or extrapolate if ((i_min.eq.0).and.(i_max.gt.0)) then @@ -2568,36 +2570,36 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) ! extrapolate to higher age age_max = age_min i_max = i_min - age_min = MAXVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).LT.age_max) - i_min = MAXLOC(pop%pop_grid(g)%patch(:)%age(1),1, & - pop%pop_grid(g)%patch(:)%age(1).LT.age_max) + age_min = maxval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).lt.age_max) + i_min = maxloc(pop%pop_grid(g)%patch(:)%age(1),1, & + pop%pop_grid(g)%patch(:)%age(1).lt.age_max) endif ! interpolate or extrapolate (growth) - if ((i_min_growth.eq.0).and.(i_max_growth.gt.0).and.age(iage).LE.2) then + if ((i_min_growth.eq.0).and.(i_max_growth.gt.0).and.age(iage).le.2) then ! interpolate to zero age_min_growth = 0 i_min_growth = 0 - elseif (((age_min_growth.LE.2).OR.(i_min_growth.eq.0)).and. & - (i_max_growth.gt.0).and.age(iage).GT.2) then + elseif (((age_min_growth.le.2).or.(i_min_growth.eq.0)).and. & + (i_max_growth.gt.0).and.age(iage).gt.2) then ! extrapolate to lower age age_min_growth = age_max_growth i_min_growth = i_max_growth - age_max_growth = MINVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).GT.age_min_growth) - i_max_growth = MINLOC(pop%pop_grid(g)%patch(:)%age(1), 1, & - pop%pop_grid(g)%patch(:)%age(1).GT.age_min_growth) + age_max_growth = minval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).gt.age_min_growth) + i_max_growth = minloc(pop%pop_grid(g)%patch(:)%age(1), 1, & + pop%pop_grid(g)%patch(:)%age(1).gt.age_min_growth) elseif ((i_max_growth.eq.0).and.(i_min_growth.gt.0)) then ! extrapolate to higher age age_max_growth = age_min_growth i_max_growth = i_min_growth - age_min_growth = MAXVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).LT.age_max_growth) - i_min_growth = MAXLOC(pop%pop_grid(g)%patch(:)%age(1),1, & - pop%pop_grid(g)%patch(:)%age(1).LT.age_max_growth) + age_min_growth = maxval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).lt.age_max_growth) + i_min_growth = maxloc(pop%pop_grid(g)%patch(:)%age(1),1, & + pop%pop_grid(g)%patch(:)%age(1).lt.age_max_growth) endif if (i_min.ne.0.and.age_min.ne.0) then @@ -2607,11 +2609,11 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) elsewhere tmp_array = 0.0_dp endwhere - tmp_min = SUM(pop%pop_grid(g)%patch(:)%layer(1)%biomass,MASK)/SUM(tmp_array) - tmp1_min = SUM(pop%pop_grid(g)%patch(:)%stress_mortality,MASK)/SUM(tmp_array) - tmp2_min = SUM(pop%pop_grid(g)%patch(:)%crowding_mortality,MASK)/SUM(tmp_array) - tmp3_min = SUM(pop%pop_grid(g)%patch(:)%sapwood,MASK)/SUM(tmp_array) - tmp4_min = SUM(pop%pop_grid(g)%patch(:)%sapwood_area,MASK)/SUM(tmp_array) + tmp_min = sum(pop%pop_grid(g)%patch(:)%layer(1)%biomass,MASK)/sum(tmp_array) + tmp1_min = sum(pop%pop_grid(g)%patch(:)%stress_mortality,MASK)/sum(tmp_array) + tmp2_min = sum(pop%pop_grid(g)%patch(:)%crowding_mortality,MASK)/sum(tmp_array) + tmp3_min = sum(pop%pop_grid(g)%patch(:)%sapwood,MASK)/sum(tmp_array) + tmp4_min = sum(pop%pop_grid(g)%patch(:)%sapwood_area,MASK)/sum(tmp_array) else tmp_min = 0.0_dp tmp1_min = 0.0_dp @@ -2626,11 +2628,11 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) elsewhere tmp_array = 0.0_dp endwhere - tmp_max = SUM(pop%pop_grid(g)%patch(:)%layer(1)%biomass,MASK)/SUM(tmp_array) - tmp1_max = SUM(pop%pop_grid(g)%patch(:)%stress_mortality,MASK)/SUM(tmp_array) - tmp2_max = SUM(pop%pop_grid(g)%patch(:)%crowding_mortality,MASK)/SUM(tmp_array) - tmp3_max = SUM(pop%pop_grid(g)%patch(:)%sapwood,MASK)/SUM(tmp_array) - tmp4_max = SUM(pop%pop_grid(g)%patch(:)%sapwood_area,MASK)/SUM(tmp_array) + tmp_max = sum(pop%pop_grid(g)%patch(:)%layer(1)%biomass,MASK)/sum(tmp_array) + tmp1_max = sum(pop%pop_grid(g)%patch(:)%stress_mortality,MASK)/sum(tmp_array) + tmp2_max = sum(pop%pop_grid(g)%patch(:)%crowding_mortality,MASK)/sum(tmp_array) + tmp3_max = sum(pop%pop_grid(g)%patch(:)%sapwood,MASK)/sum(tmp_array) + tmp4_max = sum(pop%pop_grid(g)%patch(:)%sapwood_area,MASK)/sum(tmp_array) cmass_age(iage) = tmp_min + (tmp_max-tmp_min)/real(age_max-age_min,dp)* & real(age(iage)-age_min,dp) @@ -2654,7 +2656,7 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) elsewhere tmp_array = 0.0_dp endwhere - tmp_min = SUM(pop%pop_grid(g)%patch(:)%growth,MASK)/SUM(tmp_array) + tmp_min = sum(pop%pop_grid(g)%patch(:)%growth,MASK)/sum(tmp_array) else tmp_min = 0.0_dp endif @@ -2665,7 +2667,7 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) elsewhere tmp_array = 0.0_dp endwhere - tmp_max = SUM(pop%pop_grid(g)%patch(:)%growth,MASK)/SUM(tmp_array) + tmp_max = sum(pop%pop_grid(g)%patch(:)%growth,MASK)/sum(tmp_array) growth_age(iage) = tmp_min + (tmp_max-tmp_min)/real(age_max_growth-age_min_growth,dp)* & real(age(iage)-age_min_growth,dp) @@ -2721,92 +2723,92 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) !!$ write(603,"(350e16.6)") real(age) !!$if (it==5) stop !!$endif - DEALLOCATE(age) - DEALLOCATE(freq_age) - DEALLOCATE(cmass_age) - DEALLOCATE(stress_mort_age) + deallocate(age) + deallocate(freq_age) + deallocate(cmass_age) + deallocate(stress_mort_age) - END SUBROUTINE INTERPOLATE_BIOMASS_1D + end subroutine INTERPOLATE_BIOMASS_1D !******************************************************************************* - SUBROUTINE INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) - IMPLICIT NONE + subroutine INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) - INTEGER(i4b), INTENT(IN) :: it,g + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: disturbance_interval(:,:) + integer(i4b), intent(IN) :: it,g - INTEGER(i4b) :: nage,iage, i_min, i_max - INTEGER(i4b) :: i_min_growth, i_max_growth - REAL(dp) :: disturbance_freq,tmp_min, tmp_max, tmp_array(NPATCH2D) - REAL(dp) :: tmp5_min, tmp5_max - LOGICAL :: MASK(NPATCH2D) - INTEGER(i4b) :: age_min, age_max - INTEGER(i4b) :: age_min_growth, age_max_growth - INTEGER(i4b), ALLOCATABLE :: age(:) - REAL(dp), ALLOCATABLE :: fire_mort_age(:) - REAL(dp), ALLOCATABLE :: freq_age(:) + integer(i4b) :: nage,iage, i_min, i_max + integer(i4b) :: i_min_growth, i_max_growth + real(dp) :: disturbance_freq,tmp_min, tmp_max, tmp_array(NPATCH2D) + real(dp) :: tmp5_min, tmp5_max + logical :: MASK(NPATCH2D) + integer(i4b) :: age_min, age_max + integer(i4b) :: age_min_growth, age_max_growth + integer(i4b), allocatable :: age(:) + real(dp), allocatable :: fire_mort_age(:) + real(dp), allocatable :: freq_age(:) ! get interpolated fire mortality POP%pop_grid(g)%fire_mortality = 0.0_dp tmp_array = 0.0_dp nage = min(POP%pop_grid(g)%patch(1)%disturbance_interval(1),it)+1 ! maximum age - IF (POP%pop_grid(g)%LU==2) then ! secondary forest + if (POP%pop_grid(g)%LU==2) then ! secondary forest nage = AGEMAX - DO iage=AGEMAX,1,-1 - IF (pop%pop_grid(g)%freq_age(iage)>0) THEN - EXIT - ELSE + do iage=AGEMAX,1,-1 + if (pop%pop_grid(g)%freq_age(iage)>0) then + exit + else nage = nage - 1 - ENDIF - ENDDO - ENDIF + endif + enddo + endif - disturbance_freq=1.0_dp/REAL(disturbance_interval(g,1),dp) - IF(.NOT.ALLOCATED(age)) ALLOCATE(age(nage)) - IF(.NOT.ALLOCATED(freq_age)) ALLOCATE(freq_age(nage)) - IF(.NOT.ALLOCATED(fire_mort_age)) ALLOCATE(fire_mort_age(nage)) + disturbance_freq=1.0_dp/real(disturbance_interval(g,1),dp) + if(.not.allocated(age)) allocate(age(nage)) + if(.not.allocated(freq_age)) allocate(freq_age(nage)) + if(.not.allocated(fire_mort_age)) allocate(fire_mort_age(nage)) tmp_min = 0.0_dp tmp_max = 0.0_dp pop%pop_grid(g)%biomass_age = 0.0_dp - IF (POP%pop_grid(g)%LU==2) then ! secondary forest - DO iage = 1, nage + if (POP%pop_grid(g)%LU==2) then ! secondary forest + do iage = 1, nage age(iage) = iage-1 freq_age(iage) = pop%pop_grid(g)%freq_age(iage) - ENDDO - ELSE - DO iage = 1, nage + enddo + else + do iage = 1, nage age(iage) = iage-1 - freq_age(iage) = REALExponential(disturbance_freq,REAL(age(iage),dp)) + freq_age(iage) = REALExponential(disturbance_freq,real(age(iage),dp)) pop%pop_grid(g)%freq_age(iage) = freq_age(iage) - END DO + end do - ENDIF + endif if (sum(freq_age)>0.0_dp) freq_age = freq_age/sum(freq_age) - DO iage = 1, nage + do iage = 1, nage ! get nearest ages bracketing age(iage) - if (any(pop%pop_grid(g)%patch(:)%age(1).LE.age(iage))) then - age_min = MAXVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).LE.age(iage)) - i_min = MAXLOC(pop%pop_grid(g)%patch(:)%age(1), 1, & - pop%pop_grid(g)%patch(:)%age(1).LE.age(iage)) + if (any(pop%pop_grid(g)%patch(:)%age(1).le.age(iage))) then + age_min = maxval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).le.age(iage)) + i_min = maxloc(pop%pop_grid(g)%patch(:)%age(1), 1, & + pop%pop_grid(g)%patch(:)%age(1).le.age(iage)) else age_min = 0 i_min = 0 endif - if (any(pop%pop_grid(g)%patch(:)%age(1).GE.age(iage))) then - age_max = MINVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).GE.age(iage)) - i_max = MINLOC(pop%pop_grid(g)%patch(:)%age(1), 1, & - pop%pop_grid(g)%patch(:)%age(1).GE.age(iage)) + if (any(pop%pop_grid(g)%patch(:)%age(1).ge.age(iage))) then + age_max = minval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).ge.age(iage)) + i_max = minloc(pop%pop_grid(g)%patch(:)%age(1), 1, & + pop%pop_grid(g)%patch(:)%age(1).ge.age(iage)) else age_max = 0 i_max = 0 @@ -2827,7 +2829,7 @@ SUBROUTINE INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) tmp_array = 0.0_dp endwhere fire_mort_age(iage)= & - SUM(pop%pop_grid(g)%patch(:)%fire_mortality,MASK)/SUM(tmp_array) + sum(pop%pop_grid(g)%patch(:)%fire_mortality,MASK)/sum(tmp_array) else ! interpolate or extrapolate if ((i_min.eq.0).and.(i_max.gt.0)) then @@ -2838,13 +2840,14 @@ SUBROUTINE INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) ! extrapolate to higher age age_max = age_min i_max = i_min - age_min = MAXVAL(pop%pop_grid(g)%patch(:)%age(1), & - pop%pop_grid(g)%patch(:)%age(1).LT.age_max) - i_min = MAXLOC(pop%pop_grid(g)%patch(:)%age(1),1, & - pop%pop_grid(g)%patch(:)%age(1).LT.age_max) + age_min = maxval(pop%pop_grid(g)%patch(:)%age(1), & + pop%pop_grid(g)%patch(:)%age(1).lt.age_max) + i_min = maxloc(pop%pop_grid(g)%patch(:)%age(1),1, & + pop%pop_grid(g)%patch(:)%age(1).lt.age_max) endif + tmp5_min = 0.0_dp if (i_min.ne.0.and.age_min.ne.0) then MASK = pop%pop_grid(g)%patch(:)%age(1).eq.age_min where (MASK) @@ -2852,18 +2855,21 @@ SUBROUTINE INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) elsewhere tmp_array = 0.0_dp endwhere - tmp5_min = SUM(pop%pop_grid(g)%patch(:)%fire_mortality,MASK)/SUM(tmp_array) - else - tmp5_min = 0.0_dp + if ( any(MASK) ) then + tmp5_min = sum(pop%pop_grid(g)%patch(:)%fire_mortality,MASK)/sum(tmp_array) + endif endif + tmp5_max = 0.0_dp MASK = pop%pop_grid(g)%patch(:)%age(1).eq.age_max where (MASK) tmp_array = 1.0_dp elsewhere tmp_array = 0.0_dp endwhere - tmp5_max = SUM(pop%pop_grid(g)%patch(:)%fire_mortality,MASK)/SUM(tmp_array) + IF ( any(MASK) ) then + tmp5_max = sum(pop%pop_grid(g)%patch(:)%fire_mortality,MASK)/sum(tmp_array) + endif fire_mort_age(iage) = tmp5_min + (tmp5_max-tmp5_min)/real(age_max-age_min,dp)* & real(age(iage)-age_min,dp) @@ -2874,32 +2880,32 @@ SUBROUTINE INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) enddo - DEALLOCATE(age) - DEALLOCATE(freq_age) - DEALLOCATE(fire_mort_age) + deallocate(age) + deallocate(freq_age) + deallocate(fire_mort_age) - END SUBROUTINE INTERPOLATE_FIREMORTALITY + end subroutine INTERPOLATE_FIREMORTALITY !******************************************************************************* - SUBROUTINE ADJUST_POP_FOR_FIRE(pop,disturbance_interval, burned_area, FLI) + subroutine ADJUST_POP_FOR_FIRE(pop,disturbance_interval, burned_area, FLI) ! reduces biomass on a cohort basis according to mortality vs dbh function ! interpolates patch-based fire mortality to get grid-cell mortality - IMPLICIT NONE + implicit none - TYPE( POP_TYPE ), INTENT(INOUT) :: pop - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) - REAL(dp), INTENT(IN) :: burned_area(:), FLI(:) - INTEGER(i4b) :: g, np, c, k, it, nc - REAL(dp) :: mort, cmass_stem, dbh + type( POP_TYPE ), intent(INOUT) :: pop + integer(i4b), intent(IN) :: disturbance_interval(:,:) + real(dp), intent(IN) :: burned_area(:), FLI(:) + integer(i4b) :: g, np, c, k, it, nc + real(dp) :: mort, cmass_stem, dbh - np = SIZE(POP%POP_grid) + np = size(POP%POP_grid) mort = 0.0 - DO g=1,np + do g=1,np POP%pop_grid(g)%fire_mortality = 0.0_dp @@ -2907,11 +2913,11 @@ SUBROUTINE ADJUST_POP_FOR_FIRE(pop,disturbance_interval, burned_area, FLI) if (burned_area(g) > 0.0_dp) then it = maxval(pop%pop_grid(g)%patch(:)%age(1)) + 1 - DO k=1,NPATCH + do k=1,NPATCH nc = pop%pop_grid(g)%patch(k)%Layer(1)%ncohort pop%pop_grid(g)%patch(k)%fire_mortality = 0.0_dp - DO c=1,nc + do c=1,nc dbh = pop%pop_grid(g)%patch(k)%layer(1)%cohort(c)%diameter*100.0_dp cmass_stem = pop%pop_grid(g)%patch(k)%layer(1)%cohort(c)%biomass @@ -2936,69 +2942,79 @@ SUBROUTINE ADJUST_POP_FOR_FIRE(pop,disturbance_interval, burned_area, FLI) pop%pop_grid(g)%patch(k)%Layer(1)%cohort(c)%density*(1.0_dp-mort) - ENDDO + enddo nc = pop%pop_grid(g)%patch(k)%Layer(1)%ncohort pop%pop_grid(g)%patch(k)%biomass_old = pop%pop_grid(g)%patch(k)%Layer(1)%biomass pop%pop_grid(g)%patch(k)%Layer(1)%biomass = & - SUM(pop%pop_grid(g)%patch(k)%Layer(1)%cohort(1:nc)%biomass) + sum(pop%pop_grid(g)%patch(k)%Layer(1)%cohort(1:nc)%biomass) ! need to remove cohorts with very low density? ! This will get done at the end of the year anyway - ENDDO + enddo - ENDIF + endif ! INTREPOLATE amongst patches to get total biomass lost to fire ! creates new value for POP%pop_grid(g)%fire_mortality - CALL INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) + call INTERPOLATE_FIREMORTALITY(pop, disturbance_interval,it,g) + !CLN Kill ratio to be used within BLAZE to compute fluxes + POP%pop_grid(g)%rkill = 0. + if ( POP%pop_grid(g)%cmass_sum .gt. 0.) then + POP%pop_grid(g)%rkill = POP%pop_grid(g)%fire_mortality / POP%pop_grid(g)%cmass_sum + else + POP%pop_grid(g)%rkill = 0. + endif + if (POP%pop_grid(g)%rkill .GT. 0.) then + WRITE(*,*) "driver rkill",g,POP%pop_grid(g)%rkill + endif POP%pop_grid(g)%cmass_sum = POP%pop_grid(g)%cmass_sum - POP%pop_grid(g)%fire_mortality + + enddo - ENDDO - - END SUBROUTINE ADJUST_POP_FOR_FIRE + end subroutine ADJUST_POP_FOR_FIRE !******************************************************************************* -SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) +subroutine INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) use mo_utils, only: eq #ifdef __MPI__ use mpi, only: MPI_Abort #endif -IMPLICIT NONE - -TYPE(POP_TYPE), INTENT(INOUT) :: POP -INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) -INTEGER(i4b), INTENT(IN) :: it,g -INTEGER(i4b), allocatable :: A1(:), A2(:) ! interpolated ages -INTEGER(i4b), allocatable :: xobs(:), yobs(:) ! observed ages -REAL(dp), allocatable :: z1obs(:), z2obs(:), z3obs(:) ! observed biomass, stress_mort, crowd_mort -REAL(dp), allocatable :: z1interp(:), z2interp(:), z3interp(:) ! interpolated biomass, stress mortality, crowding mortality -REAL(dp), allocatable :: freq_interp(:) ! weightings for interpolated age pairs -REAL(dp), allocatable :: zp(:) ! euclidean distance from interpolated age pair to observed age pairs -INTEGER(i4b) :: age_max(2), nrep(NPATCH2D+1) -INTEGER(i4b) :: tmp1, tmp2, I1, I2,I3,I4 -INTEGER(i4b) :: x1, x2, x3, x4, y1, y2, y3, y4 -INTEGER(i4b) :: p, j, k, n, np, nobs, count_extrap, ct -LOGICAL :: flag -REAL(dp) :: biomass(NPATCH2D+1), stress_mort(NPATCH2D+1), crowd_mort(NPATCH2D+1) -INTEGER(i4b) :: age1(NPATCH2D+1), age2(NPATCH2D+1) -REAL(dp) :: zmin -INTEGER(i4b), allocatable :: interp_case(:), tmp_array(:), tmp(:) -REAL(dp) :: area(4,4), x(4), y(4), disturbance_freq1, disturbance_freq2 -INTEGER(i4b) :: triangle_points(4,3), I_inside_triangle, Ineighbour(8) -LOGICAL :: MASK_INSIDE_TRIANGLE(4), IS_NEIGHBOUR(8), tmp_logical -LOGICAL, allocatable :: MASK2(:), MASK3(:), MASK4(:) -INTEGER(i4b), allocatable :: address(:,:) +implicit none + +type(POP_TYPE), intent(INOUT) :: POP +integer(i4b), intent(IN) :: disturbance_interval(:,:) +integer(i4b), intent(IN) :: it,g +integer(i4b), allocatable :: A1(:), A2(:) ! interpolated ages +integer(i4b), allocatable :: xobs(:), yobs(:) ! observed ages +real(dp), allocatable :: z1obs(:), z2obs(:), z3obs(:) ! observed biomass, stress_mort, crowd_mort +real(dp), allocatable :: z1interp(:), z2interp(:), z3interp(:) ! interpolated biomass, stress mortality, crowding mortality +real(dp), allocatable :: freq_interp(:) ! weightings for interpolated age pairs +real(dp), allocatable :: zp(:) ! euclidean distance from interpolated age pair to observed age pairs +integer(i4b) :: age_max(2), nrep(NPATCH2D+1) +integer(i4b) :: tmp1, tmp2, I1, I2,I3,I4 +integer(i4b) :: x1, x2, x3, x4, y1, y2, y3, y4 +integer(i4b) :: p, j, k, n, np, nobs, count_extrap, ct +logical :: flag +real(dp) :: biomass(NPATCH2D+1), stress_mort(NPATCH2D+1), crowd_mort(NPATCH2D+1) +integer(i4b) :: age1(NPATCH2D+1), age2(NPATCH2D+1) +real(dp) :: zmin +integer(i4b), allocatable :: interp_case(:), tmp_array(:), tmp(:) +real(dp) :: area(4,4), x(4), y(4), disturbance_freq1, disturbance_freq2 +integer(i4b) :: triangle_points(4,3), I_inside_triangle, Ineighbour(8) +logical :: MASK_INSIDE_TRIANGLE(4), IS_NEIGHBOUR(8), tmp_logical +logical, allocatable :: MASK2(:), MASK3(:), MASK4(:) +integer(i4b), allocatable :: address(:,:) #ifdef __MPI__ integer :: ierr #endif @@ -3012,37 +3028,37 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) age_max(2) = min(POP%pop_grid(g)%patch(1)%disturbance_interval(NDISTURB),it)+1 ! maximum age p=0 -DO j=0,age_max(1) - DO k=0, age_max(2) - IF (k>j) THEN +do j=0,age_max(1) + do k=0, age_max(2) + if (k>j) then p=p+1 - ENDIF - ENDDO -ENDDO + endif + enddo +enddo np = p -ALLOCATE(A1(np)) -ALLOCATE(A2(np)) -ALLOCATE(z1interp(np)) -ALLOCATE(z2interp(np)) -ALLOCATE(z3interp(np)) -ALLOCATE(freq_interp(np)) -ALLOCATE(interp_case(np)) -ALLOCATE(tmp_array(np)) -ALLOCATE(tmp(np)) -ALLOCATE(address(age_max(1)+1,age_max(2)+1)) +allocate(A1(np)) +allocate(A2(np)) +allocate(z1interp(np)) +allocate(z2interp(np)) +allocate(z3interp(np)) +allocate(freq_interp(np)) +allocate(interp_case(np)) +allocate(tmp_array(np)) +allocate(tmp(np)) +allocate(address(age_max(1)+1,age_max(2)+1)) p=0 address = -9999 -DO j=0,age_max(1) - DO k=0, age_max(2) - IF (k>j) THEN +do j=0,age_max(1) + do k=0, age_max(2) + if (k>j) then p=p+1 A1(p) = j A2(p) = k address(j+1,k+1) = p - ENDIF - ENDDO -ENDDO + endif + enddo +enddo ! Construct Age observations @@ -3086,15 +3102,15 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) biomass(1:nobs) = biomass(1:nobs)/nrep(1:nobs) stress_mort(1:nobs) = stress_mort(1:nobs)/nrep(1:nobs) crowd_mort(1:nobs) = crowd_mort(1:nobs)/nrep(1:nobs) -ALLOCATE(xobs(nobs)) -ALLOCATE(yobs(nobs)) -ALLOCATE(z1obs(nobs)) -ALLOCATE(z2obs(nobs)) -ALLOCATE(z3obs(nobs)) -ALLOCATE(zp(nobs)) -ALLOCATE(MASK2(nobs)) -ALLOCATE(MASK3(nobs)) -ALLOCATE(MASK4(nobs)) +allocate(xobs(nobs)) +allocate(yobs(nobs)) +allocate(z1obs(nobs)) +allocate(z2obs(nobs)) +allocate(z3obs(nobs)) +allocate(zp(nobs)) +allocate(MASK2(nobs)) +allocate(MASK3(nobs)) +allocate(MASK4(nobs)) xobs = age1(1:nobs) yobs = age2(1:nobs) z1obs = biomass(1:nobs) @@ -3109,60 +3125,60 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) ! get weightings for each interpolated age pair do k = 1, np - disturbance_freq1=1.0_dp/REAL(disturbance_interval(g,1),dp) - disturbance_freq2=1.0_dp/REAL(disturbance_interval(g,2),dp) + disturbance_freq1=1.0_dp/real(disturbance_interval(g,1),dp) + disturbance_freq2=1.0_dp/real(disturbance_interval(g,2),dp) - freq_interp(k) = REALExponential(disturbance_freq1,REAL(A1(k),dp)) * & - REALExponential(disturbance_freq2,REAL(A2(k),dp)) + freq_interp(k) = REALExponential(disturbance_freq1,real(A1(k),dp)) * & + REALExponential(disturbance_freq2,real(A2(k),dp)) -ENDDO +enddo freq_interp = freq_interp/sum(freq_interp) ! interpolate -DO p=1,np ! loop over interpolated age pairs +do p=1,np ! loop over interpolated age pairs ! get distance to all observations - DO j=1,nobs + do j=1,nobs zp(j) = sqrt((real(A1(p),dp)-real(xobs(j),dp))**2+(real(A2(p),dp)-real(yobs(j),dp))**2) - ENDDO + enddo ! get closest point - zmin = MINVAL(zp) - I1 = MINLOC(zp,1) + zmin = minval(zp) + I1 = minloc(zp,1) x1 = xobs(I1) y1 = yobs(I1) ! check for obs locations forming a quadrangle around interpolating point - MASK2 = (sign(1,A1(p)-xobs)== -sign(1,A1(p)-x1)).AND.(sign(1,A2(p)-yobs)== sign(1,A2(p)-y1).and.A1(p).NE.xobs) - MASK3 = (sign(1,A1(p)-xobs)== sign(1,A1(p)-x1)).AND.(sign(1,A2(p)-yobs)== -sign(1,A2(p)-y1).and.A2(p).NE.yobs) - MASK4 = (sign(1,A1(p)-xobs)== -sign(1,A1(p)-x1)).AND.(sign(1,A2(p)-yobs)== -sign(1,A2(p)-y1) & - .and.A1(p).NE.xobs.and.A2(p).NE.yobs) + MASK2 = (sign(1,A1(p)-xobs)== -sign(1,A1(p)-x1)).and.(sign(1,A2(p)-yobs)== sign(1,A2(p)-y1).and.A1(p).ne.xobs) + MASK3 = (sign(1,A1(p)-xobs)== sign(1,A1(p)-x1)).and.(sign(1,A2(p)-yobs)== -sign(1,A2(p)-y1).and.A2(p).ne.yobs) + MASK4 = (sign(1,A1(p)-xobs)== -sign(1,A1(p)-x1)).and.(sign(1,A2(p)-yobs)== -sign(1,A2(p)-y1) & + .and.A1(p).ne.xobs.and.A2(p).ne.yobs) - IF ((ANY(MASK2)).and.(ANY(MASK3)).and.(ANY(MASK4))) THEN + if ((any(MASK2)).and.(any(MASK3)).and.(any(MASK4))) then ! get nearest point with opposing sign of x displacement - I2 = MINLOC(zp,1, MASK2) + I2 = minloc(zp,1, MASK2) x2 = xobs(I2) y2 = yobs(I2) ! get nearest point with opposing sign of y displacement - I3 = MINLOC(zp,1, MASK3) + I3 = minloc(zp,1, MASK3) x3 = xobs(I3) y3 = yobs(I3) ! get nearest point with opposing sign of x & y displacements - I4 = MINLOC(zp,1, MASK4) + I4 = minloc(zp,1, MASK4) x4 = xobs(I4) y4 = yobs(I4) - tmp_logical = .NOT.( (x2.eq.0.and.y2.eq.0).OR.(x3.eq.0.and.y3.eq.0).OR.(x4.eq.0.and.y4.eq.0)) - ENDIF + tmp_logical = .not.( (x2.eq.0.and.y2.eq.0).or.(x3.eq.0.and.y3.eq.0).or.(x4.eq.0.and.y4.eq.0)) + endif - IF ((A1(p)==x1).and.(A2(p)==y1)) THEN + if ((A1(p)==x1).and.(A2(p)==y1)) then interp_case(p)=1 - ELSEIF ((ANY(MASK2)).and.(ANY(MASK3)).and.(ANY(MASK4)) .AND.tmp_logical) THEN ! quadrangle (without (0,0)) exists + elseif ((any(MASK2)).and.(any(MASK3)).and.(any(MASK4)) .and.tmp_logical) then ! quadrangle (without (0,0)) exists interp_case(p) = 2 - ELSE + else interp_case(p) = 3 - ENDIF!j=1 + endif!j=1 @@ -3178,15 +3194,15 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) z3interp(p) = z3obs(I1) case(2) ! quadrangle ! get nearest point with opposing sign of x displacement - I2 = MINLOC(zp,1, MASK2) + I2 = minloc(zp,1, MASK2) x2 = xobs(I2) y2 = yobs(I2) ! get nearest point with opposing sign of y displacement - I3 = MINLOC(zp,1, MASK3) + I3 = minloc(zp,1, MASK3) x3 = xobs(I3) y3 = yobs(I3) ! get nearest point with opposing sign of x & y displacements - I4 = MINLOC(zp,1, MASK4) + I4 = minloc(zp,1, MASK4) x4 = xobs(I4) y4 = yobs(I4) @@ -3223,12 +3239,12 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) area(4,4) = area_triangle(real(A1(p),dp), real(A2(p),dp), x(2), y(2), x(4), y(4)) MASK_INSIDE_TRIANGLE = eq(area(:,1), sum(area(:,2:4),2)) - I_inside_triangle = MINLOC(area(:,1),1,MASK_INSIDE_TRIANGLE) - z1interp(p) =SUM( z1obs(triangle_points(I_inside_triangle,:))* & + I_inside_triangle = minloc(area(:,1),1,MASK_INSIDE_TRIANGLE) + z1interp(p) =sum( z1obs(triangle_points(I_inside_triangle,:))* & area(I_inside_triangle,2:4))/sum(area(I_inside_triangle,2:4)) - z2interp(p) =SUM( z2obs(triangle_points(I_inside_triangle,:))* & + z2interp(p) =sum( z2obs(triangle_points(I_inside_triangle,:))* & area(I_inside_triangle,2:4))/sum(area(I_inside_triangle,2:4)) - z3interp(p) =SUM( z3obs(triangle_points(I_inside_triangle,:))* & + z3interp(p) =sum( z3obs(triangle_points(I_inside_triangle,:))* & area(I_inside_triangle,2:4))/sum(area(I_inside_triangle,2:4)) @@ -3241,23 +3257,23 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) #endif end select ! interpolation case -ENDDO ! loop over interpolated age pairs +enddo ! loop over interpolated age pairs p = 0 ! counter for while loop count_extrap = 0 ! Extrapolation -IF (ANY(interp_case.NE.3)) THEN - DO WHILE (ANY(interp_case==3)) - DO ct = 3,3 - DO p=1,np +if (any(interp_case.ne.3)) then + do while (any(interp_case==3)) + do ct = 3,3 + do p=1,np ! find number of neighbours for each extrapolable point - is_neighbour = .FALSE. + is_neighbour = .false. Ineighbour = 1 tmp(p) = 0 - IF (interp_case(p)==3) THEN + if (interp_case(p)==3) then - DO k=1,8 + do k=1,8 if(k==1) then tmp1=A1(p)-1 tmp2=A2(p) @@ -3283,31 +3299,31 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) tmp1=A1(p)-1 tmp2=A2(p)+1 endif - IF(tmp1.ge.0.and.tmp1.LE.age_max(1).and.tmp2.ge.0.and.tmp2.LE.age_max(2).and.tmp2.gt.tmp1) THEN + if(tmp1.ge.0.and.tmp1.le.age_max(1).and.tmp2.ge.0.and.tmp2.le.age_max(2).and.tmp2.gt.tmp1) then is_neighbour(k) = (interp_case(address(tmp1+1,tmp2+1)).ne.3) Ineighbour(k) = address(tmp1+1,tmp2+1) - ENDIF + endif - ENDDO + enddo - tmp(p) = COUNT(is_neighbour) - if (tmp(p).GE.ct) then + tmp(p) = count(is_neighbour) + if (tmp(p).ge.ct) then z1interp(p) = sum(z1interp(Ineighbour) ,is_neighbour)/real(tmp(p),dp) z2interp(p) = sum(z2interp(Ineighbour) ,is_neighbour)/real(tmp(p),dp) z3interp(p) = sum(z3interp(Ineighbour) ,is_neighbour)/real(tmp(p),dp) interp_case(p) = 2 endif - ENDIF - ENDDO !1, np - ENDDO - IF (ALL(tmp.lt.3)) THEN + endif + enddo !1, np + enddo + if (all(tmp.lt.3)) then ! maximum of one neighbour - p = MAXLOC(tmp,1) - is_neighbour = .FALSE. + p = maxloc(tmp,1) + is_neighbour = .false. Ineighbour = 1 tmp(p) = 0 - DO k=1,8 + do k=1,8 if(k==1) then tmp1=A1(p)-1 tmp2=A2(p) @@ -3333,26 +3349,26 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) tmp1=A1(p)-1 tmp2=A2(p)+1 endif - IF(tmp1.ge.0.and.tmp1.LE.age_max(1).and.tmp2.ge.0.and.tmp2.LE.age_max(2).and.tmp2.gt.tmp1) THEN + if(tmp1.ge.0.and.tmp1.le.age_max(1).and.tmp2.ge.0.and.tmp2.le.age_max(2).and.tmp2.gt.tmp1) then is_neighbour(k) = (interp_case(address(tmp1+1,tmp2+1)).ne.3) Ineighbour(k) = address(tmp1+1,tmp2+1) - ENDIF + endif - ENDDO + enddo - tmp(p) = COUNT(is_neighbour) + tmp(p) = count(is_neighbour) z1interp(p) = sum(z1interp(Ineighbour) ,is_neighbour)/real(tmp(p),dp) z2interp(p) = sum(z2interp(Ineighbour) ,is_neighbour)/real(tmp(p),dp) z3interp(p) = sum(z3interp(Ineighbour) ,is_neighbour)/real(tmp(p),dp) interp_case(p) = 2 - ENDIF ! ALL(tmp.lt.2) + endif ! ALL(tmp.lt.2) - ENDDO ! do while -ENDIF + enddo ! do while +endif -DO p = 1,np +do p = 1,np POP%pop_grid(g)%cmass_sum = POP%pop_grid(g)%cmass_sum + & freq_interp(p)*z1interp(p) POP%pop_grid(g)%stress_mortality = POP%pop_grid(g)%stress_mortality + & @@ -3361,7 +3377,7 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) freq_interp(p)*z3interp(p) -ENDDO +enddo POP%pop_grid(g)%cat_mortality = POP%pop_grid(g)%cmass_sum * disturbance_freq2 POP%pop_grid(g)%fire_mortality = POP%pop_grid(g)%growth - & @@ -3371,52 +3387,52 @@ SUBROUTINE INTERPOLATE_BIOMASS_2D(pop, disturbance_interval,it,g) ( POP%pop_grid(g)%cmass_sum- POP%pop_grid(g)%cmass_sum_old) -DEALLOCATE(xobs) -DEALLOCATE(yobs) -DEALLOCATE(z1obs) -DEALLOCATE(z2obs) -DEALLOCATE(z3obs) -DEALLOCATE(zp) -DEALLOCATE(MASK2) -DEALLOCATE(MASK3) -DEALLOCATE(MASK4) -DEALLOCATE(A1) -DEALLOCATE(A2) -DEALLOCATE(z1interp) -DEALLOCATE(z2interp) -DEALLOCATE(z3interp) -DEALLOCATE(freq_interp) -DEALLOCATE(interp_case) -DEALLOCATE(tmp) -DEALLOCATE(tmp_array) -DEALLOCATE(address) - -END SUBROUTINE INTERPOLATE_BIOMASS_2D +deallocate(xobs) +deallocate(yobs) +deallocate(z1obs) +deallocate(z2obs) +deallocate(z3obs) +deallocate(zp) +deallocate(MASK2) +deallocate(MASK3) +deallocate(MASK4) +deallocate(A1) +deallocate(A2) +deallocate(z1interp) +deallocate(z2interp) +deallocate(z3interp) +deallocate(freq_interp) +deallocate(interp_case) +deallocate(tmp) +deallocate(tmp_array) +deallocate(address) + +end subroutine INTERPOLATE_BIOMASS_2D !****************************************************************************** -SUBROUTINE SMOOTH_FLUX(POP,g,t) +subroutine SMOOTH_FLUX(POP,g,t) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: g, t + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: g, t - INTEGER(i4b), PARAMETER :: SPAN = NYEAR_WINDOW - REAL(dp) :: x(NYEAR_SMOOTH), y(NYEAR_SMOOTH), a, b, r - REAL(dp) :: sumflux, sumsmooth, flux(NYEAR_HISTORY), smoothed_flux - REAL(dp) :: dbuf - INTEGER(i4b) :: t0, tt, n, k + integer(i4b), parameter :: SPAN = NYEAR_WINDOW + real(dp) :: x(NYEAR_SMOOTH), y(NYEAR_SMOOTH), a, b, r + real(dp) :: sumflux, sumsmooth, flux(NYEAR_HISTORY), smoothed_flux + real(dp) :: dbuf + integer(i4b) :: t0, tt, n, k ! update fire_mortality_history - IF (t.gt.NYEAR_HISTORY) THEN - DO k = 1, NYEAR_HISTORY-1 + if (t.gt.NYEAR_HISTORY) then + do k = 1, NYEAR_HISTORY-1 POP%pop_grid(g)%fire_mortality_history(k) = POP%pop_grid(g)%fire_mortality_history(k+1) - ENDDO - ENDIF + enddo + endif POP%pop_grid(g)%fire_mortality_history(t) = POP%pop_grid(g)%fire_mortality flux = POP%pop_grid(g)%fire_mortality_history @@ -3424,51 +3440,51 @@ SUBROUTINE SMOOTH_FLUX(POP,g,t) n = 0 sumflux = 0.0_dp sumsmooth = 0.0_dp - DO tt=1, NYEAR_SMOOTH - IF ((t0+tt).GE.1 .AND. (t0+tt).LE.t+1) THEN + do tt=1, NYEAR_SMOOTH + if ((t0+tt).ge.1 .and. (t0+tt).le.t+1) then sumflux = sumflux + flux(t0+tt) y(tt) = flux(t0+tt) x(tt) = real(tt,dp) n = n+1 - IF ((t0+tt).eq.t+1) THEN - CALL regress(x,y,n,a,b,r) - ENDIF - ELSE + if ((t0+tt).eq.t+1) then + call regress(x,y,n,a,b,r) + endif + else sumflux = sumflux + (a + b*tt) n = n+ 1 - ENDIF - ENDDO + endif + enddo dbuf = POP%pop_grid(g)%smoothing_buffer / (real(NYEAR_SMOOTH,dp)/2.0_dp) smoothed_flux = max(sumflux/real(n)+dbuf, 0.0_dp) POP%pop_grid(g)%smoothing_buffer = POP%pop_grid(g)%smoothing_buffer + flux(t) - smoothed_flux POP%pop_grid(g)%fire_mortality_smoothed = smoothed_flux -END SUBROUTINE SMOOTH_FLUX +end subroutine SMOOTH_FLUX !****************************************************************************** -SUBROUTINE SMOOTH_FLUX_cat(POP,g,t) +subroutine SMOOTH_FLUX_cat(POP,g,t) - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: g, t - INTEGER(i4b), PARAMETER :: SPAN = NYEAR_WINDOW - REAL(dp) :: x(NYEAR_SMOOTH), y(NYEAR_SMOOTH), a, b, r - REAL(dp) :: sumflux, sumsmooth, flux(NYEAR_HISTORY), smoothed_flux - REAL(dp) :: dbuf - INTEGER(i4b) :: t0, tt, n, k + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: g, t + integer(i4b), parameter :: SPAN = NYEAR_WINDOW + real(dp) :: x(NYEAR_SMOOTH), y(NYEAR_SMOOTH), a, b, r + real(dp) :: sumflux, sumsmooth, flux(NYEAR_HISTORY), smoothed_flux + real(dp) :: dbuf + integer(i4b) :: t0, tt, n, k ! update cat_mortality_history - IF (t.gt.NYEAR_HISTORY) THEN - DO k = 1, NYEAR_HISTORY-1 + if (t.gt.NYEAR_HISTORY) then + do k = 1, NYEAR_HISTORY-1 POP%pop_grid(g)%cat_mortality_history(k) = POP%pop_grid(g)%cat_mortality_history(k+1) - ENDDO - ENDIF + enddo + endif POP%pop_grid(g)%cat_mortality_history(t) = POP%pop_grid(g)%cat_mortality flux = POP%pop_grid(g)%cat_mortality_history @@ -3476,41 +3492,41 @@ SUBROUTINE SMOOTH_FLUX_cat(POP,g,t) n = 0 sumflux = 0.0_dp sumsmooth = 0.0_dp - DO tt=1, NYEAR_SMOOTH - IF ((t0+tt).GE.1 .AND. (t0+tt).LE.t+1) THEN + do tt=1, NYEAR_SMOOTH + if ((t0+tt).ge.1 .and. (t0+tt).le.t+1) then sumflux = sumflux + flux(t0+tt-1) y(tt) = flux(t0+tt-1) x(tt) = real(tt, dp) n = n+1 - IF ((t0+tt).eq.t+1) THEN - CALL regress(x,y,n,a,b,r) - ENDIF - ELSE + if ((t0+tt).eq.t+1) then + call regress(x,y,n,a,b,r) + endif + else sumflux = sumflux + (a + b*tt) n = n+ 1 - ENDIF - ENDDO + endif + enddo dbuf = POP%pop_grid(g)%smoothing_buffer_cat/(real(NYEAR_SMOOTH,dp)/2.0_dp) smoothed_flux = max(sumflux/real(n)+dbuf, 0.0_dp) POP%pop_grid(g)%smoothing_buffer_cat = POP%pop_grid(g)%smoothing_buffer_cat + flux(t) - smoothed_flux POP%pop_grid(g)%cat_mortality_smoothed = smoothed_flux -END SUBROUTINE SMOOTH_FLUX_cat +end subroutine SMOOTH_FLUX_cat !****************************************************************************** -SUBROUTINE REGRESS(x, y, n, a, b, r) +subroutine REGRESS(x, y, n, a, b, r) - IMPLICIT NONE + implicit none - REAL(dp), INTENT(IN) :: x(:), y(:) - REAL(dp), INTENT(OUT) :: a, b, r - INTEGER(i4b), INTENT(IN) :: n - REAL(dp):: sx,sy,sxx,sxy,delta,meanx,meany,sdx,sdy - INTEGER(i4b) :: i + real(dp), intent(IN) :: x(:), y(:) + real(dp), intent(OUT) :: a, b, r + integer(i4b), intent(IN) :: n + real(dp):: sx,sy,sxx,sxy,delta,meanx,meany,sdx,sdy + integer(i4b) :: i ! Performs a linear regression of array y on array x (n values) ! returning parameters a and b in the fitted model: y=a+bx @@ -3521,12 +3537,12 @@ SUBROUTINE REGRESS(x, y, n, a, b, r) sy=0.0_dp sxx=0.0_dp sxy=0.0_dp - DO i=1,n + do i=1,n sx = sx + x(i) sy = sy + y(i) sxx = sxx + x(i) * y(i) sxy = sxy + x(i)*y(i) - ENDDO + enddo delta = real(n,dp)*sxx - sx*sx a=(sxx*sy-sx*sxy)/delta b=(real(n,dp)*sxy-sx*sy)/delta @@ -3534,55 +3550,55 @@ SUBROUTINE REGRESS(x, y, n, a, b, r) meany=sy/real(n,dp) sdx = 0.0_dp sdy = 0.0_dp - DO i=1,n + do i=1,n sdx = sdx + (x(i)-meanx)*(x(i)-meanx) sdy = sdy + (y(i)-meany)*(y(i)-meany) - ENDDO + enddo sdx=sqrt(sdx/real(n-1,dp)) sdy=sqrt(sdy/real(n-1,dp)) if ((abs(sdx) .lt. tiny(0.0_dp)) .or. (abs(sdy) .lt. tiny(0.0_dp))) then r = 0.0_dp else r = b*sdx/sdy - ENDIF + endif -END SUBROUTINE REGRESS +end subroutine REGRESS !****************************************************************************** -REAL(dp) FUNCTION Area_Triangle(x1,y1,x2,y2,x3,y3) +real(dp) function Area_Triangle(x1,y1,x2,y2,x3,y3) - IMPLICIT NONE + implicit none - REAL(dp), INTENT(IN) :: x1, y1, x2, y2, x3, y3 + real(dp), intent(IN) :: x1, y1, x2, y2, x3, y3 area_triangle = abs((x1*(y2-y3) + x2*(y3-y1)+ x3*(y1-y2))/2.0_dp) -END FUNCTION Area_Triangle +end function Area_Triangle !****************************************************************************** ! Fraction of topkill by DBH , according to Fig. 2 of Collins, J. Ec., 2020 -REAL(dp) FUNCTION TopKill_Collins(dbh, FLI) +real(dp) function TopKill_Collins(dbh, FLI) - IMPLICIT NONE + implicit none - REAL(dp), INTENT(IN) :: dbh, FLI - REAL(dp), PARAMETER:: a = 0.79130437_dp, b = 0.07999477_dp, c = 0.06326282_dp + real(dp), intent(IN) :: dbh, FLI + real(dp), parameter:: a = 0.79130437_dp, b = 0.07999477_dp, c = 0.06326282_dp - IF ((FLI > 3000.0_dp).and.(FLI < 7000.0_dp)) then + if ((FLI > 3000.0_dp).and.(FLI < 7000.0_dp)) then TopKill_Collins = 0.08_dp - ELSEIF (FLI > 7000.0_dp) then + elseif (FLI > 7000.0_dp) then TopKill_Collins = max(a * exp(-b * dbh) + c, 0.08_dp) - ELSE ! low intensity fires + else ! low intensity fires TopKill_Collins = 0.0_dp - ENDIF + endif -END FUNCTION TopKill_Collins +end function TopKill_Collins !****************************************************************************** @@ -3592,33 +3608,33 @@ END FUNCTION TopKill_Collins ! Computes tree stem diameter (m) and basal area (m2/ha) ! given height (m), stem biomass (kgC/m2) and tree population density (indiv/m2) -SUBROUTINE Allometry(height,biomass,density,diam,basal) +subroutine Allometry(height,biomass,density,diam,basal) - IMPLICIT NONE + implicit none - REAL(dp), INTENT(IN) :: height - REAL(dp), INTENT(IN) :: biomass - REAL(dp), INTENT(IN) :: density - REAL(dp), INTENT(OUT) :: diam - REAL(dp), INTENT(OUT) :: basal + real(dp), intent(IN) :: height + real(dp), intent(IN) :: biomass + real(dp), intent(IN) :: density + real(dp), intent(OUT) :: diam + real(dp), intent(OUT) :: basal - REAL(dp) :: delta,rh + real(dp) :: delta,rh - delta=2.0_dp*SQRT(biomass/density/WD/PI) - rh=1.0_dp/SQRT(height) + delta=2.0_dp*sqrt(biomass/density/WD/PI) + rh=1.0_dp/sqrt(height) diam=delta*rh basal=PI*(diam/2.0_dp)*(diam/2.0_dp)*density*1.0e4_dp -END SUBROUTINE Allometry +end subroutine Allometry !******************************************************************************* - SUBROUTINE Williams_Allometry(agBiomass, density, height, dbh, basal) + subroutine Williams_Allometry(agBiomass, density, height, dbh, basal) - IMPLICIT NONE + implicit none ! Allometry following Williams 2005, Model 5b (see table 2) ! Williams et al., "Allometry for estimating aboveground tree biomass in tropical ! and subtropical eucalypt woodlands: towards general predictive equations", @@ -3630,12 +3646,12 @@ SUBROUTINE Williams_Allometry(agBiomass, density, height, dbh, basal) ! height : tree height [m] ! dbh : Diameter at breast height [m] ! basal : Basal area [m2/ha] - REAL(dp), INTENT(IN) :: agbiomass, density - REAL(dp), INTENT(OUT):: height, dbh, basal + real(dp), intent(IN) :: agbiomass, density + real(dp), intent(OUT):: height, dbh, basal - REAL(dp), PARAMETER :: beta0 = -2.3046_dp - REAL(dp), PARAMETER :: beta1 = 2.5243_dp - REAL(dp), PARAMETER :: gC2DM = 1.0_dp/0.49_dp ! ratio Dry matter mass to g(C) + real(dp), parameter :: beta0 = -2.3046_dp + real(dp), parameter :: beta1 = 2.5243_dp + real(dp), parameter :: gC2DM = 1.0_dp/0.49_dp ! ratio Dry matter mass to g(C) ! Compute dbh using model 5b and converting from cm -> m dbh = ( agbiomass * gC2DM / density / exp(beta0) ) ** (1.0_dp/beta1) @@ -3647,109 +3663,109 @@ SUBROUTINE Williams_Allometry(agBiomass, density, height, dbh, basal) ! Basal Area [m^2/m^2]->[m^2/ha] basal = basal * 1.0e4_dp - END SUBROUTINE Williams_Allometry + end subroutine Williams_Allometry !******************************************************************************* - SUBROUTINE POP_init(POP, disturbance_interval, np, Iwood, precip) + subroutine POP_init(POP, disturbance_interval, np, Iwood, precip) - USE POP_types, ONLY: POP_TYPE - USE TypeDef, ONLY: i4b + use POP_types, only: POP_TYPE + use TypeDef, only: i4b - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) - INTEGER(i4b), INTENT(IN) :: np - INTEGER(i4b), INTENT(IN) :: Iwood(:) - REAL(dp), INTENT(IN), OPTIONAL :: precip(:) + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: disturbance_interval(:,:) + integer(i4b), intent(IN) :: np + integer(i4b), intent(IN) :: Iwood(:) + real(dp), intent(IN), optional :: precip(:) - INTEGER(i4b) :: j, k + integer(i4b) :: j, k - CALL alloc_POP(pop,int(np)) + call alloc_POP(pop,int(np)) POP%np = np POP%Iwood = Iwood POP%it_pop = 0 ! POP%LU = 1 ! initialise to primary forest POP%pop_grid(:)%LU = 1 - CALL ZeroPOP(pop) + call ZeroPOP(pop) - CALL InitPOP2D_Poisson(pop, INT(disturbance_interval,i4b)) + call InitPOP2D_Poisson(pop, int(disturbance_interval,i4b)) - DO j=1,np - DO k=1,NPATCH2D + do j=1,np + do k=1,NPATCH2D ! understorey recruitment - IF (PRESENT(precip)) THEN - CALL layer_recruitment_single_patch(pop, k, j, precip) - ELSE - CALL layer_recruitment_single_patch(pop, k, j) - ENDIF - ENDDO - ENDDO + if (present(precip)) then + call layer_recruitment_single_patch(pop, k, j, precip) + else + call layer_recruitment_single_patch(pop, k, j) + endif + enddo + enddo - END SUBROUTINE POP_init + end subroutine POP_init !******************************************************************************* - SUBROUTINE POP_init_single(POP, disturbance_interval, n, precip) + subroutine POP_init_single(POP, disturbance_interval, n, precip) - USE POP_types, ONLY: POP_TYPE - USE TypeDef, ONLY: i4b + use POP_types, only: POP_TYPE + use TypeDef, only: i4b - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER(i4b), INTENT(IN) :: disturbance_interval(:,:) - INTEGER(i4b), INTENT(IN) :: n - REAL(dp), INTENT(IN), OPTIONAL :: precip(:) + type(POP_TYPE), intent(INOUT) :: POP + integer(i4b), intent(IN) :: disturbance_interval(:,:) + integer(i4b), intent(IN) :: n + real(dp), intent(IN), optional :: precip(:) - INTEGER(i4b) :: j, k + integer(i4b) :: j, k POP%it_pop(n) = 0 - CALL ZeroPOP(pop, n) + call ZeroPOP(pop, n) - CALL InitPOP2D_Poisson(pop, INT(disturbance_interval,i4b), n) + call InitPOP2D_Poisson(pop, int(disturbance_interval,i4b), n) - DO j=n,n - DO k=1,NPATCH2D + do j=n,n + do k=1,NPATCH2D ! understorey recruitment - IF (PRESENT(precip)) THEN - CALL layer_recruitment_single_patch(pop, k, j, precip) - ELSE - CALL layer_recruitment_single_patch(pop, k, j) - ENDIF - ENDDO - ENDDO + if (present(precip)) then + call layer_recruitment_single_patch(pop, k, j, precip) + else + call layer_recruitment_single_patch(pop, k, j) + endif + enddo + enddo - END SUBROUTINE POP_init_single + end subroutine POP_init_single !******************************************************************************* - SUBROUTINE alloc_POP(POP, arraysize) + subroutine alloc_POP(POP, arraysize) - USE POP_Types, Only: POP_TYPE + use POP_Types, only: POP_TYPE - IMPLICIT NONE + implicit none - TYPE(POP_TYPE), INTENT(INOUT) :: POP - INTEGER, INTENT(IN) :: arraysize + type(POP_TYPE), intent(INOUT) :: POP + integer, intent(IN) :: arraysize - IF (.NOT. ALLOCATED(POP%POP_Grid)) ALLOCATE(POP%POP_Grid(arraysize)) - IF (.NOT. ALLOCATED(POP%Iwood)) ALLOCATE(POP%Iwood(arraysize)) + if (.not. allocated(POP%POP_Grid)) allocate(POP%POP_Grid(arraysize)) + if (.not. allocated(POP%Iwood)) allocate(POP%Iwood(arraysize)) ! IF (.NOT. ALLOCATED(POP%LU)) ALLOCATE (POP%LU(arraysize)) - IF (.NOT. ALLOCATED(POP%it_pop)) ALLOCATE(POP%it_pop(arraysize)) + if (.not. allocated(POP%it_pop)) allocate(POP%it_pop(arraysize)) - END SUBROUTINE alloc_POP + end subroutine alloc_POP !******************************************************************************* -END MODULE POPModule +end module POPModule !******************************************************************************* diff --git a/core/biogeochem/casa_cable.F90 b/core/biogeochem/casa_cable.F90 index 65b522ed1..2ff0f8741 100644 --- a/core/biogeochem/casa_cable.F90 +++ b/core/biogeochem/casa_cable.F90 @@ -152,22 +152,27 @@ SUBROUTINE bgcdriver(ktau,kstart,dels,met,ssnow,canopy,veg,soil, & if (cable_user%c13o2) call c13o2_update_pools(casasave, casaflux, c13o2flux, c13o2pools) #endif + !changes here to accomodate %potstemnpp - 5/4/2024 - svn 9218 IF (cable_user%CALL_POP) THEN ! accumulate annual variables for use in POP IF (MOD(ktau/ktauday,LOY)==1 ) THEN casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_r_2 ! (assumes 70% of wood NPP is allocated above ground) + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(LOY,r_2) / 1000.0_r_2 casabal%Crootmean = casapool%cplant(:,3) / real(LOY,r_2) / 1000.0_r_2 ELSE casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_r_2 + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_r_2 + & + casaflux%fracClabile * casaflux%cgpp ) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(LOY,r_2) / 1000.0_r_2 casabal%Crootmean = casabal%Crootmean + casapool%cplant(:,3) / real(LOY,r_2) / 1000.0_r_2 ENDIF ELSE casaflux%stemnpp = 0.0_r_2 + casaflux%potstemnpp = 0.0_r_2 ENDIF ! CALL_POP ENDIF ! icycle > 0 @@ -193,22 +198,27 @@ SUBROUTINE bgcdriver(ktau,kstart,dels,met,ssnow,canopy,veg,soil, & if (cable_user%c13o2) call c13o2_update_pools(casasave, casaflux, c13o2flux, c13o2pools) #endif + !changes here to accomodate %potstemnpp - 5/4/2024 - svn 9635 IF (cable_user%CALL_POP) THEN ! accumulate annual variables for use in POP IF (MOD(ktau/ktauday,LOY)==1) THEN casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_r_2 ! (assumes 70% of wood NPP is allocated above ground) + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(LOY,r_2) / 1000.0_r_2 casabal%Crootmean = casapool%cplant(:,3) / real(LOY,r_2) / 1000.0_r_2 ELSE casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_r_2 + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + & + casaflux%fracClabile * casaflux%cgpp ) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(LOY,r_2) / 1000.0_r_2 casabal%Crootmean = casabal%Crootmean + casapool%cplant(:,3) / real(LOY,r_2) / 1000.0_r_2 ENDIF ELSE casaflux%stemnpp = 0.0_r_2 + casaflux%potstemnpp = 0.0_r_2 ENDIF ! CALL_POP ENDIF ! end of day @@ -239,6 +249,7 @@ SUBROUTINE POPdriver(casaflux, casabal, veg, POP) type(POP_TYPE), INTENT(INOUT) :: POP real(dp) :: StemNPP(mp,2) + real(dp) :: PotStemNPP(mp) real(dp), allocatable :: NPPtoGPP(:) real(dp), allocatable :: LAImax(:), Cleafmean(:), Crootmean(:) !! vh_js !! @@ -255,6 +266,11 @@ SUBROUTINE POPdriver(casaflux, casabal, veg, POP) StemNPP(:,1) = casaflux%stemnpp StemNPP(:,2) = 0.0_dp + !changes due to PotStemNPP - 5/4/2024 - svn 9635 + !JK: define an unstressed (potential) stem NPP that could be achieved + ! in the absence of nutrient limitation. PotStemNPP used only + ! for the calculation of stress (=resource) mortality in POP. + PotStemNPP(:) = casaflux%potstemnpp where (casabal%FCgppyear > 1.e-5_dp .and. casabal%FCnppyear > 1.e-5_dp) NPPtoGPP = casabal%FCnppyear / casabal%FCgppyear elsewhere @@ -264,9 +280,10 @@ SUBROUTINE POPdriver(casaflux, casabal, veg, POP) Cleafmean = casabal%cleafmean Crootmean = casabal%Crootmean + !changes due to PotStemNPP - 5/4/2024 CALL POPStep(pop, max(StemNPP(Iw,:)/1000.0_dp, 0.0001_dp), int(veg%disturbance_interval(Iw,:), i4b), & real(veg%disturbance_intensity(Iw,:), dp), & - max(LAImax(Iw), 0.001_dp), Cleafmean(Iw), Crootmean(Iw), NPPtoGPP(Iw)) + max(LAImax(Iw), 0.001_dp), Cleafmean(Iw), Crootmean(Iw), NPPtoGPP(Iw), max(PotStemNPP(Iw)/1000.0_dp,0.0001_dp) ) endif ! CALL_POP END SUBROUTINE POPdriver @@ -832,15 +849,19 @@ SUBROUTINE casa_feedback(ktau,veg,casabiome,casapool,casamet,climate,ktauday) ! nleafx = ncleafx/sla ! ncleafx = (casabiome%ratioNCplantmin(ivt,leaf) + casabiome%ratioNCplantmax(ivt,leaf)) / 2.0_r_2 if (icycle>1) then - vcmax_ref(np) = real( vcmax_np(((casabiome%ratioNCplantmin(ivt,leaf) + casabiome%ratioNCplantmax(ivt,leaf)) / 2.0_r_2) / & - casabiome%sla(ivt), pleafx(np)) * casabiome%vcmax_scalar(ivt) ) + vcmax_ref(np) = real( vcmax_np(((casabiome%ratioNCplantmin(ivt,leaf) + & + casabiome%ratioNCplantmax(ivt,leaf)) / 2.0_r_2) / & + casabiome%sla(ivt), pleafx(np)) * casabiome%vcmax_scalar(ivt) ) endif if (icycle>2) then ! pleaf = nleafx / npleafx ! npleafx = casabiome%ratioNPplantmin(ivt,leaf) + casabiome%ratioNPplantmax(ivt,leaf)) / 2.0_r_2 - vcmax_ref(np) = real( vcmax_np(((casabiome%ratioNCplantmin(ivt,leaf) + casabiome%ratioNCplantmax(ivt,leaf)) / 2.0_r_2) / & - casabiome%sla(ivt), ((casabiome%ratioNCplantmin(ivt,leaf) + casabiome%ratioNCplantmax(ivt,leaf)) / 2.0_r_2) / & - casabiome%sla(ivt)/(casabiome%ratioNPplantmin(ivt,leaf) + casabiome%ratioNPplantmax(ivt,leaf)) / 2.0_r_2) * casabiome%vcmax_scalar(ivt) ) + vcmax_ref(np) = real( vcmax_np(((casabiome%ratioNCplantmin(ivt,leaf) + & + casabiome%ratioNCplantmax(ivt,leaf)) / 2.0_r_2) / & + casabiome%sla(ivt), ((casabiome%ratioNCplantmin(ivt,leaf) + & + casabiome%ratioNCplantmax(ivt,leaf)) / 2.0_r_2) / & + casabiome%sla(ivt)/(casabiome%ratioNPplantmin(ivt,leaf) + & + casabiome%ratioNPplantmax(ivt,leaf)) / 2.0_r_2) * casabiome%vcmax_scalar(ivt) ) endif endif diff --git a/core/biogeochem/casa_cnp.F90 b/core/biogeochem/casa_cnp.F90 index c44cb3ad9..8d68fe75b 100644 --- a/core/biogeochem/casa_cnp.F90 +++ b/core/biogeochem/casa_cnp.F90 @@ -1360,8 +1360,8 @@ SUBROUTINE casa_delplant(veg, casabiome, casapool, casaflux, casamet, & do nP=1, mplant casaflux%FluxFromPtoCO2(npt,nP) = & (1.0_r_2-casaflux%kplant(npt,nP)) * casaflux%kplant_fire(npt,nP) * & - casapool%cplant(npt,nP) * & - (1.0_r_2 - sum(casaflux%fromPtoL_fire(npt,:,nP))) + casapool%cplant(npt,nP) !CLN * & Shouldn't it be min(1-casaflux%kplant,X)??? + !CLN should be considered in kplant_fire ??? (1.0_r_2 - sum(casaflux%fromPtoL_fire(npt,:,nP))) casaflux%fluxCtoCO2_plant_fire(npt) = casaflux%fluxCtoCO2_plant_fire(npt) + & casaflux%FluxFromPtoCO2(npt,nP) enddo diff --git a/core/biogeochem/casa_inout.F90 b/core/biogeochem/casa_inout.F90 index fe6c89c1c..435ff913d 100644 --- a/core/biogeochem/casa_inout.F90 +++ b/core/biogeochem/casa_inout.F90 @@ -1876,21 +1876,28 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao integer, parameter :: sp = kind(1.0) ! 1 dim arrays (mp) - character(len=20), dimension(2) :: a0 + character(len=22), dimension(2) :: a0 + !INH BLAZE + !! 2 dim arrays (mp,t) + !character(len=22), dimension(51) :: a1 + !! 3 dim arrays (mp,mplant,t) + !character(len=22), dimension(10) :: a2 + !! 3 dim arrays (mp,mlitter,t) + !character(len=22), dimension(10) :: a3 ! 2 dim arrays (mp,t) - character(len=20), dimension(51) :: a1 + character(len=22), dimension(53) :: a1 ! 3 dim arrays (mp,mplant,t) - character(len=20), dimension(9) :: a2 + character(len=22), dimension(9) :: a2 ! 3 dim arrays (mp,mlitter,t) - character(len=20), dimension(9) :: a3 + character(len=22), dimension(9) :: a3 ! 3 dim arrays (mp,msoil,t) - character(len=20), dimension(8) :: a4 + character(len=22), dimension(8) :: a4 ! 4 dim arrays (mp,mlitter,mplant,t) - character(len=20), dimension(1) :: a5 + character(len=22), dimension(1) :: a5 ! 4 dim arrays (mp,msoil,mlitter,t) - character(len=20), dimension(1) :: a6 + character(len=22), dimension(1) :: a6 ! 4 dim arrays (mp,msoil,msoil,t) - character(len=20), dimension(1) :: a7 + character(len=22), dimension(1) :: a7 integer, dimension(size(a0)), save :: vid0 integer, dimension(size(a1)), save :: vid1 @@ -1930,43 +1937,46 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao a1(17) = 'FCrsyear' a1(18) = 'FCNeeyear' a1(19) = 'vcmax' - na1 = 19 + !INH BLAZE na1 = 19 + a1(20) = 'fluxCtoCO2_plant_fire' + a1(21) = 'fluxCtoCO2_litter_fire' + na1 = 21 ! N - a1(20) = 'sumnbal' - a1(21) = 'Nminfix' - a1(22) = 'Nmindep' - a1(23) = 'Nminloss' - a1(24) = 'Nminleach' - a1(25) = 'Nupland' - a1(26) = 'Nlittermin' - a1(27) = 'Nsmin' - a1(28) = 'Nsimm' - a1(29) = 'Nsnet' - a1(30) = 'fNMinloss' - a1(31) = 'Nsoilmin' - if (icycle==2) na1 = 31 + a1(22) = 'sumnbal' + a1(23) = 'Nminfix' + a1(24) = 'Nmindep' + a1(25) = 'Nminloss' + a1(26) = 'Nminleach' + a1(27) = 'Nupland' + a1(28) = 'Nlittermin' + a1(29) = 'Nsmin' + a1(30) = 'Nsimm' + a1(31) = 'Nsnet' + a1(32) = 'fNMinloss' + a1(33) = 'Nsoilmin' + if (icycle==2) na1 = 33 ! P - a1(32) = 'psoillab' - a1(33) = 'psoilsorb' - a1(34) = 'psoilocc' - a1(35) = 'sumpbal' - a1(36) = 'Plabuptake' - a1(37) = 'Pdep' - a1(38) = 'pwea' - a1(39) = 'Pleach' - a1(40) = 'Ploss' - a1(41) = 'Pupland' - a1(42) = 'Plittermin' - a1(43) = 'Psmin' - a1(44) = 'Psimm' - a1(45) = 'Psnet' - a1(46) = 'fPleach' - a1(47) = 'kPlab' - a1(48) = 'kPsorb' - a1(49) = 'kpocc' - a1(50) = 'kmlabP' - a1(51) = 'Psorbmax' - if (icycle==3) na1 = 51 + a1(34) = 'psoillab' + a1(35) = 'psoilsorb' + a1(36) = 'psoilocc' + a1(37) = 'sumpbal' + a1(38) = 'Plabuptake' + a1(39) = 'Pdep' + a1(40) = 'pwea' + a1(41) = 'Pleach' + a1(42) = 'Ploss' + a1(43) = 'Pupland' + a1(44) = 'Plittermin' + a1(45) = 'Psmin' + a1(46) = 'Psimm' + a1(47) = 'Psnet' + a1(48) = 'fPleach' + a1(49) = 'kPlab' + a1(50) = 'kPsorb' + a1(51) = 'kpocc' + a1(52) = 'kmlabP' + a1(53) = 'Psorbmax' + if (icycle==3) na1 = 53 ! C a2(1) = 'cplant' @@ -1974,15 +1984,17 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao a2(3) = 'kplant' a2(4) = 'Crmplant' a2(5) = 'kplant_fire' + !INH BLAZE a2(6) = 'fluxCtoCO2_plant_fire' + !na2 = 6 na2 = 5 ! N a2(6) = 'nplant' a2(7) = 'fracNalloc' - if (icycle==2) na2 = 7 + if (icycle==2) na2 = na2 + 2 ! P a2(8) = 'pplant' - a2(9) = 'fracPalloc' - if (icycle==3) na2 = 9 + a2(9)= 'fracPalloc' + if (icycle==3) na2 = na2 + 2 ! C a3(1) = 'clitter' @@ -1990,15 +2002,17 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao a3(3) = 'fromLtoCO2' a3(4) = 'FluxCtolitter' a3(5) = 'klitter_fire' + !INH BLAZE a3(6) = 'fluxCtoCO2_litter_fire' + !na3 = 6 na3 = 5 ! N a3(6) = 'nlitter' a3(7) = 'FluxNtolitter' - if (icycle==2) na3 = 7 + if (icycle==2) na3 = na3 + 2 ! P a3(8) = 'plitter' - a3(9) = 'FluxPtolitter' - if (icycle==3) na3 = 9 + a3(9)= 'FluxPtolitter' + if (icycle==3) na3 = na3 + 2 ! C a4(1) = 'csoil' @@ -2221,74 +2235,80 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao if(status /= nf90_noerr) call handle_err(status) status = nf90_put_var(file_id, vid1(19), real(veg%vcmax,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) + !INH BLAZE edits from here down + status = nf90_put_var(file_id, vid1(20), real(casaflux%fluxCtoCO2_plant_fire,sp), start=(/1,cnt/), count=(/mp,1/) ) + if(status /= nf90_noerr) call handle_err(status) + status = nf90_put_var(file_id, vid1(21), real(casaflux%fluxCtoCO2_litter_fire,sp), start=(/1,cnt/), count=(/mp,1/) ) + if(status /= nf90_noerr) call handle_err(status) ! N if (icycle > 1) then - status = nf90_put_var(file_id, vid1(20), real(casabal%sumnbal,sp), start=(/1,cnt/), count=(/mp,1/) ) + !INH BLAZE added 2 to indexes in vid1 + status = nf90_put_var(file_id, vid1(22), real(casabal%sumnbal,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(21), real(casaflux%nminfix,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(23), real(casaflux%nminfix,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(22), real(casaflux%nmindep,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(24), real(casaflux%nmindep,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(23), real(casaflux%nminloss,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(25), real(casaflux%nminloss,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(24), real(casaflux%nminleach,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(26), real(casaflux%nminleach,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(25), real(casaflux%nupland,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(27), real(casaflux%nupland,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(26), real(casaflux%nlittermin,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(28), real(casaflux%nlittermin,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(27), real(casaflux%nsmin,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(29), real(casaflux%nsmin,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(28), real(casaflux%nsimm,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(30), real(casaflux%nsimm,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(29), real(casaflux%nsnet,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(31), real(casaflux%nsnet,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(30), real(casaflux%fnminloss,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(32), real(casaflux%fnminloss,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(31), real(casapool%nsoilmin,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(33), real(casapool%nsoilmin,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) endif ! P if (icycle > 2) then - status = nf90_put_var(file_id, vid1(32), real(casapool%psoillab,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(34), real(casapool%psoillab,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(33), real(casapool%psoilsorb,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(35), real(casapool%psoilsorb,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(34), real(casapool%psoilocc,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(36), real(casapool%psoilocc,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(35), real(casabal%sumpbal,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(37), real(casabal%sumpbal,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(36), real(casaflux%plabuptake,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(38), real(casaflux%plabuptake,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(37), real(casaflux%pdep,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(39), real(casaflux%pdep,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(38), real(casaflux%pwea,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(40), real(casaflux%pwea,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(39), real(casaflux%pleach,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(41), real(casaflux%pleach,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(40), real(casaflux%ploss,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(42), real(casaflux%ploss,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(41), real(casaflux%pupland,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(43), real(casaflux%pupland,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(42), real(casaflux%plittermin,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(44), real(casaflux%plittermin,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(43), real(casaflux%psmin,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(45), real(casaflux%psmin,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(44), real(casaflux%psimm,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(46), real(casaflux%psimm,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(45), real(casaflux%psnet,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(47), real(casaflux%psnet,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(46), real(casaflux%fpleach,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(48), real(casaflux%fpleach,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(47), real(casaflux%kplab,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(49), real(casaflux%kplab,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(48), real(casaflux%kpsorb,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(50), real(casaflux%kpsorb,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(49), real(casaflux%kpocc,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(51), real(casaflux%kpocc,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(50), real(casaflux%kmlabp,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(52), real(casaflux%kmlabp,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) - status = nf90_put_var(file_id, vid1(51), real(casaflux%psorbmax,sp), start=(/1,cnt/), count=(/mp,1/) ) + status = nf90_put_var(file_id, vid1(53), real(casaflux%psorbmax,sp), start=(/1,cnt/), count=(/mp,1/) ) if(status /= nf90_noerr) call handle_err(status) endif @@ -2304,6 +2324,10 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao if(status /= nf90_noerr) call handle_err(status) status = nf90_put_var(file_id, vid2(5), real(casaflux%kplant_fire,sp), start=(/1,1,cnt/), count=(/mp,mplant,1/)) if(status /= nf90_noerr) call handle_err(status) + !INH BLAZE + !status = nf90_put_var(file_id, vid2(6), real(casaflux%fluxCtoCO2_plant_fire,sp), & + ! start=(/1,1,cnt/), count=(/mp,mplant,1/)) + !if(status /= nf90_noerr) call handle_err(status) ! N if (icycle > 1) then status = nf90_put_var(file_id, vid2(6), real(casapool%nplant,sp), start=(/1,1,cnt/), count=(/mp,mplant,1/)) @@ -2331,6 +2355,10 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao if(status /= nf90_noerr) call handle_err(status) status = nf90_put_var(file_id, vid3(5), real(casaflux%klitter_fire,sp), start=(/1,1,cnt/), count=(/mp,mlitter,1/)) if(status /= nf90_noerr) call handle_err(status) + !INH BLAZE + !status = nf90_put_var(file_id, vid3(6), real(casaflux%fluxCtoCO2_litter_fire,sp), & + ! start=(/1,1,cnt/), count=(/mp,mlitter,1/)) + !if(status /= nf90_noerr) call handle_err(status) ! N if (icycle > 1) then status = nf90_put_var(file_id, vid3(6), real(casapool%nlitter,sp), start=(/1,1,cnt/), count=(/mp,mlitter,1/)) @@ -2393,7 +2421,7 @@ subroutine write_casa_output_nc(veg, casamet, casapool, casabal, casaflux, casao if (status /= nf90_noerr) call handle_err(status) write(*,*) " casa output written to ", trim(fname) endif - + end subroutine write_casa_output_nc #endif diff --git a/core/biogeochem/casa_variable.F90 b/core/biogeochem/casa_variable.F90 index fc5a96fb2..beb925d67 100644 --- a/core/biogeochem/casa_variable.F90 +++ b/core/biogeochem/casa_variable.F90 @@ -232,6 +232,7 @@ MODULE casavariable fracClabile => null(), & !! vh_js !! the 3 variables below are needed for POP coupling to CASA stemnpp => null(), & + potstemnpp => null(), & frac_sapwood => null(), & sapwood_area => null(), & Charvest => null(), & ! leaf biomass removed due to crop or pasture management @@ -645,6 +646,7 @@ SUBROUTINE alloc_casaflux(casaflux, arraysize) casaflux%fromLtoCO2(arraysize,mlitter), & casaflux%fromStoCO2(arraysize,msoil), & casaflux%stemnpp(arraysize), & + casaflux%potstemnpp(arraysize), & casaflux%frac_sapwood(arraysize), & casaflux%sapwood_area(arraysize), & casaflux%fharvest(arraysize), & @@ -1132,6 +1134,7 @@ subroutine zero_casaflux(casaflux) casaflux%fromLtoCO2 = 0.0_r_2 casaflux%fromStoCO2 = 0.0_r_2 casaflux%stemnpp = 0.0_r_2 + casaflux%potstemnpp = 0.0_r_2 casaflux%frac_sapwood = 0.0_r_2 casaflux%sapwood_area = 0.0_r_2 casaflux%fharvest = 0.0_r_2 @@ -1463,6 +1466,7 @@ subroutine print_casaflux(casaflux) write(*,*) 'fromLtoCO2 ', casaflux%fromLtoCO2 write(*,*) 'fromStoCO2 ', casaflux%fromStoCO2 write(*,*) 'stemnpp ', casaflux%stemnpp + write(*,*) 'potstemnpp', casaflux%potstemnpp write(*,*) 'frac_sapwood ', casaflux%frac_sapwood write(*,*) 'sapwood_area ', casaflux%sapwood_area write(*,*) 'fharvest ', casaflux%fharvest @@ -1872,6 +1876,7 @@ SUBROUTINE update_sum_casa(sum_casapool, sum_casaflux, casapool, casaflux, sum_n sum_casaflux%fromLtoCO2 = sum_casaflux%fromLtoCO2 + casaflux%fromLtoCO2 sum_casaflux%fromStoCO2 = sum_casaflux%fromStoCO2 + casaflux%fromStoCO2 sum_casaflux%stemnpp = sum_casaflux%stemnpp + casaflux%stemnpp + sum_casaflux%potstemnpp = sum_casaflux%stemnpp + casaflux%potstemnpp sum_casaflux%frac_sapwood = sum_casaflux%frac_sapwood + casaflux%frac_sapwood sum_casaflux%sapwood_area = sum_casaflux%sapwood_area + casaflux%sapwood_area sum_casaflux%Cplant_turnover = & @@ -2026,6 +2031,7 @@ SUBROUTINE update_sum_casa(sum_casapool, sum_casaflux, casapool, casaflux, sum_n sum_casaflux%fromLtoCO2 = sum_casaflux%fromLtoCO2 * rnsteps sum_casaflux%fromStoCO2 = sum_casaflux%fromStoCO2 * rnsteps sum_casaflux%stemnpp = sum_casaflux%stemnpp * rnsteps + sum_casaflux%potstemnpp = sum_casaflux%potstemnpp * rnsteps sum_casaflux%frac_sapwood = sum_casaflux%frac_sapwood * rnsteps sum_casaflux%sapwood_area = sum_casaflux%sapwood_area * rnsteps sum_casaflux%Cplant_turnover = & @@ -2067,6 +2073,7 @@ SUBROUTINE update_sum_casa(sum_casapool, sum_casaflux, casapool, casaflux, sum_n sum_casaflux%FluxFromPtoHarvest = sum_casaflux%FluxFromPtoHarvest * rnsteps endif ! average_now + END SUBROUTINE update_sum_casa diff --git a/core/biogeochem/spincasacnp.F90 b/core/biogeochem/spincasacnp.F90 index f5fdf8d2b..6d1cf3696 100755 --- a/core/biogeochem/spincasacnp.F90 +++ b/core/biogeochem/spincasacnp.F90 @@ -248,17 +248,22 @@ SUBROUTINE spincasacnp(dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & if (mod(ktau/ktauday,LOY) == 1) then ! (assumes 70% of wood NPP is allocated above ground) casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(LOY,dp) / 1000._dp casabal%Crootmean = casapool%cplant(:,3) / real(LOY,dp) / 1000._dp else casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + & + casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(LOY,dp) / 1000.0_dp casabal%Crootmean = casabal%Crootmean + casapool%cplant(:,3) / real(LOY,dp) / 1000.0_dp endif else casaflux%stemnpp = 0.0_dp + casaflux%potstemnpp = 0.0_dp !#9238 endif ! CALL_POP !CALL WRITE_CASA_OUTPUT_NC (veg, casamet, casapool, casabal, casaflux, & @@ -529,17 +534,23 @@ SUBROUTINE spincasacnp(dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & IF (MOD(ktau/ktauday,LOY) == 1) THEN ! (assumes 70% of wood NPP is allocated above ground) casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(LOY,dp) / 1000.0_dp casabal%Crootmean = casapool%cplant(:,3) / real(LOY,dp) / 1000.0_dp ELSE casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + & + casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(LOY,dp) / 1000.0_dp casabal%Crootmean = casabal%Crootmean + casapool%cplant(:,3) / real(LOY,dp) / 1000.0_dp ENDIF ELSE casaflux%stemnpp = 0.0_dp + casaflux%potstemnpp = 0.0_dp !#9238 ENDIF ! CALL_POP IF (idoy==mdyear) THEN ! end of year diff --git a/core/biogeophys/cable_canopy.F90 b/core/biogeophys/cable_canopy.F90 index 33515d55a..3ae4ef7a4 100644 --- a/core/biogeophys/cable_canopy.F90 +++ b/core/biogeophys/cable_canopy.F90 @@ -582,6 +582,10 @@ SUBROUTINE define_canopy(bal, rad, rough, air, met, dels, ssnow, soil, veg, cano real(canopy%fes(j))/ssnow%potev(j) ) ) ) ENDDO + ! INH #335 - we don't need to weight components of %epot by %transd + ! however coupled model uses %wetfac_cs so overwrite here before testing in ACCESS + canopy%epot = (canopy%fevw_pot + ssnow%potev/ssnow%cls) * dels/air%rlam + CALL update_zetar() END DO ! do iter = 1, NITER @@ -1633,6 +1637,23 @@ SUBROUTINE dryLeaf( dels, rad, air, met, & sum_rad_rniso = SUM(rad%rniso,2) sum_rad_gradis = SUM(rad%gradis,2) + ! default for variable d_3 of RuBP-limited photosynthesis of + ! Wang and Leuning (1998), which is 2 * Gamma^star + if (cable_user%explicit_gm) then + if (trim(cable_user%Rubisco_parameters) == 'Bernacchi_2002') then + gam0 = C%gam0cc + egam = C%egamcc + else if (trim(cable_user%Rubisco_parameters) == 'Walker_2013') then + gam0 = C%gam0ccw + egam = C%egamccw + endif + else + gam0 = C%gam0 + egam = C%egam + endif + cx2(:) = 2.0 * gam0 * exp( egam / (C%rgas * C%trefk) & + * (1.0 - C%trefk / tlfx(:)) ) + DO kk=1,mp IF(canopy%vlaiw(kk) <= C%LAI_THRESH) THEN @@ -1649,6 +1670,9 @@ SUBROUTINE dryLeaf( dels, rad, air, met, & deltlfy = abs_deltlf k = 0 + !CLN as yet uninitialised + cx2(:) = 0. + !kdcorbin, 08/10 - doing all points all the time DO WHILE (k < C%MAXITER) k = k + 1 @@ -1792,8 +1816,8 @@ SUBROUTINE dryLeaf( dels, rad, air, met, & ! + C%gam2 * tdiff(i) * tdiff(i) ) cx2(i) = 2.0 * gam0 * EXP( ( egam / (C%rgas*C%trefk) ) & * ( 1.0 - C%trefk/tlfx(i) ) ) - - ! All equations below in appendix E in Wang and Leuning 1998 are + + ! All equations below in appendix E in Wang and Leuning 1998 are ! for calculating anx, csx and gswx for Rubisco limited, ! RuBP limited, sink limited. ! JK: vx4 changed to correspond to formulation in Collatz et al. 1992 @@ -2672,6 +2696,9 @@ FUNCTION xgmesT(x) RESULT(z) real :: EHa, EHd, Entrop real :: xgmes +#ifdef __MPI__ + integer :: ierr +#endif if (trim(cable_user%Rubisco_parameters) == 'Bernacchi_2002') then EHa = 49.6e3 ! J/mol @@ -2681,6 +2708,12 @@ FUNCTION xgmesT(x) RESULT(z) EHa = 7.4e3 ! J/mol EHd = 434.0e3 ! J/mol Entrop = 1.4e3 ! J/mol/K + else +#ifdef __MPI__ + call MPI_Abort(0, 926, ierr) ! Do not know comm nor rank here +#else + stop 926 +#endif endif CALL point2constants(C) diff --git a/core/biogeophys/cable_common.F90 b/core/biogeophys/cable_common.F90 index 92b024985..d0ce1c313 100644 --- a/core/biogeophys/cable_common.F90 +++ b/core/biogeophys/cable_common.F90 @@ -136,8 +136,6 @@ MODULE cable_common_module REAL :: & dva_T_perturbation = 1.0, & Ta_perturbation = 1.0 - CHARACTER(len=6) :: SIMFIRE_REGION = "ANZ" ! either GLOBAL, EUROPE, ANZ - CHARACTER(len=7) :: burnt_area = "SIMFIRE" ! either SIMFIRE !--- LN ------------------------------------------ CHARACTER(LEN=5) :: RUN_DIAG_LEVEL @@ -982,4 +980,20 @@ FUNCTION Esatf(TC) END FUNCTION Esatf +!CLN SUBROUTINE PRINT_PER_PROC(TXT) +!CLN +!CLN ! Write out process specific output into files called +!CLN ! "cable_log_"//cRank as defined in +!CLN USE cable_IO_vars_module, ONLY: wlogn +!CLN +!CLN IMPLICIT NONE +!CLN CHARACTER(LEN=200) :: TXT +!CLN +!CLN#ifndef __MPI__ +!CLN RETURN +!CLN#endif +!CLN +!CLN END SUBROUTINE PRINT_PER_PROC + + END MODULE cable_common_module diff --git a/core/blaze/blaze.F90 b/core/blaze/blaze.F90 index 488e4bb2f..9b8f4326f 100644 --- a/core/blaze/blaze.F90 +++ b/core/blaze/blaze.F90 @@ -15,8 +15,12 @@ MODULE BLAZE_MOD !CRM INTEGER :: IGNITION ! 0=GFED3, 1=SIMFIRE REAL :: FT,tstp LOGICAL :: USE_POP = .FALSE., ERR=.FALSE. - CHARACTER :: GFEDP*80, FSTEP*7, BURNT_AREA_SRC*10 + CHARACTER :: GFEDP*80, FSTEP*7 CHARACTER(LEN=4) :: OUTMODE = "full" !"std" ! "full" for diagnostical purposes + CHARACTER(len=8) :: BLAZE_TSTEP = "annually" ! Call frequency ("daily","monthly","annually") + CHARACTER(len=6) :: SIMFIRE_REGION = "GLOBAL" ! either GLOBAL, EUROPE, ANZ + CHARACTER(len=7) :: BURNT_AREA_SRC = "SIMFIRE" ! either SIMFIRE or NONE !CLN for now! + INTEGER :: IAM ! number of master/worker for diagnostic output reasons END TYPE TYPE_BLAZE TYPE TYPE_TURNOVER @@ -26,6 +30,7 @@ MODULE BLAZE_MOD REAL, DIMENSION(:,:), ALLOCATABLE :: BLAZEFLX ! To BLAZE!!! INTEGER, PARAMETER :: NTO = 7 ! Number of TurnOver Parameters ,i.e. #lines below +INTEGER, PARAMETER :: NFLUXES = 14! Number of FLUXES in BLAZE output INTEGER, PARAMETER :: LEAF = 1 INTEGER, PARAMETER :: WOOD = 2 INTEGER, PARAMETER :: FROOT = 3 @@ -85,18 +90,18 @@ SUBROUTINE INI_BLAZE ( np, LAT, LON, BLAZE) INTEGER , INTENT(IN) :: np REAL, DIMENSION(np), INTENT(IN) :: LAT, LON TYPE(TYPE_BLAZE) , INTENT(INOUT) :: BLAZE - INTEGER, PARAMETER :: NPOOLS = 3 - CHARACTER(len=400) :: HydePath, BurnedAreaFile, & - BurnedAreaClimatologyFile, SIMFIRE_REGION - CHARACTER(len=10) :: BurnedAreaSource + INTEGER, PARAMETER :: NPOOLS = 3 + CHARACTER(len=400) :: BurnedAreaFile = "", OutputMode="full" + CHARACTER(len=10) :: BurnedAreaSource = "SIMFIRE", blazeTStep = "annually" INTEGER :: iu - NAMELIST /BLAZENML/ HydePath, BurnedAreaSource, BurnedAreaFile, BurnedAreaClimatologyFile, & - SIMFIRE_REGION - + !CLNNAMELIST /BLAZENML/ HydePath, BurnedAreaSource, BurnedAreaFile, BurnedAreaClimatologyFile, & + !CLN SIMFIRE_REGION + NAMELIST /BLAZENML/ blazeTStep, BurnedAreaSource, BurnedAreaFile, OutputMode + ! READ BLAZE settings CALL GET_UNIT(iu) - OPEN (iu,FILE="BLAZE.nml",STATUS='OLD',ACTION='READ') + OPEN (iu,FILE="blaze.nml",STATUS='OLD',ACTION='READ') READ (iu,NML=BLAZENML) CLOSE(iu) @@ -139,13 +144,16 @@ SUBROUTINE INI_BLAZE ( np, LAT, LON, BLAZE) ALLOCATE ( BLAZE%POP_TO ( np ) ) ALLOCATE ( BLAZE%POP_CWD ( np ) ) ALLOCATE ( BLAZE%POP_STR ( np ) ) - ALLOCATE ( BLAZE%FLUXES ( np, 13 ) ) + ALLOCATE ( BLAZE%FLUXES ( np, NFLUXES ) ) ALLOCATE( BLAZE%AGLit_g(np,NPOOLS),BLAZE%AGLit_w(np,NPOOLS) ) ALLOCATE( BLAZE%BGLit_g(np,NPOOLS),BLAZE%BGLit_w(np,NPOOLS) ) ALLOCATE( BLAZE%CPLANT_g(np,NPOOLS),BLAZE%CPLANT_w(np,NPOOLS) ) call zero_blaze(BLAZE) + + BLAZE%BURNT_AREA_SRC = trim(BurnedAreaSource) + BLAZE%OUTMODE = TRIM(OutputMode) ! SETTINGS FOR BLAZE (BLAZEFLAG) ! bit value: 0 | 1 @@ -157,10 +165,10 @@ SUBROUTINE INI_BLAZE ( np, LAT, LON, BLAZE) ! BLAZE(+1) with FLI-only(+0) and SIMFIRE(+4) -> BLAZEFLAG=5 ! BLAZE(+1) full (+2) with GFED (+0) -> BLAZEFLAG=3 - - BLAZE%BURNMODE = 1 ! Full. All Fluxes computed by BLAZE + BLAZE%BURNMODE = 2 ! Full. All Fluxes computed by BLAZE WRITE(*,*) " BLAZE: Full Mode" WRITE(*,*) " Burnt-area source: ", TRIM(BurnedAreaSource) + WRITE(*,*) " BLAZE output mode: ", TRIM(OutputMode) BLAZE%DSLR = 0 BLAZE%RAINF = 0. @@ -168,7 +176,7 @@ SUBROUTINE INI_BLAZE ( np, LAT, LON, BLAZE) BLAZE%KBDI = 0. BLAZE%AB = 0. BLAZE%DEADWOOD = 0. - BLAZE%FSTEP = 'DAILY' + BLAZE%FSTEP = TRIM(blazeTStep) BLAZE%LAT = LAT BLAZE%LON = LON @@ -178,8 +186,6 @@ SUBROUTINE INI_BLAZE ( np, LAT, LON, BLAZE) !!$ ! deadwood decay scale time [a] !!$ BLAZE%FT = 30 - BLAZE%BURNT_AREA_SRC = trim(BurnedAreaSource) - BLAZE%CPLANT_g = 0.0 BLAZE%CPLANT_w = 0.0 @@ -338,7 +344,6 @@ SUBROUTINE BLAZE_ACCOUNTING(BLAZE, climate, ktau, dels, year, doy) END SUBROUTINE BLAZE_ACCOUNTING - FUNCTION AVAIL_FUEL(FLIx, CPLANT_w, CPLANT_g, AGL_w, AGL_g) IMPLICIT NONE @@ -358,7 +363,7 @@ FUNCTION AVAIL_FUEL(FLIx, CPLANT_w, CPLANT_g, AGL_w, AGL_g) END FUNCTION AVAIL_FUEL SUBROUTINE BLAZE_TURNOVER(AB, CPLANT_g, CPLANT_w, AGL_g, AGL_w, & - BGL_g, BGL_w, shootfrac, TO, BT, BURNMODE, POP_TO) + BGL_g, BGL_w, shootfrac, TO, BT, BURNMODE, IAM , POP_TO) IMPLICIT NONE @@ -366,11 +371,11 @@ SUBROUTINE BLAZE_TURNOVER(AB, CPLANT_g, CPLANT_w, AGL_g, AGL_w, & !-> apply idx and factor on other TOs TYPE(TYPE_TURNOVER),INTENT(INOUT) :: TO(7) - INTEGER, INTENT(IN) :: BURNMODE + INTEGER, INTENT(IN) :: BURNMODE, IAM REAL, INTENT(IN) :: AB, shootfrac REAL, INTENT(INOUT) :: CPLANT_w(3) , CPLANT_g(3) REAL, DIMENSION(3), INTENT(INOUT) :: AGL_w, AGL_g, BGL_w, BGL_g - REAL, INTENT(OUT) :: BT(13) + REAL, INTENT(OUT) :: BT(NFLUXES) REAL, OPTIONAL, INTENT(IN) :: POP_TO TYPE(TYPE_TURNOVER) :: MTO(7) REAL :: fAB @@ -378,7 +383,6 @@ SUBROUTINE BLAZE_TURNOVER(AB, CPLANT_g, CPLANT_w, AGL_g, AGL_w, & !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ fAB = AB - ! Mass Fluxes MTO(LEAF )%TO_ATM = fAB * TO(LEAF )%TO_ATM * CPLANT_w (LEAF ) MTO(WOOD )%TO_ATM = fAB * TO(WOOD )%TO_ATM * CPLANT_w (WOOD ) @@ -392,20 +396,23 @@ SUBROUTINE BLAZE_TURNOVER(AB, CPLANT_g, CPLANT_w, AGL_g, AGL_w, & MTO(SLIT )%TO_ATM = fAB * TO(SLIT )%TO_ATM * AGL_w(STR ) MTO(CLIT )%TO_ATM = fAB * TO(CLIT )%TO_ATM * AGL_w(CWD ) - ! Diagnostics + ! Diagnostics (new order acc to blaze_driver.F90 ll 215ff) BT( 1) = MTO(LEAF )%TO_ATM - BT( 2) = MTO(WOOD )%TO_ATM - BT( 3) = MTO(LEAF )%TO_STR - BT( 4) = MTO(WOOD )%TO_STR - BT( 5) = MTO(WOOD )%TO_CWD - BT( 6) = MTO(MLIT )%TO_ATM - BT( 7) = MTO(SLIT )%TO_ATM - BT( 8) = MTO(CLIT )%TO_ATM - BT( 9) = MTO(FROOT)%TO_ATM - BT(10) = MTO(FROOT)%TO_STR + BT( 3) = MTO(WOOD )%TO_ATM + BT( 7) = MTO(LEAF )%TO_STR + BT( 9) = MTO(WOOD )%TO_STR + BT(10) = MTO(WOOD )%TO_CWD + + BT( 4) = MTO(MLIT )%TO_ATM + BT( 5) = MTO(SLIT )%TO_ATM + BT( 6) = MTO(CLIT )%TO_ATM + BT( 2) = MTO(FROOT)%TO_ATM + BT( 8) = MTO(FROOT)%TO_STR + BT(11) = AB * CPLANT_g (LEAF) - BT(12) = AB * AGL_g(METB) - BT(13) = AB * AGL_g(STR ) + BT(12) = AB * CPLANT_g (FROOT) + BT(13) = AB * AGL_g(METB) + BT(14) = AB * AGL_g(STR ) @@ -704,36 +711,36 @@ SUBROUTINE COMBUST (BLAZE, np, CPLANT_g, CPLANT_w, TO, BURN ) IF (FLIx .gt.0) then ! Live to Atmosphere - TO(LEAF)%TO_ATM = TOF(FLIx, 4) - TO(WOOD)%TO_ATM = (1. - fbranch - fbark) * TOF(FLIx, 1) + & - fbranch * TOF(FLIx, 2) + & - fbark * TOF(FLIx, 3) - TO(FROOT)%TO_ATM = TOF(FLIx, 9) - - ! Live to Litter - TO(LEAF)%TO_STR = TOF(FLIx, 8) - TO(WOOD)%TO_STR = fbark * TOF(FLIx, 7) - TO(WOOD)%TO_CWD = (1. - fbranch - fbark) * TOF(FLIx, 5) + & - fbranch * TOF(FLIx, 6) - TO(FROOT)%TO_STR = MAX( TO(WOOD)%TO_ATM + TO(WOOD)%TO_STR + TO(WOOD)%TO_CWD - & - TO(FROOT)%TO_ATM , 0. ) - - ! Litter to Atmosphere - TO(MLIT)%TO_ATM = TOF(FLIx, 11) - TO(SLIT)%TO_ATM = TOF(FLIx, 11) - TO(CLIT)%TO_ATM = TOF(FLIx, 10) - -ELSE - TO(LEAF)%TO_ATM = 0.0 - TO(WOOD)%TO_ATM = 0.0 - TO(FROOT)%TO_ATM = 0.0 - TO(LEAF)%TO_STR = 0.0 - TO(WOOD)%TO_CWD = 0.0 - TO(FROOT)%TO_STR = 0.0 - TO(MLIT)%TO_ATM = 0.0 - TO(SLIT)%TO_ATM = 0.0 - TO(CLIT)%TO_ATM = 0.0 -ENDIF + TO(LEAF)%TO_ATM = TOF(FLIx, 4) + TO(WOOD)%TO_ATM = (1. - fbranch - fbark) * TOF(FLIx, 1) + & + fbranch * TOF(FLIx, 2) + & + fbark * TOF(FLIx, 3) + TO(FROOT)%TO_ATM = TOF(FLIx, 9) + + ! Live to Litter + TO(LEAF)%TO_STR = TOF(FLIx, 8) + TO(WOOD)%TO_STR = fbark * TOF(FLIx, 7) + TO(WOOD)%TO_CWD = (1. - fbranch - fbark) * TOF(FLIx, 5) + & + fbranch * TOF(FLIx, 6) + TO(FROOT)%TO_STR = MAX( TO(WOOD)%TO_ATM + TO(WOOD)%TO_STR + TO(WOOD)%TO_CWD - & + TO(FROOT)%TO_ATM , 0. ) + + ! Litter to Atmosphere + TO(MLIT)%TO_ATM = TOF(FLIx, 11) + TO(SLIT)%TO_ATM = TOF(FLIx, 11) + TO(CLIT)%TO_ATM = TOF(FLIx, 10) + + ELSE + TO(LEAF)%TO_ATM = 0.0 + TO(WOOD)%TO_ATM = 0.0 + TO(FROOT)%TO_ATM = 0.0 + TO(LEAF)%TO_STR = 0.0 + TO(WOOD)%TO_CWD = 0.0 + TO(FROOT)%TO_STR = 0.0 + TO(MLIT)%TO_ATM = 0.0 + TO(SLIT)%TO_ATM = 0.0 + TO(CLIT)%TO_ATM = 0.0 + ENDIF END SUBROUTINE COMBUST @@ -753,7 +760,7 @@ SUBROUTINE RUN_BLAZE(BLAZE, SF, CPLANT_g, CPLANT_w, tstp, YYYY, doy, TO , climat INTEGER :: np, doy, YYYY, MM, DD, DOM(12) REAL :: CPLANT_g(BLAZE%NCELLS,3), CPLANT_w(BLAZE%NCELLS,3), tstp - REAL, DIMENSION(BLAZE%NCELLS,3) :: AGL_g, AGL_w, BGL_g, BGL_w + !CLNREAL, DIMENSION(BLAZE%NCELLS,3) :: AGL_g, AGL_w, BGL_g, BGL_w REAL, DIMENSION(BLAZE%NCELLS) :: & RAINF, & ! [mm/d] TMIN, & ! [deg C] @@ -798,7 +805,6 @@ SUBROUTINE RUN_BLAZE(BLAZE, SF, CPLANT_g, CPLANT_w, tstp, YYYY, doy, TO , climat ! CALL SIMFIRE DAILY FOR ACOUNTING OF PARAMETERS CALL SIMFIRE ( SF, RAINF, TMAX, TMIN, DOY,MM, YYYY, BLAZE%AB , climate) - DO np = 1, BLAZE%NCELLS IF ( AVAIL_FUEL(1, CPLANT_w(np,:), CPLANT_g(np,:),BLAZE%AGLit_w(np,:),BLAZE%AGLit_g(np,:) ) .LE. MIN_FUEL ) & BLAZE%AB(np) = 0. @@ -810,24 +816,22 @@ SUBROUTINE RUN_BLAZE(BLAZE, SF, CPLANT_g, CPLANT_w, tstp, YYYY, doy, TO , climat STOP -1 ENDIF + !CALL PRINT_BLAZE(BLAZE) + ! Apply half of former deadwood to atm now How to distribut (str ! set following Fraver 2013 pinus rosinosa (hardwood/decid. wood to be added DO np = 1, BLAZE%NCELLS - - CALL COMBUST( BLAZE, np, CPLANT_g(np,:), CPLANT_w(np,:),TO(np,:),BLAZE%AB(np).GT.0 ) - - BLAZE%DFLI(np) = BLAZE%FLI(np) BLAZE%TO(np,:) = 0. IF (BLAZE%AB(np) .GT. 0. ) THEN CALL BLAZE_TURNOVER( BLAZE%AB(np), CPLANT_g(np,:), CPLANT_w(np,:), & - AGL_g(np,:), AGL_w(np,:),BGL_g(np,:), BGL_w(np,:), & - BLAZE%shootfrac(np), TO(np,:), BLAZE%FLUXES(np,:), BLAZE%BURNMODE ) + BLAZE%AGLit_g(np,:), BLAZE%AGLit_w(np,:),BLAZE%BGLit_g(np,:), BLAZE%BGLit_w(np,:), & + BLAZE%shootfrac(np), TO(np,:), BLAZE%FLUXES(np,:), BLAZE%BURNMODE, BLAZE%IAM ) ENDIF @@ -838,7 +842,7 @@ SUBROUTINE RUN_BLAZE(BLAZE, SF, CPLANT_g, CPLANT_w, tstp, YYYY, doy, TO , climat !CLN AGL(np,CWD) = AGL(np,CWD) + & !CLN ! (1.-exp(-0.5*tstp/SF(ft))) * SUM(DEADWOOD(np,:)) !CLN (1.-exp(-0.5*tstp/15.)) * SUM(DEADWOOD(np,:)) - + !CLN BLAZE%DEADWOOD(np,:) = DEADWOOD(np,:) * exp(-0.5*tstp/15.) END DO @@ -862,8 +866,9 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) !INTEGER, INTENT(IN) :: ctime INTEGER :: STATUS - INTEGER :: land_ID, t_ID + INTEGER :: land_ID, t_ID, f_ID INTEGER :: i, mp + !CLNINTEGER, PARAMETER :: NFLUXES = 14 CHARACTER :: FNAME*99,dum*50 LOGICAL, SAVE :: CALL1 = .TRUE. @@ -873,8 +878,10 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) CHARACTER(len=20),DIMENSION(25):: A1 ! 2 dim integer arrays (mp,t) CHARACTER(len=20),DIMENSION(1):: AI1 + ! 3 dim real arrays (mp,t,nfluxes) + CHARACTER(len=20),DIMENSION(1):: A2 - INTEGER, SAVE :: VIDtime, VID0(SIZE(A0)),VID1(SIZE(A1)),VIDI1(SIZE(AI1)) + INTEGER, SAVE :: VIDtime, VID0(SIZE(A0)),VID1(SIZE(A1)),VIDI1(SIZE(AI1)),VID2(SIZE(A2)) INTEGER, SAVE :: FILE_ID, CNT = 0 A0(1) = 'latitude' @@ -895,7 +902,6 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) A1(13) = 'DMacArthur' A1(14) = 'AvailFuel' A1(15) = 'AvailFuelPrior' - A1(16) = 'CPLANT_w_froot' A1(17) = 'CPLANT_w_leaf' A1(18) = 'CPLANT_w_wood' @@ -909,6 +915,8 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) AI1(1) = 'DaysSinceLastRain' + A2(1) = 'BLAZE_fluxes' + CNT = CNT + 1 mp = BLAZE%ncells @@ -927,8 +935,8 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) IF (LEN_TRIM( TRIM(cable_user%BLAZE_outfile) ) .gt. 0 ) THEN fname = TRIM(cable_user%BLAZE_outfile) ELSE - fname = TRIM(filename%path)//'/'//TRIM(cable_user%RunIden)//'_'//& - TRIM(dum)//'_BLAZE_out.nc' + fname = TRIM(filename%path)//'/outputs/'//TRIM(cable_user%RunIden)//'_out_blaze_'//& + TRIM(dum)//'.nc' ENDIF ! Create NetCDF file: @@ -945,13 +953,16 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) STATUS = NF90_def_dim(FILE_ID, 'time' , NF90_UNLIMITED, t_ID) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + + STATUS = NF90_def_dim(FILE_ID, 'fluxes' , NFLUXES, f_ID) IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) ! Define variables STATUS = NF90_def_var(FILE_ID,'time' ,NF90_INT,(/t_ID/),VIDtime ) IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) - !write(*,*) 'timeunits', TRIM(timeunits), t_ID, FILE_ID + write(*,*) 'timeunits', TRIM(timeunits), t_ID, FILE_ID STATUS = NF90_PUT_ATT(FILE_ID, VIDtime, 'units', TRIM(timeunits)) IF (STATUS /= NF90_NOERR) CALL handle_err(STATUS) @@ -972,12 +983,18 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) END DO - DO i = 1, SIZE(AI1) - STATUS = NF90_def_var(FILE_ID,TRIM(AI1(i)) ,NF90_INT,(/land_ID,t_ID/),VIDI1(i)) - IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) - write(*,*) 'def AI1' - END DO - + DO i = 1, SIZE(AI1) + STATUS = NF90_def_var(FILE_ID,TRIM(AI1(i)) ,NF90_INT,(/land_ID,t_ID/),VIDI1(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + write(*,*) 'def AI1' + END DO + + DO i = 1, SIZE(A2) + STATUS = NF90_def_var(FILE_ID,TRIM(A2(i)) ,NF90_FLOAT,(/land_ID,f_ID ,t_ID/),VID2(i)) + IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) + write(*,*) 'def A2' + END DO + ! End define mode: STATUS = NF90_enddef(FILE_ID) IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) @@ -1082,13 +1099,16 @@ SUBROUTINE WRITE_BLAZE_OUTPUT_NC ( BLAZE, FINAL ) STATUS = NF90_PUT_VAR(FILE_ID, VID1( 25), BLAZE%AGlit_g(:,str), start=(/ 1, CNT /), count=(/ mp, 1 /) ) IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) - - + ! Integer 2D STATUS = NF90_PUT_VAR(FILE_ID, VIDI1(1), BLAZE%DSLR, start=(/ 1, CNT /), count=(/ mp, 1 /) ) IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) - IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + ! Float 3D + DO i=1,NFLUXES + STATUS = NF90_PUT_VAR(FILE_ID, VID2(1),BLAZE%FLUXES(:,i), start=(/ 1, i, CNT /), count=(/ mp, 1, 1 /)) + IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + END DO IF ( FINAL ) THEN ! Close NetCDF file: diff --git a/core/blaze/blaze_driver.F90 b/core/blaze/blaze_driver.F90 index fbfd0d441..9c3f5163f 100644 --- a/core/blaze/blaze_driver.F90 +++ b/core/blaze/blaze_driver.F90 @@ -29,9 +29,9 @@ SUBROUTINE BLAZE_DRIVER ( NCELLS, BLAZE, SF, casapool, casaflux, casamet, & TYPE(TYPE_TURNOVER) ,ALLOCATABLE,SAVE :: TO(:,:) REAL, DIMENSION(NCELLS) :: POP_TO - INTEGER :: MM, DD, i, np, j, patch_index, p + INTEGER :: MM, DD, i, np, j, patch_index, p, pidx REAL :: TSTP - REAL :: ag_litter_frac + REAL :: ag_litter_frac, twto, rkill REAL :: CPLANT_g (ncells,3),CPLANT_w (ncells,3) REAL :: CLITTER_g(ncells,3),CLITTER_w(ncells,3) LOGICAL :: EOY @@ -74,26 +74,20 @@ SUBROUTINE BLAZE_DRIVER ( NCELLS, BLAZE, SF, casapool, casaflux, casamet, & real(casapool%cplant(patch_index,j)*patch(patch_index)%frac) CLITTER_w(i,j) = CLITTER_w(i,j) + & real(casapool%clitter(patch_index,j)*patch(patch_index)%frac) - ENDIF + ENDIF END DO ENDDO ENDDO BLAZE%CPLANT_w (:,WOOD) = BLAZE%CPLANT_w (:,WOOD) * BLAZE%shootfrac(:) -!!$ ! set heights at which tree mortality is calculated -!!$ nbins = mheights -!!$ DO i=1,nbins -!!$ casaflux%fire_mortality_vs_height(:,i,1) = real(BIN_POWER**i, r_2) -!!$ ENDDO - ag_litter_frac = 0.4 BLAZE%AGLit_w(:, CWD) = CLITTER_w(:, CWD) * BLAZE%shootfrac(:) BLAZE%AGLit_w(:,METB) = CLITTER_w(:,METB) * ag_litter_frac - BLAZE%AGLit_w(:,STR) = CLITTER_w(:,STR) * ag_litter_frac + BLAZE%AGLit_w(:, STR) = CLITTER_w(:, STR) * ag_litter_frac - BLAZE%AGLit_g(:,CWD) = 0. - BLAZE%AGLit_g(:,STR ) = CLITTER_g(:,STR) * ag_litter_frac + BLAZE%AGLit_g(:, CWD) = 0. + BLAZE%AGLit_g(:, STR) = CLITTER_g(:, STR) * ag_litter_frac BLAZE%AGLit_g(:,METB) = CLITTER_g(:,METB) * ag_litter_frac DO i = 1, 3 @@ -141,7 +135,7 @@ SUBROUTINE BLAZE_DRIVER ( NCELLS, BLAZE, SF, casapool, casaflux, casamet, & DO np = 1, NCELLS CALL BLAZE_TURNOVER( BLAZE%AB(np), CPLANT_g(np,:), CPLANT_w(np,:), BLAZE%AGLit_g(np,:), & BLAZE%AGLit_w(np,:), BLAZE%BGLit_g(np,:), BLAZE%BGLit_w(np,:),BLAZE%shootfrac(np),TO(np,:), & - BLAZE%FLUXES(np,:), BLAZE%BURNMODE, POP_TO(np) ) + BLAZE%FLUXES(np,:), BLAZE%BURNMODE, BLAZE%IAM,POP_TO(np) ) END DO ELSE STOP "Wrong MODE in blaze_driver.f90!" @@ -149,32 +143,17 @@ SUBROUTINE BLAZE_DRIVER ( NCELLS, BLAZE, SF, casapool, casaflux, casamet, & !CVH ! set casa fire turnover rates and partitioning of fire losses here! - casaflux%kplant_fire = 0.0_r_2 - casaflux%klitter_fire = 0.0_r_2 + casaflux%kplant_fire = 0.0_r_2 + casaflux%klitter_fire = 0.0_r_2 casaflux%fromPtoL_fire = 0.0_r_2 - !casaflux%fire_mortality_vs_height(:,:,2) = 0.0_r_2 - - ! set burned area and fire line intensity in veg%disturbance_intensity for use in ! calculating tree mortality in POP. DO i = 1, BLAZE%NCELLS DO p = 1, landpt(i)%nap ! loop over number of active patches patch_index = landpt(i)%cstart + p - 1 ! patch index in CABLE vector -!!$ IF ( casamet%lnonwood(patch_index) == 0 ) THEN ! Here woody patches - veg%disturbance_intensity(patch_index,1) = BLAZE%AB(i) ! needed for ADJUST_POP_FOR_FIRE - veg%disturbance_intensity(patch_index,2) = BLAZE%FLI(i) ! needed for ADJUST_POP_FOR_FIRE - -!!$ DO nh = 1,mheights -!!$ hgt = real(casaflux%fire_mortality_vs_height(patch_index,nh,1)) -!!$ casaflux%fire_mortality_vs_height(patch_index,nh,2) = & -!!$ (1._r_2 - real(p_surv_OzSavanna(hgt,BLAZE%FLI(i)),r_2)) * BLAZE%AB(i) !* -!!$ -!!$ -!!$ ! (1._r_2 - casaflux%fire_mortality_vs_height(patch_index,nh,2)) & -!!$ -!!$ ENDDO -!!$ ENDIF + veg%disturbance_intensity(patch_index,1) = BLAZE%AB(i) ! needed for ADJUST_POP_FOR_FIRE + veg%disturbance_intensity(patch_index,2) = BLAZE%FLI(i) ! needed for ADJUST_POP_FOR_FIRE ENDDO ENDDO @@ -183,37 +162,31 @@ SUBROUTINE BLAZE_DRIVER ( NCELLS, BLAZE, SF, casapool, casaflux, casamet, & ! POP cohorts and then interpolating fire_mortality between POP patches if (.NOT.Allocated(Iw)) allocate(Iw(POP%np)) Iw = POP%Iwood - ! print*, 'IW', POP%Iwood - ! print*, 'fire_mort', casaflux%fire_mortality_vs_height(Iw,:,:) - ! print*, 'BA: ', BLAZE%AB - ! print*, 'dist: ', int(veg%disturbance_interval(Iw,:), i4b) - POP%pop_grid(:)%fire_mortality = 0.0_dp -!!$ CALL ADJUST_POP_FOR_FIRE(pop,int(veg%disturbance_interval(Iw,:), i4b), & -!!$ casaflux%fire_mortality_vs_height(Iw,:,:)) CALL ADJUST_POP_FOR_FIRE(pop,int(veg%disturbance_interval(Iw,:), i4b), & veg%disturbance_intensity(Iw,1), veg%disturbance_intensity(Iw,2) ) - - casaflux%kplant_fire(Iw,WOOD) = max(min(POP%pop_grid(:)%fire_mortality/POP%pop_grid(:)%cmass_sum, & - 0.99_dp),0.0_dp) - !write(556,*) casaflux%kplant_fire(1,WOOD), casaflux%kplant(1,WOOD), BLAZE%AB - !write(557,*) BLAZE%AB, casaflux%fire_mortality_vs_height(1,:,2) - - !print*, 'fire mort', POP%pop_grid(:)%fire_mortality, casaflux%kplant_fire(Iw,WOOD) - + ! Apply turn-overs to biomass killed by fire in POP + + BLAZE%FLUXES(:,:) = 0. + ! pop_grid index + pidx=1 DO i = 1, BLAZE%NCELLS DO p = 1, landpt(i)%nap ! loop over number of active patches patch_index = landpt(i)%cstart + p - 1 ! patch index in CABLE vector - + IF ( casamet%lnonwood(patch_index) == 1 ) THEN ! Here non-wood - +!CLN wrong for kplant. Take out cmass here + !CLNcasaflux%kplant_fire(patch_index,LEAF) = real(BLAZE%AB(i), r_2) & + !CLN * real(casapool%cplant(patch_index,LEAF )*patch(patch_index)%frac, r_2) + !CLNcasaflux%kplant_fire(patch_index,FROOT) = real(BLAZE%AB(i), r_2) & + !CLN * real(casapool%cplant(patch_index,FROOT)*patch(patch_index)%frac, r_2) casaflux%kplant_fire(patch_index,LEAF) = real(BLAZE%AB(i), r_2) - casaflux%kplant_fire(patch_index,FROOT) = real(BLAZE%AB(i), r_2) + casaflux%kplant_fire(patch_index,FROOT) = real(BLAZE%AB(i), r_2) casaflux%kplant_fire(patch_index,WOOD) = 0.0_r_2 casaflux%klitter_fire(patch_index,METB) = real(BLAZE%AB(i) * ag_litter_frac, r_2) - casaflux%klitter_fire(patch_index,STR) = real(BLAZE%AB(i) * ag_litter_frac, r_2) + casaflux%klitter_fire(patch_index,STR) = real(BLAZE%AB(i) * ag_litter_frac, r_2) casaflux%klitter_fire(patch_index,CWD) = 0.0_r_2 casaflux%fromPtoL_fire(patch_index,METB,LEAF) = 0.0_r_2 @@ -228,41 +201,80 @@ SUBROUTINE BLAZE_DRIVER ( NCELLS, BLAZE, SF, casapool, casaflux, casamet, & casaflux%fromPtoL_fire(patch_index,CWD,FROOT) = 0.0_r_2 casaflux%fromPtoL_fire(patch_index,CWD,WOOD) = 0.0_r_2 + ! BLAZE fluxes + BLAZE%FLUXES(i,11) = BLAZE%FLUXES(i,11) + casaflux%kplant_fire(patch_index,LEAF ) & + * real(casapool%cplant(patch_index,LEAF )*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i,12) = BLAZE%FLUXES(i,12) + casaflux%kplant_fire(patch_index,FROOT) & + * real(casapool%cplant(patch_index,FROOT)*patch(patch_index)%frac, r_2) + + BLAZE%FLUXES(i,13) = BLAZE%FLUXES(i,13) + casaflux%klitter_fire(patch_index,METB) & + * real(casapool%clitter(patch_index,METB)*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i,14) = BLAZE%FLUXES(i,14) + casaflux%klitter_fire(patch_index,STR ) & + * real(casapool%clitter(patch_index,STR )*patch(patch_index)%frac, r_2) + ELSEIF ( casamet%lnonwood(patch_index) == 0 ) THEN ! Here woody patches - casaflux%kplant_fire(patch_index,LEAF) = real(BLAZE%AB(i) * & - (TO(i, LEAF )%TO_ATM + TO(i, LEAF )%TO_STR), r_2) - casaflux%kplant_fire(patch_index,FROOT) = real(BLAZE%AB(i) * & - (TO(i, FROOT )%TO_ATM + TO(i, FROOT )%TO_STR), r_2) - - - casaflux%klitter_fire(patch_index,METB) = real(BLAZE%AB(i) * & - (TO(i, MLIT )%TO_ATM) * ag_litter_frac, r_2) - casaflux%klitter_fire(patch_index,STR) = real(BLAZE%AB(i) * & - (TO(i, SLIT )%TO_ATM) * ag_litter_frac, r_2) - casaflux%klitter_fire(patch_index,CWD) = real(BLAZE%AB(i) * & - (TO(i, CLIT )%TO_ATM) * ag_litter_frac, r_2) - - casaflux%fromPtoL_fire(patch_index,STR,LEAF) = real(TO(i, LEAF )%TO_STR/ & - MAX((TO(i, LEAF )%TO_STR + TO(i, LEAF )%TO_ATM),1.e-5), r_2) - - casaflux%fromPtoL_fire(patch_index,STR,FROOT) = real(TO(i, FROOT )%TO_STR/ & - MAX((TO(i, FROOT )%TO_STR + TO(i, FROOT )%TO_ATM),1.e-5), r_2) - - ! maintain look-up table values for partitioning flux from woody biomass, but assume - ! flux to atm only applies to above-ground wood (70% of total) - - casaflux%fromPtoL_fire(patch_index,CWD,WOOD) = real(TO(i, WOOD )%TO_CWD/ & - MAX((TO(i, WOOD )%TO_CWD + TO(i, WOOD )%TO_ATM*0.7 + TO(i, WOOD )%TO_STR ),1.e-5), r_2) - - casaflux%fromPtoL_fire(patch_index,STR,WOOD) = real(TO(i, WOOD )%TO_STR/ & - MAX((TO(i, WOOD )%TO_CWD + TO(i, WOOD )%TO_ATM + & - TO(i, WOOD )%TO_STR ),1e-5), r_2) - - + !CLN increment iwood for pop_grid + + rkill=POP%pop_grid(pidx)%rkill + + pidx = pidx + 1 + ! Check if there is mortality and COMBUST has only computed non-woody TO + ! When POP is involved these fluxes need to sum up to 1, assuming that + ! all that is not going to ATM or STR will be going to CWD (DEADWOOD) + !IF (CALL_POP) THEN + TO(i, WOOD)%TO_CWD = 1. - TO(i, WOOD)%TO_ATM - TO(i, WOOD)%TO_STR + TO(i, FROOT)%TO_STR = MAX( TO(i, WOOD)%TO_ATM + TO(i, WOOD)%TO_STR + TO(i, WOOD)%TO_CWD - & + TO(i, FROOT)%TO_ATM , 0. ) + ! ENDIF + + ! Total wood turn-over + twto = MAX(TO(i, WOOD)%TO_ATM * 0.7 + TO(i, WOOD )%TO_CWD + TO(i, WOOD )%TO_STR,1.e-7) + + casaflux%kplant_fire(patch_index,LEAF) = real(BLAZE%AB(i) * TO(i, LEAF )%TO_ATM, r_2) + casaflux%kplant_fire(patch_index,FROOT) = real(BLAZE%AB(i) * (1.-rkill) * TO(i, FROOT)%TO_ATM, r_2) + casaflux%kplant_fire(patch_index,WOOD ) = real(rkill/twto * TO(i, WOOD )%TO_ATM * 0.7, r_2) + + casaflux%klitter_fire(patch_index,METB) = real(BLAZE%AB(i) * TO(i, MLIT )%TO_ATM & + * ag_litter_frac, r_2) + casaflux%klitter_fire(patch_index,STR) = real(BLAZE%AB(i) * TO(i, SLIT )%TO_ATM & + * ag_litter_frac, r_2) + casaflux%klitter_fire(patch_index,CWD) = real(BLAZE%AB(i) * TO(i, CLIT )%TO_ATM & + * ag_litter_frac, r_2) + + casaflux%fromPtoL_fire(patch_index,STR,LEAF) = real(BLAZE%AB(i) * TO(i, LEAF )%TO_STR, r_2) + casaflux%fromPtoL_fire(patch_index,STR,FROOT)= real(rkill * TO(i, FROOT)%TO_STR, r_2) + casaflux%fromPtoL_fire(patch_index,STR,WOOD) = real(rkill/twto * TO(i, WOOD )%TO_STR, r_2) + + casaflux%fromPtoL_fire(patch_index,CWD,WOOD) = real(rkill/twto * TO(i, WOOD )%TO_CWD, r_2) + + ! BLAZE fluxes + BLAZE%FLUXES(i, 1) = BLAZE%FLUXES(i, 1) + casaflux%kplant_fire(patch_index,LEAF ) & + * real(casapool%cplant(patch_index,LEAF )*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i, 2) = BLAZE%FLUXES(i, 2) + casaflux%kplant_fire(patch_index,FROOT) & + * real(casapool%cplant(patch_index,FROOT)*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i, 3) = BLAZE%FLUXES(i, 3) + casaflux%kplant_fire(patch_index,WOOD ) & + * real(casapool%cplant(patch_index,WOOD )*patch(patch_index)%frac, r_2) + + BLAZE%FLUXES(i, 4) = BLAZE%FLUXES(i, 4) + casaflux%klitter_fire(patch_index,METB) & + * real(casapool%clitter(patch_index,METB)*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i, 5) = BLAZE%FLUXES(i, 5) + casaflux%klitter_fire(patch_index,STR ) & + * real(casapool%clitter(patch_index,STR )*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i, 6) = BLAZE%FLUXES(i, 6) + casaflux%klitter_fire(patch_index,CWD ) & + * real(casapool%clitter(patch_index,CWD )*patch(patch_index)%frac, r_2) + + BLAZE%FLUXES(i, 7) = BLAZE%FLUXES(i, 7) + casaflux%fromPtoL_fire(patch_index,STR,LEAF ) & + * real(casapool%clitter(patch_index,LEAF )*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i, 8) = BLAZE%FLUXES(i, 8) + casaflux%fromPtoL_fire(patch_index,STR,FROOT) & + * real(casapool%clitter(patch_index,FROOT)*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i, 9) = BLAZE%FLUXES(i, 9) + casaflux%fromPtoL_fire(patch_index,STR,WOOD ) & + * real(casapool%clitter(patch_index,WOOD )*patch(patch_index)%frac, r_2) + BLAZE%FLUXES(i,10) = BLAZE%FLUXES(i,10) + casaflux%fromPtoL_fire(patch_index,CWD,WOOD ) & + * real(casapool%clitter(patch_index,WOOD)*patch(patch_index)%frac, r_2) + ENDIF - ENDDO ! number of active patches + ENDDO ! number of active patches ENDDO ! number of grid cells diff --git a/core/blaze/blaze_mpi.F90 b/core/blaze/blaze_mpi.F90 index 1eee3e60d..ad766fd35 100644 --- a/core/blaze/blaze_mpi.F90 +++ b/core/blaze/blaze_mpi.F90 @@ -17,7 +17,7 @@ MODULE BLAZE_MPI ! for BLAZE%OUTMODE == "std" INTEGER, PARAMETER :: n_blaze_output_std = 10 ! add for BLAZE%OUTMODE == "full" - INTEGER, PARAMETER :: n_blaze_output_extra = 14 + INTEGER, PARAMETER :: n_blaze_output_extra = 15 ! Total number of restart parameters for SIMFIRE INTEGER, PARAMETER :: n_simfire_restart = 4 @@ -112,17 +112,17 @@ SUBROUTINE master_blaze_types (comm, wland, wnp, mp, BLAZE, blaze_restart_ts, bl END IF CALL MPI_Type_create_struct (bidx, blocks, displs, types, blaze_in_ts(rank), ierr) -write(*,*)" CLN ierr1 " , ierr +!write(*,*)" CLN ierr1 " , ierr CALL MPI_Type_commit (blaze_in_ts(rank), ierr) -write(*,*)" CLN ierr2 " , ierr +!write(*,*)" CLN ierr2 " , ierr CALL MPI_Type_size (blaze_in_ts(rank), tsize, ierr) -write(*,*)" CLN ierr3 " , ierr +!write(*,*)" CLN ierr3 " , ierr CALL MPI_Type_get_extent (blaze_in_ts(rank), tmplb, text, ierr) -write(*,*)" CLN ierr4 " , ierr +!write(*,*)" CLN ierr4 " , ierr - WRITE (*,*) 'input results recv from worker, size, extent, lb: ', & - & rank,tsize,text,tmplb + ! WRITE (*,*) 'input results recv from worker, size, extent, lb: ', & + ! & rank,tsize,text,tmplb totalrecv = totalrecv + tsize @@ -248,17 +248,17 @@ SUBROUTINE master_blaze_types (comm, wland, wnp, mp, BLAZE, blaze_restart_ts, bl END IF CALL MPI_Type_create_struct (bidx, blocks, displs, types, blaze_restart_ts(rank), ierr) -write(*,*)" CLN ierr1 " , ierr +!write(*,*)" CLN ierr1 " , ierr CALL MPI_Type_commit (blaze_restart_ts(rank), ierr) -write(*,*)" CLN ierr2 " , ierr +!write(*,*)" CLN ierr2 " , ierr CALL MPI_Type_size (blaze_restart_ts(rank), tsize, ierr) -write(*,*)" CLN ierr3 " , ierr +!write(*,*)" CLN ierr3 " , ierr CALL MPI_Type_get_extent (blaze_restart_ts(rank), tmplb, text, ierr) -write(*,*)" CLN ierr4 " , ierr +!write(*,*)" CLN ierr4 " , ierr - WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & - & rank,tsize,text,tmplb +! WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & +! & rank,tsize,text,tmplb totalrecv = totalrecv + tsize @@ -315,12 +315,19 @@ SUBROUTINE master_blaze_types (comm, wland, wnp, mp, BLAZE, blaze_restart_ts, bl r2len = cnt * extr2 bidx = 0 - last2d = 0 + last2d = 0 ! ------------- 2D arrays ------------- IF ( TRIM(BLAZE%OUTMODE) == "full" ) THEN + ! fluxes + bidx = bidx + 1 + CALL MPI_Get_address (BLAZE%FLUXES(off,1), displs(bidx), ierr) + CALL MPI_Type_create_hvector (NFLUXES, r1len, r1stride, MPI_BYTE, & + & types(bidx), ierr) + blocks(bidx) = 1 + ! Annual (daily) rainfall (ncells,366) bidx = bidx + 1 CALL MPI_Get_address (BLAZE%TO(off,1), displs(bidx), ierr) ! 1 @@ -422,6 +429,7 @@ SUBROUTINE master_blaze_types (comm, wland, wnp, mp, BLAZE, blaze_restart_ts, bl bidx = bidx + 1 CALL MPI_Get_address (BLAZE%w_prior(off), displs(bidx), ierr) blocks(bidx) = r1len + END IF ! current KBDI @@ -490,8 +498,8 @@ SUBROUTINE master_blaze_types (comm, wland, wnp, mp, BLAZE, blaze_restart_ts, bl CALL MPI_Type_size (blaze_out_ts(rank), tsize, ierr) CALL MPI_Type_get_extent (blaze_out_ts(rank), tmplb, text, ierr) - WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & - & rank,tsize,text,tmplb + ! WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & + !& rank,tsize,text,tmplb totalrecv = totalrecv + tsize @@ -595,7 +603,7 @@ SUBROUTINE worker_blaze_types(comm, mp, BLAZE, blaze_restart_t, blaze_in_t, blaz CALL MPI_Type_size (blaze_in_t, tsize, ierr) CALL MPI_Type_get_extent (blaze_in_t, tmplb, text, ierr) - WRITE (*,*) 'in_blaze struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb + !WRITE (*,*) 'in_blaze struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -688,7 +696,7 @@ SUBROUTINE worker_blaze_types(comm, mp, BLAZE, blaze_restart_t, blaze_in_t, blaz CALL MPI_Type_size (blaze_restart_t, tsize, ierr) CALL MPI_Type_get_extent (blaze_restart_t, tmplb, text, ierr) - WRITE (*,*) 'restart_blaze struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb + !WRITE (*,*) 'restart_blaze struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -712,10 +720,15 @@ SUBROUTINE worker_blaze_types(comm, mp, BLAZE, blaze_restart_t, blaze_in_t, blaz bidx = 0 - ! ------------- 2D arrays ------------- + ! ------------- 2D arrays ------------- IF ( TRIM(BLAZE%OUTMODE) == "full" ) THEN + ! fluxes + bidx = bidx + 1 + CALL MPI_Get_address (BLAZE%FLUXES(off,1), displs(bidx), ierr) + blocks(bidx) = r1len * NFLUXES + bidx = bidx + 1 CALL MPI_Get_address (BLAZE%TO(off,1), displs(bidx), ierr) blocks(bidx) = r1len * NTO @@ -857,7 +870,7 @@ SUBROUTINE worker_blaze_types(comm, mp, BLAZE, blaze_restart_t, blaze_in_t, blaz CALL MPI_Type_size (blaze_out_t, tsize, ierr) CALL MPI_Type_get_extent (blaze_out_t, tmplb, text, ierr) - WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb + !WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -976,8 +989,8 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si CALL MPI_Type_size (simfire_restart_ts(rank), tsize, ierr) CALL MPI_Type_get_extent (simfire_restart_ts(rank), tmplb, text, ierr) - WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & - & rank,tsize,text,tmplb + !WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & + !& rank,tsize,text,tmplb totalrecv = totalrecv + tsize @@ -988,7 +1001,7 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si END DO - WRITE (*,*) 'total size of simfire restart fields received from all workers: ', totalrecv + !WRITE (*,*) 'total size of simfire restart fields received from all workers: ', totalrecv ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -996,7 +1009,7 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si CALL MPI_Reduce (MPI_IN_PLACE, totalsend, 1, MPI_INTEGER, MPI_SUM, & & 0, comm, ierr) - WRITE (*,*) 'total size of simfire restart fields sent by all workers: ', totalsend + !WRITE (*,*) 'total size of simfire restart fields sent by all workers: ', totalsend IF (totalrecv /= totalsend) THEN WRITE (*,*) 'error: simfire restart fields totalsend and totalrecv differ',totalsend,totalrecv @@ -1055,8 +1068,8 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si CALL MPI_Type_size (simfire_inp_ts(rank), tsize, ierr) CALL MPI_Type_get_extent (simfire_inp_ts(rank), tmplb, text, ierr) - WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & - & rank,tsize,text,tmplb + !WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & + ! & rank,tsize,text,tmplb totalrecv = totalrecv + tsize @@ -1067,7 +1080,7 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si END DO - WRITE (*,*) 'total size of simfire input fields received from all workers: ', totalrecv + !WRITE (*,*) 'total size of simfire input fields received from all workers: ', totalrecv ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -1075,7 +1088,7 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si CALL MPI_Reduce (MPI_IN_PLACE, totalsend, 1, MPI_INTEGER, MPI_SUM, & & 0, comm, ierr) - WRITE (*,*) 'total size of restart fields sent by all workers: ', totalsend + !WRITE (*,*) 'total size of restart fields sent by all workers: ', totalsend IF (totalrecv /= totalsend) THEN WRITE (*,*) 'error: restart fields totalsend and totalrecv differ',totalsend,totalrecv @@ -1155,8 +1168,8 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si CALL MPI_Type_size (simfire_out_ts(rank), tsize, ierr) CALL MPI_Type_get_extent (simfire_out_ts(rank), tmplb, text, ierr) - WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & - & rank,tsize,text,tmplb + !WRITE (*,*) 'restart results recv from worker, size, extent, lb: ', & + ! & rank,tsize,text,tmplb totalrecv = totalrecv + tsize @@ -1167,7 +1180,7 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si END DO - WRITE (*,*) 'total size of restart fields received from all workers: ', totalrecv + !WRITE (*,*) 'total size of restart fields received from all workers: ', totalrecv ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -1175,7 +1188,7 @@ SUBROUTINE master_simfire_types(comm, wland, wnp, mp, SF, simfire_restart_ts, si CALL MPI_Reduce (MPI_IN_PLACE, totalsend, 1, MPI_INTEGER, MPI_SUM, & & 0, comm, ierr) - WRITE (*,*) 'total size of restart fields sent by all workers: ', totalsend + !WRITE (*,*) 'total size of restart fields sent by all workers: ', totalsend IF (totalrecv /= totalsend) THEN WRITE (*,*) 'error4: restart fields totalsend and totalrecv differ',totalsend,totalrecv @@ -1267,7 +1280,7 @@ SUBROUTINE worker_simfire_types(comm, mp, SF, simfire_restart_t, simfire_inp_t, CALL MPI_Type_size (simfire_restart_t, tsize, ierr) CALL MPI_Type_get_extent (simfire_restart_t, tmplb, text, ierr) - WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb + !WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -1304,7 +1317,7 @@ SUBROUTINE worker_simfire_types(comm, mp, SF, simfire_restart_t, simfire_inp_t, CALL MPI_Type_size (simfire_inp_t, tsize, ierr) CALL MPI_Type_get_extent (simfire_inp_t, tmplb, text, ierr) - WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb + !WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb ! MPI: check whether total size of received data equals total ! data sent by all the workers @@ -1358,7 +1371,7 @@ SUBROUTINE worker_simfire_types(comm, mp, SF, simfire_restart_t, simfire_inp_t, CALL MPI_Type_size (simfire_out_t, tsize, ierr) CALL MPI_Type_get_extent (simfire_out_t, tmplb, text, ierr) - WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb + !WRITE (*,*) 'restart struct blocks, size, extent and lb: ',rank,bidx,tsize,text,tmplb ! MPI: check whether total size of received data equals total ! data sent by all the workers diff --git a/core/blaze/simfire.F90 b/core/blaze/simfire.F90 index 8108efd12..ba9cfeb03 100644 --- a/core/blaze/simfire.F90 +++ b/core/blaze/simfire.F90 @@ -62,8 +62,8 @@ SUBROUTINE INI_SIMFIRE( NCELLS, SF, modis_igbp ) TYPE (TYPE_SIMFIRE), INTENT(INOUT) :: SF INTEGER, INTENT(IN) :: NCELLS, modis_igbp(NCELLS) - CHARACTER(len=400) :: HydePath, BurnedAreaSource, BurnedAreaFile, & - BurnedAreaClimatologyFile, SIMFIRE_REGION + CHARACTER(len=400) :: HydePath, BurnedAreaFile = "", BurnedAreaClimatologyFile, SIMFIRE_REGION + CHARACTER(len=10) :: BurnedAreaSource = "SIMFIRE", blazeTStep = "annually" INTEGER :: F_ID, V_ID, V_ID_lat, V_ID_lon, ilat,ilon INTEGER :: iu INTEGER :: i @@ -71,14 +71,11 @@ SUBROUTINE INI_SIMFIRE( NCELLS, SF, modis_igbp ) REAL, DIMENSION(360):: lat_BA integer :: status - NAMELIST /BLAZENML/ HydePath, BurnedAreaSource, BurnedAreaFile, BurnedAreaClimatologyFile, & - SIMFIRE_REGION + NAMELIST /SIMFIRENML/ SIMFIRE_REGION, HydePath, BurnedAreaClimatologyFile !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! SF%RES = 1./12. - - ! SF%RES = 0.5 + SF%RES = 0.5 ! CLN should stay 0.5 deg becasue SIMFIRE was trained on it. SF%NCELLS = NCELLS ALLOCATE( SF%IGBP (NCELLS) ) @@ -113,17 +110,15 @@ SUBROUTINE INI_SIMFIRE( NCELLS, SF, modis_igbp ) !vh! ! inherit modis_igbp from climate variable - - ! READ BLAZE settings - CALL GET_UNIT(iu) - OPEN (iu,FILE="BLAZE.nml",STATUS='OLD',ACTION='READ') - READ (iu,NML=BLAZENML) - CLOSE(iu) - - SF%HYDEPATH = TRIM(HydePath) - SF%BA_CLIM_FILE = TRIM(BurnedAreaClimatologyFile) - + CALL GET_UNIT(iu) + OPEN (iu,FILE="blaze.nml",STATUS='OLD',ACTION='READ') + READ (iu,NML=SIMFIRENML) + CLOSE(iu) + + SF%HYDEPATH = TRIM(HydePath) + SF%BA_CLIM_FILE = TRIM(BurnedAreaClimatologyFile) + WRITE(*,*)"SIMFIRENML :", SIMFIRE_REGION, HydePath, BurnedAreaClimatologyFile SF%IGBP = modis_igbp DO i = 1, NCELLS @@ -136,8 +131,8 @@ SUBROUTINE INI_SIMFIRE( NCELLS, SF, modis_igbp ) SF%BIOME(i) = IGBP2BIOME(SF%IGBP(i),1) ENDIF - WRITE(*,FMT='(A5,I2,A17,I1,(1X,F7.2))')"IGBP ",SF%IGBP(i)," -> SIMFIREBIOME ", & - SF%BIOME(i),SF%LAT(i), SF%LON(i) + !WRITE(*,FMT='(A5,I2,A17,I1,(1X,F7.2))')"IGBP ",SF%IGBP(i)," -> SIMFIREBIOME ", & + ! SF%BIOME(i),SF%LAT(i), SF%LON(i) IF ( TRIM(SIMFIRE_REGION) == "GLOBAL" ) THEN ! GLOBAL SF%REGION(i) = 1 @@ -278,12 +273,12 @@ SUBROUTINE GET_POPDENS ( SF, YEAR ) ELSE ISTEP = 5 END IF - SF%RES = HYRES + !CLN WROOONGGG!!!! SF%RES = HYRES IF ( CALL1 ) THEN RF = NINT(SF%RES/HYRES) ! Check for Res being an integral multiple of 5' [RES] = fract. deg IF ( REAL(RF) .NE. SF%RES/HYRES .OR. SF%RES .LT. HYRES ) THEN - WRITE(*,*) 'Spatial resolution must be integral multiple of HYDE res. ' + WRITE(*,*) 'Spatial resolution must be integer multiple of HYDE res. ' WRITE(*,*) "RES:",SF%RES,"/ HYDE:",HYRES," = ",SF%RES/HYRES STOP "get_popdens in simfire_mod.f90" END IF @@ -323,7 +318,7 @@ SUBROUTINE GET_POPDENS ( SF, YEAR ) Y(i) = INT( (SF%LAT(i) + 90.) / SF%RES ) + 1 END DO - write(*,*) 'X,Y:', X, Y,SF%RES + !write(*,*) 'X,Y:', X, Y,SF%RES NREAD = 2 CALL1 = .FALSE. ELSE IF ( YEAR .GE. FINAL_YEAR ) THEN @@ -339,7 +334,7 @@ SUBROUTINE GET_POPDENS ( SF, YEAR ) NREAD = 0 END IF - SF%RES = 1./12. + !CLN SF%RES = 1./12. RF = NINT(SF%RES/HYRES) @@ -393,7 +388,7 @@ SUBROUTINE GET_POPDENS ( SF, YEAR ) ix0 = RF * (X(i)-1) + 1 jy0 = RF * (Y(i)-1) + 1 dxy = RF - 1 -!write(*,*) 'ix0,iy0', RF,ix0, jy0 + !write(*,*) 'ix0,iy0', RF,ix0, jy0 ! average over sub-gridcells, weighted by land area of cell wPOPD = 0. wTOT = 0. @@ -403,14 +398,21 @@ SUBROUTINE GET_POPDENS ( SF, YEAR ) wPOPD = wPOPD + RVAL(ix,jy) * LAND_AREA(ix,jy) wTOT = wTOT + LAND_AREA(ix,jy) - write(*,*) 'RVAL: ', RVAL(ix,jy), ix, jy + !write(*,*) 'RVAL: ', RVAL(ix,jy), ix, jy + END DO END DO IF ( wTOT .EQ. 0. ) THEN + ! There are land-pixels in the CABLE grid that are non-land in HYDE 3.1 + ! therefore assume zero population on these WRITE(*,*)"Pixel LAT:",SF%LAT(i)," LON:",SF%LON(i)," does not contain land!" - STOP "GET_POPDENS in simfire_mod.f90" - ELSEIF ( nr .EQ. 1 ) THEN + !CLN STOP "GET_POPDENS in simfire_mod.f90" + wPOPD = 0. + wTOT = 1. + ENDIF + + IF ( nr .EQ. 1 ) THEN EPOPD(i) = wPOPD / wTOT ELSE SPOPD(i) = wPOPD / wTOT @@ -508,10 +510,6 @@ FUNCTION ANNUAL_BA ( FAPAR, FIRE_IDX, POPDENS, BIOME, REGIO_FLAG ) ELSE ANNUAL_BA = & a(BIOME,ai) * FAPAR ** b(ai) * (scalar * FIRE_IDX) ** c(ai) * EXP(e(ai)*POPDENS) - - - ANNUAL_BA = & - a(BIOME,ai) * FAPAR ** b(ai) * (scalar * FIRE_IDX) ** c(ai) * EXP(e(ai)*POPDENS) !CLNELSE !CLN ! W.KNORR: Instead of fpar_corr1 * fpar_leafon + fpar_corr2 * fpar_leafon * fpar_leafon, !CLN ! simply use FAPAR - the correction takes into account that fpar_leafon has a high bias @@ -524,18 +522,6 @@ FUNCTION ANNUAL_BA ( FAPAR, FIRE_IDX, POPDENS, BIOME, REGIO_FLAG ) END FUNCTION ANNUAL_BA -SUBROUTINE UPDATE_FIRE_BIOME - - - - - - - - - -END SUBROUTINE UPDATE_FIRE_BIOME - SUBROUTINE SIMFIRE ( SF, RAINF, TMAX, TMIN, DOY,MM, YEAR, AB, climate ) USE CABLE_COMMON_MODULE, ONLY: IS_LEAPYEAR diff --git a/namelists/blaze.nml b/namelists/blaze.nml new file mode 100644 index 000000000..1e40978a7 --- /dev/null +++ b/namelists/blaze.nml @@ -0,0 +1,11 @@ +&blazenml + blazeTStep = "daily" ! Call frequency ("daily","monthly","annually") + BurnedAreaSource = "SIMFIRE" ! Burnt Area ("PRESCRIBED","SIMFIRE","GFED4") + BurnedAreaFile = "/home/x_larni/STOREDIR/DATA/CABLE_INPUT/DATA_BLAZE/BA_Aust_2001-2019.nc" ! used for Prescribed fires !CLN not available for now! + OutputMode = "full" ! "std" for standard vars, "full" for full set of BLAZE output +&end +&simfirenml + SIMFIRE_REGION = "ANZ" ! ("ANZ","EUROPE","GLOBAL") + HydePath = "/home/x_larni/STOREDIR/DATA/CABLE_INPUT/DATA_BLAZE/HYDE3.1" ! PAth to Hyde3.1 population density data + BurnedAreaClimatologyFile = "/home/x_larni/STOREDIR/DATA/CABLE_INPUT/DATA_BLAZE/simfire_monthly_ba.nc" ! BA climatology file (needed when blazeTStep!="annual" +&end diff --git a/namelists/cable.nml b/namelists/cable.nml index a92a988c0..ef08358d9 100644 --- a/namelists/cable.nml +++ b/namelists/cable.nml @@ -1,7 +1,7 @@ &cable filename%met = '' filename%path = './' - filename%type = 'CABLE-AUX/offline/gridinfo_CSIRO_1x1.nc' + filename%type = 'CABLE-AUX/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc' filename%veg = 'driver_files/def_veg_params.txt' filename%soil = 'driver_files/def_soil_params.txt' filename%log = 'logs/log_cable.txt' @@ -14,10 +14,10 @@ cable_user%POP_restart_in = 'restart/pop_cru_ini.nc' ! POP restart_in cable_user%POP_restart_out = 'restart/pop_cru_ini.nc' ! POP restart_out cable_user%LUC_restart_in = '' ! LUC restart_in - cable_user%LUC_restart_out = 'restart/cru_LUC_rst.nc' ! LUC restart_out - cable_user%LUC_outfile = 'outputs/cru_out_LUC.nc' - cable_user%climate_restart_in = 'restart/cru_climate_rst.nc' ! climate restart_in - cable_user%climate_restart_out = 'restart/cru_climate_rst.nc' ! climate restart_out + cable_user%LUC_restart_out = 'restart/bios_LUC_rst.nc' ! LUC restart_out + cable_user%LUC_outfile = 'outputs/bios_out_LUC.nc' + cable_user%climate_restart_in = 'restart/bios_climate_rst.nc' ! climate restart_in + cable_user%climate_restart_out = 'restart/bios_climate_rst.nc' ! climate restart_out vegparmnew = .TRUE. ! using new format when true soilparmnew = .TRUE. ! using new format when true spinup = .FALSE. ! do we spin up the model? @@ -29,7 +29,6 @@ output%flux = .TRUE. ! convective, runoff, NEE output%soil = .TRUE. ! soil states output%snow = .TRUE. ! snow states - output%snowmip = .false. ! ESM-SnowMIP variables output%radiation = .TRUE. ! net rad, albedo output%casa = .TRUE. output%carbon = .TRUE. ! NEE, GPP, NPP, stores @@ -52,7 +51,7 @@ icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, ! 1 for C, 2 for C+N, 3 for C+N+P casafile%cnpbiome = 'driver_files/pftlookup.csv' ! biome specific BGC parameters - casafile%phen = 'CABLE-AUX/offline/modis_phenology_csiro.txt' ! modis phenology + casafile%phen = 'CABLE-AUX/core/biogeochem/modis_phenology_csiro.txt' ! modis phenology casafile%cnpflux = 'cnpfluxOut.csv' ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met redistrb = .FALSE. ! Turn on/off the hydraulic redistribution @@ -76,15 +75,16 @@ cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 cable_user%LogWorker = .FALSE. cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method - cable_user%SOIL_STRUC = 'default' ! 'default','sli' + cable_user%SOIL_STRUC = 'sli' ! 'default','sli' + cable_user%Rubisco_parameters = 'Bernacchi_2002' cable_user%CALL_POP = .TRUE. ! TRUE uses POP population dynamics model, coupled to CASA. - cable_user%POP_out = 'epi' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_out = 'ini' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode cable_user%POP_fromZero = .FALSE. ! Start POP from Zero, don't read restart file cable_user%CASA_fromZero = .FALSE. - cable_user%RunIden = 'cru' ! Unique identifier for model Run, will be used in Filenames + cable_user%RunIden = 'bios' ! Unique identifier for model Run, will be used in Filenames cable_user%YearStart = 1990 ! YYYY 4 digit year cable_user%YearEnd = 2017 ! YYYY 4 digit year - cable_user%MetType = 'cru' ! Either 'gswp' or 'plum' for PLUME + cable_user%MetType = 'bios' ! Either 'gswp' or 'plum' for PLUME cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq cable_user%CLIMATE_fromZero = .FALSE. cable_user%CALL_CLIMATE = .TRUE. @@ -92,25 +92,15 @@ cable_user%POPLUC = .TRUE. cable_user%POPLUC_RunType = 'static' cable_user%vcmax = 'Walker2014' - cable_user%gs_switch = 'medlyn' - cable_user%explicit_gm = .FALSE. - cable_user%Rubisco_parameters = 'Bernacchi_2002' + cable_user%gs_switch = 'leuning' cable_user%coordinate_photosyn = .TRUE. - cable_user%acclimate_photosyn = .FALSE. - cable_user%g0_switch = 'default' + cable_user%acclimate_photosyn = .TRUE. + cable_user%acclimate_autoresp_seasonal = .TRUE. cable_user%limit_labile = .FALSE. cable_user%SRF = .TRUE. cable_user%SMRF_NAME = 'Trudinger2016' - cable_user%STRF_NAME = 'LT1994' - cable_user%c13o2 = .false. ! switch 13CO2 calculations on - cable_user%c13o2_simple_disc = .false. ! simple or full leaf discrimination - cable_user%c13o2_delta_atm_file = 'graven_et_al_gmd_2017-table_s1-delta_13c.txt' ! atmospheric 13CO2 - cable_user%c13o2_outfile = 'outputs/cru_out_casa_c13o2.nc' ! 13C Casa and LUC output file - cable_user%c13o2_restart_in_flux = 'restart/cru_c13o2_flux_rst.nc' ! 13CO2 restart Canopy input file - cable_user%c13o2_restart_out_flux = 'restart/cru_c13o2_flux_rst.nc' ! 13CO2 restart Canopy output file - cable_user%c13o2_restart_in_pools = 'restart/cru_c13o2_pools_rst.nc' ! 13CO2 restart Casa input file - cable_user%c13o2_restart_out_pools = 'restart/cru_c13o2_pools_rst.nc' ! 13CO2 restart Casa output file - cable_user%c13o2_restart_in_luc = 'restart/cru_c13o2_luc_rst.nc' ! 13CO2 restart LUC input file - cable_user%c13o2_restart_out_luc = 'restart/cru_c13o2_luc_rst.nc' ! 13CO2 restart LUC output file - output%c13o2 = .true. ! 13C in Cable output -/ + cable_user%STRF_NAME = 'Q10' + cable_user%within_canopy_isothermal = .TRUE. + cable_user%amphistomatous = .TRUE. + cable_user%CALL_BLAZE = .TRUE. ! Switch on/off Fire-model BLAZE +&end diff --git a/namelists_bios/LUC.nml b/namelists_bios/LUC.nml new file mode 100755 index 000000000..bcdf58888 --- /dev/null +++ b/namelists_bios/LUC.nml @@ -0,0 +1,10 @@ +&LUCNML + + !TransitionFilePath ="/g/data1a/x45/LUH2/GCB_2018/1deg/EXTRACT" + TransitionFilePath ="/OSM/CBR/OA_GLOBALCABLE/work/LUH2/LUH2_Aug2019/1deg/EXTRACT" + ClimateFile ="/OSM/CBR/OA_GLOBALCABLE/work/Vanessa/MASKS/cru_climate_rst_test_savanna_1x1.nc" + DirectRead = .FALSE. + YearStart = 2000 + YearEnd = 2014 + NotPrimOnlyFile = "none" +&end \ No newline at end of file diff --git a/namelists_bios/bios.nml b/namelists_bios/bios.nml new file mode 100755 index 000000000..b1062b66d --- /dev/null +++ b/namelists_bios/bios.nml @@ -0,0 +1,59 @@ +&biosnml +! Bios Namelist File + +Run = "standard" + +! Pathnames for meteorology and spatially varying parameters. File format is dated binfile, +met_path = "/g/data/x45/BIOS3_forcing/aust_0.25_pts/met/" +param_path = "/g/data/x45/BIOS3_forcing/aust_0.25_pts/params/" + +! Operational landmask. Format is gridded flt file. +landmaskflt_file = "/g/data/x45/BIOS3_forcing/aust_0.25_pts/australia_op_maskv2ctr25.flt" +landmaskhdr_file = "/g/data/x45/BIOS3_forcing/aust_0.25_pts/australia_op_maskv2ctr25.hdr" + +! Meteorology files. File format is dated bin files. +rain_file = "1900010120200229_rain_b2003.bin" +swdown_file = "1900010120200229_rad_b2003.bin" +tairmax_file = "1900010120200229_tmax_noclim_b2003.bin" +tairmin_file = "1900010120200229_tmin_noclim_b2003.bin" +wind_file = "1900010120200229_windspeed_ms_b2003.bin" +vp0900_file = "1900010120200229_vph09_b2003.bin" +vp1500_file = "1900010120200229_vph15_b2003.bin" +co2_file = "1750_2020_globalCO2_time_series.bin" + +! Spatially-varying soil parameters. Format is undated bin files. +b1_file = "b1.bin" +b2_file = "b2.bin" +bulkdens1_kgm3_file = "bulkdens1_kgm3.bin" +bulkdens2_kgm3_file = "bulkdens2_kgm3.bin" +clayfrac1_file = "clayfrac1.bin" +clayfrac2_file = "clayfrac2.bin" +csoil1_file = "csoil1.bin" +csoil2_file = "csoil2.bin" +depth1_m_file = "depth1_m.bin" +depth2_m_file = "depth2_m.bin" +hyk1sat_ms_file = "hyk1sat_ms.bin" +hyk2sat_ms_file = "hyk2sat_ms.bin" +psie1_m_file = "psie1_m.bin" +psie2_m_file = "psie2_m.bin" +siltfrac1_file = "siltfrac1.bin" +siltfrac2_file = "siltfrac2.bin" +wvol1fc_m3m3_file = "wvol1fc_m3m3.bin" +wvol2fc_m3m3_file = "wvol2fc_m3m3.bin" +wvol1sat_m3m3_file = "wvol1sat_m3m3.bin" +wvol2sat_m3m3_file = "wvol2sat_m3m3.bin" +wvol1w_m3m3_file = "wvol1w_m3m3.bin" +wvol2w_m3m3_file = "wvol2w_m3m3.bin" +MVG_file = "nvis5pre1750grp.bin" +c4frac_file = "c4_grass_frac_cov.bin" +vegtypeigbp_file = "vegtypeigbp_ctr05.bin" +avgannmax_fapar_file = "avgannmaxdata1998-2005_ctr05.bin" + +! Terrain slope in degrees +!slope_deg_file = "slope_deg.bin" + +! Timestep size in seconds +dels = 10800. + +&end + diff --git a/namelists_bios/bios_global.nml b/namelists_bios/bios_global.nml new file mode 100755 index 000000000..e1455e4ba --- /dev/null +++ b/namelists_bios/bios_global.nml @@ -0,0 +1,59 @@ +&biosnml +! Bios Namelist File + +Run = "standard" + +! Pathnames for meteorology and spatially varying parameters. File format is dated binfile, +met_path="/g/data/x45/BIOS3_forcing/acttest9/met//" +param_path="/g/data/x45/BIOS3_forcing/acttest9/params/" + +! Operational landmask. Format is gridded flt file. +landmaskflt_file="/g/data/x45/BIOS3_forcing/acttest9/acttest9.flt" +landmaskhdr_file="/g/data/x45/BIOS3_forcing/acttest9/acttest9.hdr" + +! Meteorology files. File format is dated bin files. +rain_file="1900010120201231_rain_b2003.bin" +swdown_file="1900010120201231_rad_b2003.bin" +tairmax_file="1900010120201231_tmax_noclim_b2003.bin" +tairmin_file="1900010120201231_tmin_noclim_b2003.bin" +wind_file="1900010120201231_windspeed_ms_b2003.bin" +vp0900_file="1900010120201231_vph09_b2003.bin" +vp1500_file="1900010120201231_vph15_b2003.bin" +co2_file="1750_2020_globalCO2_time_series.bin" + +! Spatially-varying soil parameters. Format is undated bin files. +b1_file = "b1.bin" +b2_file = "b2.bin" +bulkdens1_kgm3_file = "bulkdens1_kgm3.bin" +bulkdens2_kgm3_file = "bulkdens2_kgm3.bin" +clayfrac1_file = "clayfrac1.bin" +clayfrac2_file = "clayfrac2.bin" +csoil1_file = "csoil1.bin" +csoil2_file = "csoil2.bin" +depth1_m_file = "depth1_m.bin" +depth2_m_file = "depth2_m.bin" +hyk1sat_ms_file = "hyk1sat_ms.bin" +hyk2sat_ms_file = "hyk2sat_ms.bin" +psie1_m_file = "psie1_m.bin" +psie2_m_file = "psie2_m.bin" +siltfrac1_file = "siltfrac1.bin" +siltfrac2_file = "siltfrac2.bin" +wvol1fc_m3m3_file = "wvol1fc_m3m3.bin" +wvol2fc_m3m3_file = "wvol2fc_m3m3.bin" +wvol1sat_m3m3_file = "wvol1sat_m3m3.bin" +wvol2sat_m3m3_file = "wvol2sat_m3m3.bin" +wvol1w_m3m3_file = "wvol1w_m3m3.bin" +wvol2w_m3m3_file = "wvol2w_m3m3.bin" +MVG_file = "nvis5pre1750grp.bin" +c4frac_file = "c4_grass_frac_cov.bin" +vegtypeigbp_file = "vegtypeigbp_ctr05.bin" +avgannmax_fapar_file = "avgannmaxdata1998-2005_ctr05.bin" + +! Terrain slope in degrees +!slope_deg_file = "slope_deg.bin" + +! Timestep size in seconds +dels = 10800. + +&end + diff --git a/namelists_bios/blaze.nml b/namelists_bios/blaze.nml new file mode 100755 index 000000000..75af36513 --- /dev/null +++ b/namelists_bios/blaze.nml @@ -0,0 +1,11 @@ +&blazenml + blazeTStep = "annually" ! Call frequency ("daily","monthly","annually") + BurnedAreaSource = "SIMFIRE" ! Burnt Area ("PRESCRIBED","SIMFIRE","GFED4") + BurnedAreaFile = "/home/x_larni/STOREDIR/DATA/CABLE_INPUT/DATA_BLAZE/BA_Aust_2001-2019.nc" ! used for Prescribed fires !CLN not available for now! + OutputMode = "full" ! "std" for standard vars, "full" for full set of BLAZE output +&end +&simfirenml + SIMFIRE_REGION = "ANZ" ! ("ANZ","EUROPE","GLOBAL") + HydePath = "/home/x_larni/STOREDIR/DATA/CABLE_INPUT/DATA_BLAZE/HYDE3.1" ! PAth to Hyde3.1 population density data + BurnedAreaClimatologyFile = "/home/x_larni/STOREDIR/DATA/CABLE_INPUT/DATA_BLAZE/simfire_monthly_ba.nc" ! BA climatology file (needed when blazeTStep!="annual" +&end diff --git a/namelists_bios/cable.nml b/namelists_bios/cable.nml new file mode 100755 index 000000000..30f04f66c --- /dev/null +++ b/namelists_bios/cable.nml @@ -0,0 +1,107 @@ +&cable + filename%met = '' + filename%path = './' + filename%type = 'CABLE-AUX/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc' + filename%veg = 'driver_files/def_veg_params.txt' + filename%soil = 'driver_files/def_soil_params.txt' + filename%log = 'logs/log_cable.txt' + filename%out = 'outputs/bios_out_cable.nc' + filename%restart_in = 'restart/bios_cable_rst.nc' + filename%restart_out = 'restart/bios_cable_rst.nc' + casafile%out = 'outputs/bios_out_casa.nc' ! casa + casafile%cnpipool = 'restart/bios_casa_rst.nc' ! casa restart_in + casafile%cnpepool = 'restart/bios_casa_rst.nc' ! casa restart_out + cable_user%POP_restart_in = 'restart/pop_bios_ini.nc' ! POP restart_in + cable_user%POP_restart_out = 'restart/pop_bios_ini.nc' ! POP restart_out + cable_user%LUC_restart_in = '' ! LUC restart_in + cable_user%LUC_restart_out = 'restart/bios_LUC_rst.nc' ! LUC restart_out + cable_user%LUC_outfile = 'outputs/bios_out_LUC.nc' + cable_user%climate_restart_in = 'restart/bios_climate_rst.nc' ! climate restart_in + cable_user%climate_restart_out = 'restart/bios_climate_rst.nc' ! climate restart_out + vegparmnew = .TRUE. ! using new format when true + soilparmnew = .TRUE. ! using new format when true + spinup = .FALSE. ! do we spin up the model? + delsoilM = 0.01 ! allowed variation in soil moisture for spin up + delsoilT = 0.1 ! allowed variation in soil temperature for spin up + output%grid = 'land' ! should a restart file be created? + output%restart = .TRUE. ! should a restart file be created? + output%met = .TRUE. ! input met data + output%flux = .TRUE. ! convective, runoff, NEE + output%soil = .TRUE. ! soil states + output%snow = .TRUE. ! snow states + output%radiation = .TRUE. ! net rad, albedo + output%casa = .TRUE. + output%carbon = .TRUE. ! NEE, GPP, NPP, stores + output%veg = .TRUE. ! vegetation states + output%params = .TRUE. ! input parameters used to produce run + output%balances = .TRUE. ! energy and water balances + output%patch = .TRUE. + output%averaging = 'monthly' + check%ranges = .FALSE. ! variable ranges, input and output + check%energy_bal = .TRUE. ! energy balance + check%mass_bal = .TRUE. ! water/mass balance + verbose = .FALSE. ! write details of every grid cell init and params to log? + leaps = .FALSE. ! calculate timing with leap years? + logn = 88 ! log file number - declared in input module + fixedCO2 = 350.0 ! if not found in met file, in ppmv + spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be + ! set to FALSE if spincasainput = .TRUE. + l_laiFeedbk = .TRUE. ! using prognostic LAI + l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax + icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, + ! 1 for C, 2 for C+N, 3 for C+N+P + casafile%cnpbiome = 'driver_files/pftlookup.csv' ! biome specific BGC parameters + casafile%phen = 'CABLE-AUX/core/biogeochem/modis_phenology_csiro.txt' ! modis phenology + casafile%cnpflux = 'cnpfluxOut.csv' + ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met + redistrb = .FALSE. ! Turn on/off the hydraulic redistribution + wiltParam = 0.5 + satuParam = 0.8 + cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: + ! 1. standard + ! 2. non-linear extrapolation + ! 3. Lai and Ktaul 2000 + ! 4. Haverd2013 + cable_user%litter = .true. + cable_user%DIAG_SOIL_RESP = 'ON ' + cable_user%LEAF_RESPIRATION = 'ON ' + cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: + ! 1. BASIC + ! 1. NONE + cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run + cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format + cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format + cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 + cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 + cable_user%LogWorker = .FALSE. + cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method + cable_user%SOIL_STRUC = 'sli' ! 'default','sli' + cable_user%CALL_POP = .TRUE. ! TRUE uses POP population dynamics model, coupled to CASA. + cable_user%POP_out = 'ini' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_fromZero = .FALSE. ! Start POP from Zero, don't read restart file + cable_user%CASA_fromZero = .FALSE. + cable_user%RunIden = 'bios' ! Unique identifier for model Run, will be used in Filenames + cable_user%YearStart = 1990 ! YYYY 4 digit year + cable_user%YearEnd = 2017 ! YYYY 4 digit year + cable_user%MetType = 'bios' ! Either 'gswp' or 'plum' for PLUME + cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq + cable_user%CLIMATE_fromZero = .FALSE. + cable_user%CALL_CLIMATE = .TRUE. + cable_user%PHENOLOGY_SWITCH = 'climate' + cable_user%POPLUC = .TRUE. + cable_user%POPLUC_RunType = 'static' + cable_user%vcmax = 'Walker2014' + cable_user%gs_switch = 'leuning' + cable_user%explicit_gm = .FALSE. + cable_user%Rubisco_parameters = "Bernacchi_2002" + cable_user%coordinate_photosyn = .TRUE. + cable_user%acclimate_photosyn = .TRUE. + cable_user%acclimate_autoresp_seasonal = .TRUE. + cable_user%limit_labile = .FALSE. + cable_user%SRF = .TRUE. + cable_user%SMRF_NAME = 'Trudinger2016' + cable_user%STRF_NAME = 'Q10' + cable_user%within_canopy_isothermal = .TRUE. + cable_user%amphistomatous = .TRUE. + cable_user%CALL_BLAZE = .TRUE. +&end diff --git a/namelists_bios/cable_05_08_2020.nml b/namelists_bios/cable_05_08_2020.nml new file mode 100755 index 000000000..b4935567e --- /dev/null +++ b/namelists_bios/cable_05_08_2020.nml @@ -0,0 +1,105 @@ +&cable + filename%met = '' + filename%path = './' + filename%type = 'CABLE-AUX/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc' + filename%veg = 'driver_files/def_veg_params.txt' + filename%soil = 'driver_files/def_soil_params.txt' + filename%log = 'logs/log_cable.txt' + filename%out = 'outputs/bios_out_cable.nc' + filename%restart_in = 'restart/bios_cable_rst.nc' + filename%restart_out = 'restart/bios_cable_rst.nc' + casafile%out = 'outputs/bios_out_casa.nc' ! casa + casafile%cnpipool = 'restart/bios_casa_rst.nc' ! casa restart_in + casafile%cnpepool = 'restart/bios_casa_rst.nc' ! casa restart_out + cable_user%POP_restart_in = 'restart/pop_bios_ini.nc' ! POP restart_in + cable_user%POP_restart_out = 'restart/pop_bios_ini.nc' ! POP restart_out + cable_user%LUC_restart_in = '' ! LUC restart_in + cable_user%LUC_restart_out = 'restart/bios_LUC_rst.nc' ! LUC restart_out + cable_user%LUC_outfile = 'outputs/bios_out_LUC.nc' + cable_user%climate_restart_in = 'restart/bios_climate_rst.nc' ! climate restart_in + cable_user%climate_restart_out = 'restart/bios_climate_rst.nc' ! climate restart_out + vegparmnew = .TRUE. ! using new format when true + soilparmnew = .TRUE. ! using new format when true + spinup = .FALSE. ! do we spin up the model? + delsoilM = 0.01 ! allowed variation in soil moisture for spin up + delsoilT = 0.1 ! allowed variation in soil temperature for spin up + output%grid = 'land' ! should a restart file be created? + output%restart = .TRUE. ! should a restart file be created? + output%met = .TRUE. ! input met data + output%flux = .TRUE. ! convective, runoff, NEE + output%soil = .TRUE. ! soil states + output%snow = .TRUE. ! snow states + output%radiation = .TRUE. ! net rad, albedo + output%casa = .TRUE. + output%carbon = .TRUE. ! NEE, GPP, NPP, stores + output%veg = .TRUE. ! vegetation states + output%params = .TRUE. ! input parameters used to produce run + output%balances = .TRUE. ! energy and water balances + output%patch = .TRUE. + output%averaging = 'monthly' + check%ranges = .FALSE. ! variable ranges, input and output + check%energy_bal = .TRUE. ! energy balance + check%mass_bal = .TRUE. ! water/mass balance + verbose = .FALSE. ! write details of every grid cell init and params to log? + leaps = .FALSE. ! calculate timing with leap years? + logn = 88 ! log file number - declared in input module + fixedCO2 = 350.0 ! if not found in met file, in ppmv + spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be + ! set to FALSE if spincasainput = .TRUE. + l_laiFeedbk = .TRUE. ! using prognostic LAI + l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax + icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, + ! 1 for C, 2 for C+N, 3 for C+N+P + casafile%cnpbiome = 'driver_files/pftlookup.csv' ! biome specific BGC parameters + casafile%phen = 'CABLE-AUX/core/biogeochem/modis_phenology_csiro.txt' ! modis phenology + casafile%cnpflux = 'cnpfluxOut.csv' + ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met + redistrb = .FALSE. ! Turn on/off the hydraulic redistribution + wiltParam = 0.5 + satuParam = 0.8 + cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: + ! 1. standard + ! 2. non-linear extrapolation + ! 3. Lai and Ktaul 2000 + ! 4. Haverd2013 + cable_user%litter = .true. + cable_user%DIAG_SOIL_RESP = 'ON ' + cable_user%LEAF_RESPIRATION = 'ON ' + cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: + ! 1. BASIC + ! 1. NONE + cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run + cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format + cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format + cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 + cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 + cable_user%LogWorker = .FALSE. + cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method + cable_user%SOIL_STRUC = 'sli' ! 'default','sli' + cable_user%CALL_POP = .TRUE. ! TRUE uses POP population dynamics model, coupled to CASA. + cable_user%POP_out = 'ini' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_fromZero = .FALSE. ! Start POP from Zero, don't read restart file + cable_user%CASA_fromZero = .FALSE. + cable_user%RunIden = 'bios' ! Unique identifier for model Run, will be used in Filenames + cable_user%YearStart = 1990 ! YYYY 4 digit year + cable_user%YearEnd = 2017 ! YYYY 4 digit year + cable_user%MetType = 'bios' ! Either 'gswp' or 'plum' for PLUME + cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq + cable_user%CLIMATE_fromZero = .FALSE. + cable_user%CALL_CLIMATE = .TRUE. + cable_user%PHENOLOGY_SWITCH = 'climate' + cable_user%POPLUC = .TRUE. + cable_user%POPLUC_RunType = 'static' + cable_user%vcmax = 'Walker2014' + cable_user%gs_switch = 'leuning' + cable_user%coordinate_photosyn = .TRUE. + cable_user%acclimate_photosyn = .TRUE. + cable_user%acclimate_autoresp_seasonal = .TRUE. + cable_user%limit_labile = .FALSE. + cable_user%SRF = .TRUE. + cable_user%SMRF_NAME = 'Trudinger2016' + cable_user%STRF_NAME = 'Q10' + cable_user%within_canopy_isothermal = .TRUE. + cable_user%amphistomatous = .TRUE. + cable_user%CALL_BLAZE = .FALSE. +&end diff --git a/namelists_bios/cable_before.nml b/namelists_bios/cable_before.nml new file mode 100755 index 000000000..01e96882f --- /dev/null +++ b/namelists_bios/cable_before.nml @@ -0,0 +1,121 @@ +&cable + filename%met = '' + filename%path = './' + filename%type = 'surface_data/gridinfo_CSIRO_CRU05x05_4tiles.nc' + filename%veg = 'driver_files/def_veg_params.txt' + filename%soil = 'driver_files/def_soil_params.txt' + filename%log = 'logs/log_cable.txt' + filename%out = 'outputs/cru_out_cable.nc' + filename%restart_in = 'restart/cru_cable_rst.nc' + filename%restart_out = 'restart/cru_cable_rst.nc' + casafile%out = 'outputs/cru_out_casa.nc' ! casa + casafile%cnpipool= 'restart/cru_casa_rst.nc' ! casa restart_in + casafile%cnpepool='restart/cru_casa_rst.nc' ! casa restart_out + cable_user%POP_outfile ='' + cable_user%POP_restart_in = 'restart/pop_cru_ini.nc' ! POP restart_in + cable_user%POP_restart_out = 'restart/pop_cru_ini.nc' ! POP restart_out + cable_user%LUC_restart_in = 'restart/cru_LUC_rst.nc' + cable_user%LUC_restart_out = 'restart/cru_LUC_rst.nc' + cable_user%LUC_outfile = 'outputs/cru_out_LUC.nc' + cable_user%climate_restart_in = 'restart/cru_climate_rst.nc' ! climate restart_in + cable_user%climate_restart_out = 'restart/cru_climate_rst.nc' ! climate restart_out + vegparmnew = .TRUE. ! using new format when true + soilparmnew = .TRUE. ! using new format when true + spinup = .FALSE. ! do we spin up the model? + delsoilM = 0.01 ! allowed variation in soil moisture for spin up + delsoilT = 0.1 ! allowed variation in soil temperature for spin up + output%grid = 'land' ! should a restart file be created? + output%restart = .TRUE. ! should a restart file be created? + output%met = .TRUE. ! input met data + output%flux = .TRUE. ! convective, runoff, NEE + output%soil = .TRUE. ! soil states + output%snow = .TRUE. ! snow states + output%radiation = .TRUE. ! net rad, albedo + output%casa = .TRUE. + output%carbon = .TRUE. ! NEE, GPP, NPP, stores + output%veg = .TRUE. ! vegetation states + output%params = .TRUE. ! input parameters used to produce run + output%balances = .TRUE. ! energy and water balances + output%patch = .TRUE. + output%averaging = 'all' + check%ranges = .FALSE. ! variable ranges, input and output + check%energy_bal = .TRUE. ! energy balance + check%mass_bal = .TRUE. ! water/mass balance + verbose = .FALSE. ! write details of every grid cell init and params to log? + leaps = .TRUE. ! calculate timing with leap years? + logn = 88 ! log file number - declared in input module + fixedCO2 = 350.0 ! if not found in met file, in ppmv + spincasainput = .FALSE. ! input required to spin casacnp offline + spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be + !set to FALSE if spincasainput = .TRUE. + l_casacnp = .TRUE. ! using casaCNP with CABLE (! DEPRECATED!!! use icycle instead!)) + l_laiFeedbk = .TRUE. ! using prognostic LAI + l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax + icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, + ! 1 for C, 2 for C+N, 3 for C+N+P + casafile%cnpbiome='/short/x45/surface_data_PLUME/pftlookup_csiro_v16_17tiles_Cumberland.csv' ! biome specific BGC parameters + casafile%cnpmetout='casamet.nc' ! output daily met forcing for spinning casacnp + casafile%cnpmetin='' ! list of daily met files for spinning casacnp + casafile%phen='/short/x45/surface_data_PLUME/modis_phenology_csiro.txt' ! modis phenology + casafile%cnpflux='cnpfluxOut.csv' + ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met + gswpfile%rainf = '/data/nie06a/MET/PLUMBER/Rainf_gswp_1986_plumber.nc' + gswpfile%snowf = '/data/nie06a/MET/PLUMBER/Snowf_gswp_1986_plumber.nc' + gswpfile%LWdown= '/data/nie06a/MET/PLUMBER/LWdown_srb_1986_plumber.nc' + gswpfile%SWdown= '/data/nie06a/MET/PLUMBER/SWdown_srb_1986_plumber.nc' + gswpfile%PSurf = '/data/nie06a/MET/PLUMBER/PSurf_ecor_1986_plumber.nc' + gswpfile%Qair = '/data/nie06a/MET/PLUMBER/Qair_cru_1986_plumber.nc' + gswpfile%Tair = '/data/nie06a/MET/PLUMBER/Tair_cru_1986_plumber.nc' + gswpfile%wind = '/data/nie06a/MET/PLUMBER/Wind_ncep_1986_plumber.nc' + redistrb = .FALSE. ! Turn on/off the hydraulic redistribution + wiltParam = 0.5 + satuParam = 0.8 + cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: + ! 1. standard + ! 2. non-linear extrapolation + ! 3. Lai and Ktaul 2000 + ! 4. Haverd2013 + cable_user%litter = .true. + cable_user%DIAG_SOIL_RESP = 'ON ' + cable_user%LEAF_RESPIRATION = 'ON ' + cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: + ! 1. BASIC + ! 1. NONE + cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run + cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format + cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format + cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 + cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 + cable_user%CASA_NREP = 0 ! number of times to repeat CASA forcing + cable_user%LogWorker = .FALSE. + cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method + cable_user%SOIL_STRUC = 'sli' ! 'default','sli' + cable_user%CALL_POP = .FALSE. ! TRUE uses POP population dynamics model, coupled to CASA. + cable_user%POP_out = 'epi' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_rst = './' ! Pop-output file to read restart values from (default is rst-file) + cable_user%POP_fromZero = .T. ! Start POP from Zero, don't read restart file + cable_user%CASA_fromZero = .T. + cable_user%RunIden = 'Cumberland' ! Unique identifier for model Run, will be used in Filenames + cable_user%YearStart = 1831 ! YYYY 4 digit year + cable_user%YearEnd = 1851 ! YYYY 4 digit year + cable_user%MetType = 'site' ! Either 'gswp' or 'plum' for PLUME + cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq 'daily','monthly' or 'annually' + cable_user%CLIMATE_fromZero =.T. + cable_user%CALL_CLIMATE =.T. + cable_user%PHENOLOGY_SWITCH = 'climate' + cable_user%POPLUC = .FALSE. + cable_user%POPLUC_RunType = 'static' + cable_user%vcmax = 'Walker2014' + cable_user%gs_switch = 'medlyn' + cable_user%explicit_gm = .FALSE. + cable_user%gm_LUT_file = 'params/gm_LUT_351x3601x7_1pt8245.nc' ! LUT for parameter conversion if explicit_gm = T. Leave blank to use algorithm + !cable_user%gm_LUT_file = '' + cable_user%coordinate_photosyn = .TRUE. + cable_user%g0_switch = 'maximum' + cable_user%acclimate_photosyn = .FALSE. + cable_user%limit_labile = .FALSE. + cable_user%SRF = .T. + cable_user%SMRF_NAME = 'Trudinger2016' + cable_user%STRF_NAME = 'LT1994' + +&end diff --git a/namelists_bios/cable_global.nml b/namelists_bios/cable_global.nml new file mode 100755 index 000000000..5aeba5e00 --- /dev/null +++ b/namelists_bios/cable_global.nml @@ -0,0 +1,122 @@ +&cable + filename%met = '' + filename%path = './' + filename%type="/g/data/x45/CABLE-AUX/offline/gridinfo_CSIRO_1x1.nc" + filename%veg="/home/599/jk8585/CABLE_run/gm_acclim_coord/params/def_veg_params.txt" + filename%soil="/home/599/jk8585/CABLE_run/gm_acclim_coord/params/def_soil_params.txt" + filename%log = 'logs/log_cable.txt' + filename%out="outputs/plume_out_cable.nc" + filename%restart_in="restart/plume_cable_rst.nc" + filename%restart_out="restart/plume_cable_rst.nc" + casafile%out="outputs/plume_out_casa.nc" + casafile%cnpipool="restart/plume_casa_rst.nc" + casafile%cnpepool="restart/plume_casa_rst.nc" + cable_user%POP_outfile ='' + cable_user%POP_restart_in="restart/pop_plume_ini.nc" + cable_user%POP_restart_out="restart/pop_plume_ini.nc" + cable_user%LUC_restart_in="restart/plume_LUC_rst.nc" + cable_user%LUC_restart_out="restart/plume_LUC_rst.nc" + cable_user%LUC_outfile="outputs/plume_out_LUC.nc" + cable_user%climate_restart_in="restart/plume_climate_rst.nc" + cable_user%climate_restart_out="restart/plume_climate_rst.nc" + vegparmnew = .TRUE. ! using new format when true + soilparmnew = .TRUE. ! using new format when true + spinup = .FALSE. ! do we spin up the model? + delsoilM = 0.01 ! allowed variation in soil moisture for spin up + delsoilT = 0.1 ! allowed variation in soil temperature for spin up + output%grid="mask" + output%restart = .TRUE. ! should a restart file be created? + output%met = .TRUE. ! input met data + output%flux = .TRUE. ! convective, runoff, NEE + output%soil = .TRUE. ! soil states + output%snow = .TRUE. ! snow states + output%radiation = .TRUE. ! net rad, albedo + output%casa = .TRUE. + output%carbon = .TRUE. ! NEE, GPP, NPP, stores + output%veg = .TRUE. ! vegetation states + output%params = .TRUE. ! input parameters used to produce run + output%balances = .TRUE. ! energy and water balances + output%patch = .TRUE. + output%averaging="monthly" + check%ranges = .FALSE. ! variable ranges, input and output + check%energy_bal = .TRUE. ! energy balance + check%mass_bal = .TRUE. ! water/mass balance + verbose = .FALSE. ! write details of every grid cell init and params to log? + leaps=.FALSE. + logn = 88 ! log file number - declared in input module + fixedCO2 = 350.0 ! if not found in met file, in ppmv + spincasainput = .FALSE. ! input required to spin casacnp offline + spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be + !set to FALSE if spincasainput = .TRUE. + l_casacnp = .TRUE. ! using casaCNP with CABLE (! DEPRECATED!!! use icycle instead!)) + l_laiFeedbk = .TRUE. ! using prognostic LAI + l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax + icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, + ! 1 for C, 2 for C+N, 3 for C+N+P + casafile%cnpbiome='/short/x45/surface_data_PLUME/pftlookup_csiro_v16_17tiles_Cumberland.csv' ! biome specific BGC parameters + casafile%cnpmetout='casamet.nc' ! output daily met forcing for spinning casacnp + casafile%cnpmetin='' ! list of daily met files for spinning casacnp + casafile%phen='/short/x45/surface_data_PLUME/modis_phenology_csiro.txt' ! modis phenology + casafile%cnpflux='cnpfluxOut.csv' + ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met + gswpfile%rainf = '/data/nie06a/MET/PLUMBER/Rainf_gswp_1986_plumber.nc' + gswpfile%snowf = '/data/nie06a/MET/PLUMBER/Snowf_gswp_1986_plumber.nc' + gswpfile%LWdown= '/data/nie06a/MET/PLUMBER/LWdown_srb_1986_plumber.nc' + gswpfile%SWdown= '/data/nie06a/MET/PLUMBER/SWdown_srb_1986_plumber.nc' + gswpfile%PSurf = '/data/nie06a/MET/PLUMBER/PSurf_ecor_1986_plumber.nc' + gswpfile%Qair = '/data/nie06a/MET/PLUMBER/Qair_cru_1986_plumber.nc' + gswpfile%Tair = '/data/nie06a/MET/PLUMBER/Tair_cru_1986_plumber.nc' + gswpfile%wind = '/data/nie06a/MET/PLUMBER/Wind_ncep_1986_plumber.nc' + redistrb = .FALSE. ! Turn on/off the hydraulic redistribution + wiltParam = 0.5 + satuParam = 0.8 + cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: + ! 1. standard + ! 2. non-linear extrapolation + ! 3. Lai and Ktaul 2000 + ! 4. Haverd2013 + cable_user%litter = .true. + cable_user%DIAG_SOIL_RESP = 'ON ' + cable_user%LEAF_RESPIRATION = 'ON ' + cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: + ! 1. BASIC + ! 1. NONE + cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run + cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format + cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format + cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 + cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 + cable_user%CASA_NREP = 0 ! number of times to repeat CASA forcing + cable_user%LogWorker = .FALSE. + cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method + cable_user%SOIL_STRUC="default" + cable_user%CALL_POP=.TRUE. + cable_user%POP_out = 'epi' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_rst = './' ! Pop-output file to read restart values from (default is rst-file) + cable_user%POP_fromZero = .T. ! Start POP from Zero, don't read restart file + cable_user%CASA_fromZero = .T. + cable_user%RunIden="plume" + cable_user%YearStart = 1831 ! YYYY 4 digit year + cable_user%YearEnd = 1851 ! YYYY 4 digit year + cable_user%MetType="plume" + cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq 'daily','monthly' or 'annually' + cable_user%CLIMATE_fromZero =.T. + cable_user%CALL_CLIMATE =.T. + cable_user%PHENOLOGY_SWITCH = 'climate' + cable_user%POPLUC = .FALSE. + cable_user%POPLUC_RunType = 'static' + cable_user%vcmax = 'Walker2014' + cable_user%gs_switch = 'medlyn' + cable_user%explicit_gm=.true. + cable_user%Rubisco_parameters="Bernacchi_2002" + cable_user%gm_LUT_file="/home/599/jk8585/CABLE_run/gm_acclim_coord/params/gm_LUT_351x3601x7_1pt8245_Bernacchi2002.nc" + !cable_user%gm_LUT_file="/home/599/jk8585/CABLE_run/gm_acclim_coord/params/gm_LUT_351x3601x7_1pt8245_Bernacchi2002.nc" + cable_user%coordinate_photosyn=.true. + cable_user%g0_switch = 'maximum' + cable_user%acclimate_photosyn=.true. + cable_user%limit_labile = .FALSE. + cable_user%SRF = .T. + cable_user%SMRF_NAME = 'Trudinger2016' + cable_user%STRF_NAME = 'LT1994' + +&end diff --git a/namelists_bios/cable_global_bios_acttest9.nml b/namelists_bios/cable_global_bios_acttest9.nml new file mode 100755 index 000000000..e6d1e8eb7 --- /dev/null +++ b/namelists_bios/cable_global_bios_acttest9.nml @@ -0,0 +1,121 @@ +&cable + filename%met = '' + filename%path = './' + filename%type="/g/data/x45/CABLE-AUX/offline/gridinfo_CSIRO_1x1.nc" + filename%veg="/home/599/jk8585/CABLE_run/BIOS3/params/def_veg_params.txt" + filename%soil="/home/599/jk8585/CABLE_run/BIOS3/params/def_soil_params.txt" + filename%log = 'logs/log_cable.txt' + filename%out="outputs/bios_out_cable.nc" + filename%restart_in="restart/bios_cable_rst.nc" + filename%restart_out="restart/bios_cable_rst.nc" + casafile%out="outputs/bios_out_casa.nc" + casafile%cnpipool="restart/bios_casa_rst.nc" + casafile%cnpepool="restart/bios_casa_rst.nc" + cable_user%POP_outfile ='' + cable_user%POP_restart_in="restart/pop_bios_ini.nc" + cable_user%POP_restart_out="restart/pop_bios_ini.nc" + cable_user%LUC_restart_in="restart/bios_LUC_rst.nc" + cable_user%LUC_restart_out="restart/bios_LUC_rst.nc" + cable_user%LUC_outfile="outputs/bios_out_LUC.nc" + cable_user%climate_restart_in="restart/bios_climate_rst.nc" + cable_user%climate_restart_out="restart/bios_climate_rst.nc" + vegparmnew = .TRUE. ! using new format when true + soilparmnew = .TRUE. ! using new format when true + spinup = .FALSE. ! do we spin up the model? + delsoilM = 0.01 ! allowed variation in soil moisture for spin up + delsoilT = 0.1 ! allowed variation in soil temperature for spin up + output%grid="mask" + output%restart = .TRUE. ! should a restart file be created? + output%met = .TRUE. ! input met data + output%flux = .TRUE. ! convective, runoff, NEE + output%soil = .TRUE. ! soil states + output%snow = .TRUE. ! snow states + output%radiation = .TRUE. ! net rad, albedo + output%casa = .TRUE. + output%carbon = .TRUE. ! NEE, GPP, NPP, stores + output%veg = .TRUE. ! vegetation states + output%params = .TRUE. ! input parameters used to produce run + output%balances = .TRUE. ! energy and water balances + output%patch = .TRUE. + output%averaging="monthly" + check%ranges = .FALSE. ! variable ranges, input and output + check%energy_bal = .TRUE. ! energy balance + check%mass_bal = .TRUE. ! water/mass balance + verbose = .FALSE. ! write details of every grid cell init and params to log? + leaps=.FALSE. + logn = 88 ! log file number - declared in input module + fixedCO2 = 350.0 ! if not found in met file, in ppmv + spincasainput = .FALSE. ! input required to spin casacnp offline + spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be + !set to FALSE if spincasainput = .TRUE. + l_casacnp = .TRUE. ! using casaCNP with CABLE (! DEPRECATED!!! use icycle instead!)) + l_laiFeedbk = .TRUE. ! using prognostic LAI + l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax + icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, + ! 1 for C, 2 for C+N, 3 for C+N+P + casafile%cnpbiome='/short/x45/surface_data_PLUME/pftlookup_csiro_v16_17tiles_Cumberland.csv' ! biome specific BGC parameters + casafile%cnpmetout='casamet.nc' ! output daily met forcing for spinning casacnp + casafile%cnpmetin='' ! list of daily met files for spinning casacnp + casafile%phen='/short/x45/surface_data_PLUME/modis_phenology_csiro.txt' ! modis phenology + casafile%cnpflux='cnpfluxOut.csv' + ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met + gswpfile%rainf = '/data/nie06a/MET/PLUMBER/Rainf_gswp_1986_plumber.nc' + gswpfile%snowf = '/data/nie06a/MET/PLUMBER/Snowf_gswp_1986_plumber.nc' + gswpfile%LWdown= '/data/nie06a/MET/PLUMBER/LWdown_srb_1986_plumber.nc' + gswpfile%SWdown= '/data/nie06a/MET/PLUMBER/SWdown_srb_1986_plumber.nc' + gswpfile%PSurf = '/data/nie06a/MET/PLUMBER/PSurf_ecor_1986_plumber.nc' + gswpfile%Qair = '/data/nie06a/MET/PLUMBER/Qair_cru_1986_plumber.nc' + gswpfile%Tair = '/data/nie06a/MET/PLUMBER/Tair_cru_1986_plumber.nc' + gswpfile%wind = '/data/nie06a/MET/PLUMBER/Wind_ncep_1986_plumber.nc' + redistrb = .FALSE. ! Turn on/off the hydraulic redistribution + wiltParam = 0.5 + satuParam = 0.8 + cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: + ! 1. standard + ! 2. non-linear extrapolation + ! 3. Lai and Ktaul 2000 + ! 4. Haverd2013 + cable_user%litter = .true. + cable_user%DIAG_SOIL_RESP = 'ON ' + cable_user%LEAF_RESPIRATION = 'ON ' + cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: + ! 1. BASIC + ! 1. NONE + cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run + cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format + cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format + cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 + cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 + cable_user%CASA_NREP = 0 ! number of times to repeat CASA forcing + cable_user%LogWorker = .FALSE. + cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method + cable_user%SOIL_STRUC="default" + cable_user%CALL_POP=.TRUE. + cable_user%POP_out = 'epi' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_rst = './' ! Pop-output file to read restart values from (default is rst-file) + cable_user%POP_fromZero = .T. ! Start POP from Zero, don't read restart file + cable_user%CASA_fromZero = .T. + cable_user%RunIden="bios" + cable_user%YearStart = 1831 ! YYYY 4 digit year + cable_user%YearEnd = 1851 ! YYYY 4 digit year + cable_user%MetType="bios" + cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq 'daily','monthly' or 'annually' + cable_user%CLIMATE_fromZero =.T. + cable_user%CALL_CLIMATE =.T. + cable_user%PHENOLOGY_SWITCH = 'climate' + cable_user%POPLUC = .FALSE. + cable_user%POPLUC_RunType = 'static' + cable_user%vcmax = 'Walker2014' + cable_user%gs_switch = 'medlyn' + cable_user%explicit_gm=.false. + !cable_user%gm_LUT_file = 'params/gm_LUT_351x3601x7_1pt8245.nc' ! LUT for parameter conversion if explicit_gm = T. Leave blank to use algorithm + !cable_user%gm_LUT_file = '' + cable_user%coordinate_photosyn=.false. + cable_user%g0_switch = 'maximum' + cable_user%acclimate_photosyn=.false. + cable_user%limit_labile = .FALSE. + cable_user%SRF = .T. + cable_user%SMRF_NAME = 'Trudinger2016' + cable_user%STRF_NAME = 'LT1994' + +&end diff --git a/namelists_bios/cable_orig.nml b/namelists_bios/cable_orig.nml new file mode 100755 index 000000000..4ed7cbc39 --- /dev/null +++ b/namelists_bios/cable_orig.nml @@ -0,0 +1,116 @@ +&cable + filename%met = '' + filename%path = './' + filename%type = 'surface_data/gridinfo_CSIRO_CRU05x05_4tiles.nc' + filename%veg = 'driver_files/def_veg_params.txt' + filename%soil = 'driver_files/def_soil_params.txt' + filename%log = 'logs/log_cable.txt' + filename%out = 'outputs/bios_out_cable.nc' + filename%restart_in = 'restart/bios_cable_rst.nc' + filename%restart_out = 'restart/bios_cable_rst.nc' + casafile%out = 'outputs/bios_out_casa.nc' ! casa + casafile%cnpipool= 'restart/bios_casa_rst.nc' ! casa restart_in + casafile%cnpepool='restart/bios_casa_rst.nc' ! casa restart_out + cable_user%POP_outfile ='' + cable_user%POP_restart_in = 'restart/pop_bios_ini.nc' ! POP restart_in + cable_user%POP_restart_out = 'restart/pop_bios_ini.nc' ! POP restart_out + cable_user%climate_restart_in = 'restart/bios_climate_rst.nc' ! climate restart_in + cable_user%climate_restart_out = 'restart/bios_climate_rst.nc' ! climate restart_out + vegparmnew = .TRUE. ! using new format when true + soilparmnew = .TRUE. ! using new format when true + spinup = .FALSE. ! do we spin up the model? + delsoilM = 0.01 ! allowed variation in soil moisture for spin up + delsoilT = 0.1 ! allowed variation in soil temperature for spin up + output%grid = 'land' ! should a restart file be created? + output%restart = .TRUE. ! should a restart file be created? + output%met = .TRUE. ! input met data + output%flux = .TRUE. ! convective, runoff, NEE + output%soil = .TRUE. ! soil states + output%snow = .TRUE. ! snow states + output%radiation = .TRUE. ! net rad, albedo + output%casa = .TRUE. + output%carbon = .TRUE. ! NEE, GPP, NPP, stores + output%veg = .TRUE. ! vegetation states + output%params = .TRUE. ! input parameters used to produce run + output%balances = .TRUE. ! energy and water balances + output%patch = .TRUE. + output%averaging = 'all' + check%ranges = .FALSE. ! variable ranges, input and output + check%energy_bal = .TRUE. ! energy balance + check%mass_bal = .TRUE. ! water/mass balance + verbose = .FALSE. ! write details of every grid cell init and params to log? + leaps = .TRUE. ! calculate timing with leap years? + logn = 88 ! log file number - declared in input module + fixedCO2 = 350.0 ! if not found in met file, in ppmv + spincasainput = .FALSE. ! input required to spin casacnp offline + spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be + !set to FALSE if spincasainput = .TRUE. + l_casacnp = .TRUE. ! using casaCNP with CABLE (! DEPRECATED!!! use icycle instead!)) + l_laiFeedbk = .TRUE. ! using prognostic LAI + l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax + icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, + ! 1 for C, 2 for C+N, 3 for C+N+P + casafile%cnpbiome='/short/x45/surface_data_PLUME/pftlookup_csiro_v16_17tiles_Cumberland.csv' ! biome specific BGC parameters + casafile%cnpmetout='casamet.nc' ! output daily met forcing for spinning casacnp + casafile%cnpmetin='' ! list of daily met files for spinning casacnp + casafile%phen='/short/x45/surface_data_PLUME/modis_phenology_csiro.txt' ! modis phenology + casafile%cnpflux='cnpfluxOut.csv' + ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met + gswpfile%rainf = '/data/nie06a/MET/PLUMBER/Rainf_gswp_1986_plumber.nc' + gswpfile%snowf = '/data/nie06a/MET/PLUMBER/Snowf_gswp_1986_plumber.nc' + gswpfile%LWdown= '/data/nie06a/MET/PLUMBER/LWdown_srb_1986_plumber.nc' + gswpfile%SWdown= '/data/nie06a/MET/PLUMBER/SWdown_srb_1986_plumber.nc' + gswpfile%PSurf = '/data/nie06a/MET/PLUMBER/PSurf_ecor_1986_plumber.nc' + gswpfile%Qair = '/data/nie06a/MET/PLUMBER/Qair_cru_1986_plumber.nc' + gswpfile%Tair = '/data/nie06a/MET/PLUMBER/Tair_cru_1986_plumber.nc' + gswpfile%wind = '/data/nie06a/MET/PLUMBER/Wind_ncep_1986_plumber.nc' + redistrb = .FALSE. ! Turn on/off the hydraulic redistribution + wiltParam = 0.5 + satuParam = 0.8 + cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: + ! 1. standard + ! 2. non-linear extrapolation + ! 3. Lai and Ktaul 2000 + ! 4. Haverd2013 + cable_user%litter = .true. + cable_user%DIAG_SOIL_RESP = 'ON ' + cable_user%LEAF_RESPIRATION = 'ON ' + cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: + ! 1. BASIC + ! 1. NONE + cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run + cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format + cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format + cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 + cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 + cable_user%CASA_NREP = 0 ! number of times to repeat CASA forcing + cable_user%LogWorker = .FALSE. + cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method + cable_user%SOIL_STRUC = 'sli' ! 'default','sli' + cable_user%CALL_POP = .FALSE. ! TRUE uses POP population dynamics model, coupled to CASA. + cable_user%POP_out = 'epi' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_rst = './' ! Pop-output file to read restart values from (default is rst-file) + cable_user%POP_fromZero = .T. ! Start POP from Zero, don't read restart file + cable_user%CASA_fromZero = .T. + cable_user%RunIden = 'Cumberland' ! Unique identifier for model Run, will be used in Filenames + cable_user%YearStart = 1831 ! YYYY 4 digit year + cable_user%YearEnd = 1851 ! YYYY 4 digit year + cable_user%MetType = 'site' ! Either 'gswp' or 'plum' for PLUME + cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq 'daily','monthly' or 'annually' + cable_user%CLIMATE_fromZero =.T. + cable_user%CALL_CLIMATE =.T. + cable_user%PHENOLOGY_SWITCH = 'climate' + cable_user%POPLUC = .F. + cable_user%POPLUC_RunType = 'static' + cable_user%vcmax = 'Walker2014' + cable_user%gs_switch = 'medlyn' + cable_user%explicit_gm = .TRUE. + cable_user%coordinate_photosyn = .TRUE. + cable_user%g0_switch = 'maximum' + cable_user%acclimate_photosyn = .FALSE. + cable_user%limit_labile = .F. + cable_user%SRF = .T. + cable_user%SMRF_NAME = 'DAMM' + cable_user%STRF_NAME = 'DAMM' + +&end diff --git a/namelists_bios/cable_yv.nml b/namelists_bios/cable_yv.nml new file mode 100755 index 000000000..3ca759f31 --- /dev/null +++ b/namelists_bios/cable_yv.nml @@ -0,0 +1,101 @@ +&cable + filename%met = '' + filename%path = './' + filename%type = 'CABLE-AUX/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc' + filename%veg = 'driver_files/def_veg_params.txt' + filename%soil = 'driver_files/def_soil_params.txt' + filename%log = 'logs/log_cable.txt' + filename%out = 'outputs/bios_out_cable.nc' + filename%restart_in = 'restart/bios_cable_rst.nc' + filename%restart_out = 'restart/bios_cable_rst.nc' + casafile%out = 'outputs/bios_out_casa.nc' ! casa + casafile%cnpipool = 'restart/bios_casa_rst.nc' ! casa restart_in + casafile%cnpepool ='restart/bios_casa_rst.nc' ! casa restart_out + cable_user%POP_restart_in = 'restart/pop_bios_ini.nc' ! POP restart_in + cable_user%POP_restart_out = 'restart/pop_bios_ini.nc' ! POP restart_out + cable_user%climate_restart_in = 'restart/bios_climate_rst.nc' ! climate restart_in + cable_user%climate_restart_out = 'restart/bios_climate_rst.nc' ! climate restart_out + vegparmnew = .TRUE. ! using new format when true + soilparmnew = .TRUE. ! using new format when true + spinup = .FALSE. ! do we spin up the model? + delsoilM = 0.01 ! allowed variation in soil moisture for spin up + delsoilT = 0.1 ! allowed variation in soil temperature for spin up + output%grid = 'land' ! should a restart file be created? + output%restart = .TRUE. ! should a restart file be created? + output%met = .TRUE. ! input met data + output%flux = .TRUE. ! convective, runoff, NEE + output%soil = .TRUE. ! soil states + output%snow = .TRUE. ! snow states + output%radiation = .TRUE. ! net rad, albedo + output%casa = .TRUE. + output%carbon = .TRUE. ! NEE, GPP, NPP, stores + output%veg = .TRUE. ! vegetation states + output%params = .TRUE. ! input parameters used to produce run + output%balances = .TRUE. ! energy and water balances + output%patch = .TRUE. + output%averaging = 'monthly' + check%ranges = .FALSE. ! variable ranges, input and output + check%energy_bal = .TRUE. ! energy balance + check%mass_bal = .TRUE. ! water/mass balance + verbose = .FALSE. ! write details of every grid cell init and params to log? + leaps = .FALSE. ! calculate timing with leap years? + logn = 88 ! log file number - declared in input module + fixedCO2 = 350.0 ! if not found in met file, in ppmv + spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be + !set to FALSE if spincasainput = .TRUE. + l_laiFeedbk = .TRUE. ! using prognostic LAI + l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax + icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, + ! 1 for C, 2 for C+N, 3 for C+N+P + casafile%cnpbiome = 'driver_files/pftlookup.csv' ! biome specific BGC parameters + !casafile%cnpbiome = 'pftlookup_csiro_pest.csv' ! biome specific BGC parameters + casafile%phen = 'CABLE-AUX/core/biogeochem/modis_phenology_csiro.txt' ! modis phenology + casafile%cnpflux = 'cnpfluxOut.csv' + ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met + redistrb = .FALSE. ! Turn on/off the hydraulic redistribution + wiltParam = 0.5 + satuParam = 0.8 + cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: + ! 1. standard + ! 2. non-linear extrapolation + ! 3. Lai and Ktaul 2000 + ! 4. Haverd2013 + cable_user%litter = .true. + cable_user%DIAG_SOIL_RESP = 'ON ' + cable_user%LEAF_RESPIRATION = 'ON ' + cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: + ! 1. BASIC + ! 1. NONE + cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run + cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format + cable_user%CASA_DUMP_WRITE = .TRUE. ! TRUE outputs CASA forcing in netcdf format + !cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 + !cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 + cable_user%LogWorker = .FALSE. + cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method + cable_user%SOIL_STRUC = 'sli' ! 'default','sli' + cable_user%CALL_POP = .T. ! TRUE uses POP population dynamics model, coupled to CASA. + cable_user%POP_out = 'ini' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode + cable_user%POP_fromZero = .FALSE. ! Start POP from Zero, don't read restart file + cable_user%CASA_fromZero = .FALSE. + cable_user%RunIden = 'bios' ! Unique identifier for model Run, will be used in Filenames + cable_user%YearStart = 1860 ! YYYY 4 digit year + cable_user%YearEnd = 1889 ! YYYY 4 digit year + cable_user%MetType = 'bios' ! Either 'gswp' or 'plum' for PLUME + cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq + cable_user%CLIMATE_fromZero = .FALSE. + cable_user%CALL_CLIMATE = .TRUE. + cable_user%PHENOLOGY_SWITCH = 'climate' + cable_user%POPLUC = .TRUE. + cable_user%POPLUC_RunType = 'static' + cable_user%vcmax = 'Walker2014' + cable_user%gs_switch = 'leuning' + cable_user%SRF = .TRUE. + cable_user%SMRF_NAME = 'Trudinger2016' + cable_user%STRF_NAME = 'Q10' + cable_user%limit_labile = .FALSE. + cable_user%within_canopy_isothermal = .TRUE. + cable_user%acclimate_photosyn = .TRUE. + cable_user%acclimate_autoresp_seasonal = .TRUE. + cable_user%amphistomatous = .TRUE. +&end diff --git a/namelists_bios/cru.nml b/namelists_bios/cru.nml new file mode 100755 index 000000000..32e14b24b --- /dev/null +++ b/namelists_bios/cru.nml @@ -0,0 +1,8 @@ +&CRUNML + BasePath = "/OSM/CBR/OA_GLOBALCABLE/work/CRUJRA2019/daily_1deg" + MetPath = "/OSM/CBR/OA_GLOBALCABLE/work/CRUJRA2019/daily_1deg" + LandMaskFile = "/OSM/CBR/OA_GLOBALCABLE/work/Vanessa/MASKS/test_savanna_1x1.nc" + Run = "S0_TRENDY" ! Run types are "spinup" (spinup), "1750_1900" (initialisation), "1901_2014" (run) + DThrs = 3.0 ! **CABLE** timestep hours (not the met timestep) + DirectRead = .FALSE. +&end \ No newline at end of file diff --git a/namelists_bios/diff.txt b/namelists_bios/diff.txt new file mode 100755 index 000000000..47d36385c --- /dev/null +++ b/namelists_bios/diff.txt @@ -0,0 +1,223 @@ +2,104c2,119 +< filename%met = '' +< filename%path = './' +< filename%type = 'CABLE-AUX/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc' +< filename%veg = 'driver_files/def_veg_params.txt' +< filename%soil = 'driver_files/def_soil_params.txt' +< filename%log = 'logs/log_cable.txt' +< filename%out = 'outputs/bios_out_cable.nc' +< filename%restart_in = 'restart/bios_cable_rst.nc' +< filename%restart_out = 'restart/bios_cable_rst.nc' +< casafile%out = 'outputs/bios_out_casa.nc' ! casa +< casafile%cnpipool = 'restart/bios_casa_rst.nc' ! casa restart_in +< casafile%cnpepool = 'restart/bios_casa_rst.nc' ! casa restart_out +< cable_user%POP_restart_in = 'restart/pop_bios_ini.nc' ! POP restart_in +< cable_user%POP_restart_out = 'restart/pop_bios_ini.nc' ! POP restart_out +< cable_user%LUC_restart_in = '' ! LUC restart_in +< cable_user%LUC_restart_out = 'restart/bios_LUC_rst.nc' ! LUC restart_out +< cable_user%LUC_outfile = 'outputs/bios_out_LUC.nc' +< cable_user%climate_restart_in = 'restart/bios_climate_rst.nc' ! climate restart_in +< cable_user%climate_restart_out = 'restart/bios_climate_rst.nc' ! climate restart_out +< vegparmnew = .TRUE. ! using new format when true +< soilparmnew = .TRUE. ! using new format when true +< spinup = .FALSE. ! do we spin up the model? +< delsoilM = 0.01 ! allowed variation in soil moisture for spin up +< delsoilT = 0.1 ! allowed variation in soil temperature for spin up +< output%grid = 'land' ! should a restart file be created? +< output%restart = .TRUE. ! should a restart file be created? +< output%met = .TRUE. ! input met data +< output%flux = .TRUE. ! convective, runoff, NEE +< output%soil = .TRUE. ! soil states +< output%snow = .TRUE. ! snow states +< output%radiation = .TRUE. ! net rad, albedo +< output%casa = .TRUE. +< output%carbon = .TRUE. ! NEE, GPP, NPP, stores +< output%veg = .TRUE. ! vegetation states +< output%params = .TRUE. ! input parameters used to produce run +< output%balances = .TRUE. ! energy and water balances +< output%patch = .TRUE. +< output%averaging = 'monthly' +< check%ranges = .FALSE. ! variable ranges, input and output +< check%energy_bal = .TRUE. ! energy balance +< check%mass_bal = .TRUE. ! water/mass balance +< verbose = .FALSE. ! write details of every grid cell init and params to log? +< leaps = .FALSE. ! calculate timing with leap years? +< logn = 88 ! log file number - declared in input module +< fixedCO2 = 350.0 ! if not found in met file, in ppmv +< spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be +< ! set to FALSE if spincasainput = .TRUE. +< l_laiFeedbk = .TRUE. ! using prognostic LAI +< l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax +< icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, +< ! 1 for C, 2 for C+N, 3 for C+N+P +< casafile%cnpbiome = 'driver_files/pftlookup.csv' ! biome specific BGC parameters +< casafile%phen = 'CABLE-AUX/core/biogeochem/modis_phenology_csiro.txt' ! modis phenology +< casafile%cnpflux = 'cnpfluxOut.csv' +< ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met +< redistrb = .FALSE. ! Turn on/off the hydraulic redistribution +< wiltParam = 0.5 +< satuParam = 0.8 +< cable_user%FWSOIL_SWITCH = 'Haverd2013' ! choices are: +< ! 1. standard +< ! 2. non-linear extrapolation +< ! 3. Lai and Ktaul 2000 +< ! 4. Haverd2013 +< cable_user%litter = .true. +< cable_user%DIAG_SOIL_RESP = 'ON ' +< cable_user%LEAF_RESPIRATION = 'ON ' +< cable_user%RUN_DIAG_LEVEL = 'BASIC' ! choices are: +< ! 1. BASIC +< ! 1. NONE +< cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run +< cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format +< cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format +< cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 +< cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 +< cable_user%LogWorker = .FALSE. +< cable_user%SSNOW_POTEV = 'P-M' ! Humidity Deficit Method +< cable_user%SOIL_STRUC = 'sli' ! 'default','sli' +< cable_user%CALL_POP = .TRUE. ! TRUE uses POP population dynamics model, coupled to CASA. +< cable_user%POP_out = 'ini' ! ! Pop-output file either 'rst':Standard restart OR 'epi' for whole episode +< cable_user%POP_fromZero = .FALSE. ! Start POP from Zero, don't read restart file +< cable_user%CASA_fromZero = .FALSE. +< cable_user%RunIden = 'bios' ! Unique identifier for model Run, will be used in Filenames +< cable_user%YearStart = 1990 ! YYYY 4 digit year +< cable_user%YearEnd = 2017 ! YYYY 4 digit year +< cable_user%MetType = 'bios' ! Either 'gswp' or 'plum' for PLUME +< cable_user%CASA_OUT_FREQ = 'monthly' ! casa standard output freq +< cable_user%CLIMATE_fromZero = .FALSE. +< cable_user%CALL_CLIMATE = .TRUE. +< cable_user%PHENOLOGY_SWITCH = 'climate' +< cable_user%POPLUC = .TRUE. +< cable_user%POPLUC_RunType = 'static' +< cable_user%vcmax = 'Walker2014' +< cable_user%gs_switch = 'leuning' +< cable_user%coordinate_photosyn = .TRUE. +< cable_user%acclimate_photosyn = .TRUE. +< cable_user%acclimate_autoresp_seasonal = .TRUE. +< cable_user%limit_labile = .FALSE. +< cable_user%SRF = .TRUE. +< cable_user%SMRF_NAME = 'Trudinger2016' +< cable_user%STRF_NAME = 'Q10' +< cable_user%within_canopy_isothermal = .TRUE. +< cable_user%amphistomatous = .TRUE. +< cable_user%CALL_BLAZE = .TRUE. +--- +> filename%met = "" +> filename%path = "./" +> filename%type = "/g/data/x45/CABLE-AUX/offline/gridinfo_CSIRO_1x1.nc" +> filename%veg = "/home/599/jk8585/CABLE_run/TRENDY_v10/params_v2/def_veg_params.txt" +> filename%soil = "/home/599/jk8585/CABLE_run/TRENDY_v10/params_v2/def_soil_params.txt" +> filename%log = "logs/log_cable.txt" +> filename%out = "outputs/cru_out_cable.nc" +> filename%restart_in = "restart/cru_cable_rst.nc" +> filename%restart_out = "restart/cru_cable_rst.nc" +> casafile%out = "outputs/cru_out_casa.nc" +> casafile%cnpipool = "restart/cru_casa_rst.nc" +> casafile%cnpepool = "restart/cru_casa_rst.nc" +> cable_user%POP_outfile = "" +> cable_user%POP_restart_in = "restart/pop_cru_ini.nc" +> cable_user%POP_restart_out = "restart/pop_cru_ini.nc" +> cable_user%LUC_restart_in = "restart/cru_LUC_rst.nc" +> cable_user%LUC_restart_out = "restart/cru_LUC_rst.nc" +> cable_user%LUC_outfile = "outputs/cru_out_LUC.nc" +> cable_user%climate_restart_in = "restart/cru_climate_rst.nc" +> cable_user%climate_restart_out = "restart/cru_climate_rst.nc" +> vegparmnew = .TRUE. ! using new format when true +> soilparmnew = .TRUE. ! using new format when true +> spinup = .FALSE. ! do we spin up the model? +> delsoilM = 0.01 ! allowed variation in soil moisture for spin up +> delsoilT = 0.1 ! allowed variation in soil temperature for spin up +> output%grid = "mask" +> output%restart = .TRUE. ! should a restart file be created? +> output%met = .TRUE. ! input met data +> output%flux = .TRUE. ! convective, runoff, NEE +> output%soil = .TRUE. ! soil states +> output%snow = .TRUE. ! snow states +> output%radiation = .TRUE. ! net rad, albedo +> output%casa = .TRUE. +> output%carbon = .TRUE. ! NEE, GPP, NPP, stores +> output%veg = .TRUE. ! vegetation states +> output%params = .TRUE. ! input parameters used to produce run +> output%balances = .TRUE. ! energy and water balances +> output%patch = .TRUE. +> output%averaging = "monthly" +> check%ranges = .FALSE. ! variable ranges, input and output +> check%energy_bal = .TRUE. ! energy balance +> check%mass_bal = .TRUE. ! water/mass balance +> verbose = .FALSE. ! write details of every grid cell init and params to log? +> leaps = .FALSE. +> logn = 88 ! log file number - declared in input module +> fixedCO2 = 350.0 ! if not found in met file, in ppmv +> spincasainput = .FALSE. ! input required to spin casacnp offline +> spincasa = .FALSE. ! spin casa before running the model if TRUE, and should be +> ! set to FALSE if spincasainput = .TRUE. +> l_casacnp = .TRUE. ! using casaCNP with CABLE (! DEPRECATED!!! use icycle instead!)) +> l_laiFeedbk = .TRUE. ! using prognostic LAI +> l_vcmaxFeedbk = .TRUE. ! using prognostic Vcmax +> icycle = 2 ! BP pull it out from casadimension and put here; 0 for not using casaCNP, +> ! 1 for C, 2 for C+N, 3 for C+N+P +> casafile%cnpbiome = "/home/599/jk8585/CABLE_run/TRENDY_v10/params_v2/pftlookup.csv" +> casafile%cnpmetout = "casamet.nc" ! output daily met forcing for spinning casacnp +> casafile%cnpmetin = "" ! list of daily met files for spinning casacnp +> casafile%phen = "/short/x45/surface_data_PLUME/modis_phenology_csiro.txt" ! modis phenology +> casafile%cnpflux = "cnpfluxOut.csv" +> ncciy = 0 ! 0 for not using gswp; 4-digit year input for year of gswp met +> gswpfile%rainf = "/data/nie06a/MET/PLUMBER/Rainf_gswp_1986_plumber.nc" +> gswpfile%snowf = "/data/nie06a/MET/PLUMBER/Snowf_gswp_1986_plumber.nc" +> gswpfile%LWdown = "/data/nie06a/MET/PLUMBER/LWdown_srb_1986_plumber.nc" +> gswpfile%SWdown = "/data/nie06a/MET/PLUMBER/SWdown_srb_1986_plumber.nc" +> gswpfile%PSurf = "/data/nie06a/MET/PLUMBER/PSurf_ecor_1986_plumber.nc" +> gswpfile%Qair = "/data/nie06a/MET/PLUMBER/Qair_cru_1986_plumber.nc" +> gswpfile%Tair = "/data/nie06a/MET/PLUMBER/Tair_cru_1986_plumber.nc" +> gswpfile%wind = "/data/nie06a/MET/PLUMBER/Wind_ncep_1986_plumber.nc" +> redistrb = .FALSE. ! Turn on/off the hydraulic redistribution +> wiltParam = 0.5 +> satuParam = 0.8 +> cable_user%FWSOIL_SWITCH = "Haverd2013" ! choices are: +> ! 1. standard +> ! 2. non-linear extrapolation +> ! 3. Lai and Ktaul 2000 +> ! 4. Haverd2013 +> cable_user%litter = .TRUE. +> cable_user%DIAG_SOIL_RESP = "ON " +> cable_user%LEAF_RESPIRATION = "ON " +> cable_user%RUN_DIAG_LEVEL = "BASIC" ! choices are: +> ! 1. BASIC +> ! 1. NONE +> cable_user%CONSISTENCY_CHECK = .TRUE. ! TRUE outputs combined fluxes at each timestep for comparisson to A control run +> cable_user%CASA_DUMP_READ = .FALSE. ! TRUE reads CASA forcing from netcdf format +> cable_user%CASA_DUMP_WRITE = .FALSE. ! TRUE outputs CASA forcing in netcdf format +> cable_user%CASA_SPIN_STARTYEAR = 1850 ! default = 1950 +> cable_user%CASA_SPIN_ENDYEAR = 1859 ! default = 1960 +> cable_user%CASA_NREP = 0 +> cable_user%LogWorker = .FALSE. +> cable_user%SSNOW_POTEV = "P-M" ! Humidity Deficit Method +> cable_user%SOIL_STRUC = "default" +> cable_user%CALL_POP = .TRUE. +> cable_user%POP_out = "epi" ! Pop-output file either 'rst': Standard restart OR 'epi' for whole episode +> cable_user%POP_fromZero = .TRUE. ! Start POP from Zero, don't read restart file +> cable_user%CASA_fromZero = .TRUE. +> cable_user%RunIden = "cru" +> cable_user%YearStart = 1831 ! YYYY 4 digit year +> cable_user%YearEnd = 1851 ! YYYY 4 digit year +> cable_user%MetType = "cru" +> cable_user%CASA_OUT_FREQ = "monthly" +> cable_user%CLIMATE_fromZero = .TRUE. +> cable_user%CALL_CLIMATE = .TRUE. +> cable_user%PHENOLOGY_SWITCH = "climate" +> cable_user%POPLUC = .FALSE. +> cable_user%POPLUC_RunType = "static" +> cable_user%vcmax = "Walker2014" +> cable_user%gs_switch = "medlyn" +> cable_user%explicit_gm = .FALSE. +> cable_user%Rubisco_parameters = "Bernacchi_2002" +> cable_user%gm_LUT_file = "/home/599/jk8585/CABLE_run/TRENDY_v10/params_v2/gm_LUT_351x3601x7_1pt8245_Bernacchi2002.nc" +> cable_user%coordinate_photosyn = .TRUE. +> cable_user%g0_switch = "maximum" +> cable_user%acclimate_photosyn = .TRUE. +> cable_user%limit_labile = .FALSE. +> cable_user%SRF = .TRUE. +> cable_user%SMRF_NAME = "Trudinger2016" +> cable_user%STRF_NAME = "LT1994" +> cable_user%CALL_BLAZE = .TRUE. diff --git a/namelists_bios/plume.nml b/namelists_bios/plume.nml new file mode 100755 index 000000000..ada15dbdc --- /dev/null +++ b/namelists_bios/plume.nml @@ -0,0 +1,13 @@ +&PLUMENML + BasePath = "/g/data/x45/ipbes/ipsl/1deg" + LandMaskFile = "/OSM/CBR/OA_GLOBALCABLE/work/Vanessa/MASKS/test_savanna_1x1.nc" + Run = "spinup" ! Run types are 'spinup', '1850_1900', '1901_2001', '1901_2005', '2006_2099' + Forcing = "ipsl-cm5a-lr" + RCP = "hist" ! 'hist', '2.6', '4.5', '6.0', '8.5' + CO2 = "static1850" + CO2file = "/g/data/x45/ipbes/co2/co2_1850_2005_hist.dat" + NDEP = "static1850" + NDEPfile = "/g/data/x45/ipbes/ndep/NOy_plus_NHx_dry_plus_wet_deposition_hist_1850_2015_annual_1deg.nc" + DT = 3.0 ! subdiurnal time step in hours + DirectRead = .FALSE. +&end \ No newline at end of file diff --git a/namelists_bios/site.nml b/namelists_bios/site.nml new file mode 100755 index 000000000..5b648a622 --- /dev/null +++ b/namelists_bios/site.nml @@ -0,0 +1,9 @@ +&siteNML + RunType = "spinup" + CO2NDepFile = "./AmaFACE_co2npdepforcing_1850_2100_AMB_JK.csv" + spinstartyear = 1831 + spinendyear = 1851 + spinCO2 = 284.7 + spinNdep = 0.79 ! kg N ha-1 y-1 + spinPdep = 0.144 ! kg P ha-1 y-1 +&end diff --git a/offline/Makefile_mpi b/offline/Makefile_mpi index a830147cd..1f810716b 100644 --- a/offline/Makefile_mpi +++ b/offline/Makefile_mpi @@ -116,7 +116,7 @@ cable_mpimaster.o: cable_mpimaster.F90 cable_mpicommon.o cable_output.o \ cable_mpiworker.o: cable_mpiworker.F90 cable_mpicommon.o cable_output.o \ cable_iovars.o cable_cbm.o casa_variable.o casa_cable.o casa_cnp.o \ casa_inout.o cable_input.o cable_define_types.o cable_common.o pop_mpi.o \ - cable_climate.o blaze.o blaze_mpi.o cable_c13o2_def.o cable_c13o2.o mo_c13o2_photosynthesis.o \ + cable_climate.o blaze.o blaze_mpi.o blaze_driver.o simfire.o cable_c13o2_def.o cable_c13o2.o mo_c13o2_photosynthesis.o \ casa_cable.o pop_io.o cable_mpidrv.o: cable_mpidrv.F90 cable_mpicommon.o cable_mpimaster.o cable_mpiworker.o diff --git a/offline/build.ksh b/offline/build.ksh index 914305850..827abc91f 100755 --- a/offline/build.ksh +++ b/offline/build.ksh @@ -10,9 +10,9 @@ fi known_hosts() { if [ -z ${PS3} ] ; then - kh=(kh gadi pear mcin mc16 vm_o) + kh=(kh gadi pear mcin mc16 vm_o auro) else - set -A kh gadi pear mcin mc16 vm_o + set -A kh gadi pear mcin mc16 vm_o auro fi } @@ -36,25 +36,31 @@ host_gadi() . /etc/kshrc fi module purge - module load intel-compiler/2019.5.281 - module load netcdf/4.6.3 + # module load intel-compiler/2019.5.281 + # module load netcdf/4.6.3 + module load intel-compiler-llvm/2023.0.0 + module load netcdf/4.9.2 export FC=ifort export NCDIR=${NETCDF_ROOT}"/lib/Intel" export NCMOD=${NETCDF_ROOT}"/include/Intel" + # -diag-disable=10382 <- e.g., option '-xHOST' setting '-xCORE-AVX2' + # -diag-disable=15009 <- has been targeted for automatic cpu dispatch if [[ ${1} == "debug" ]]; then # debug # export CFLAGS='-O0 -fpp -traceback -g -fp-model precise -ftz -fpe0' - export CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv" + export CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382,15009 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv" export LDFLAGS="-O0" OPTFLAG="" else # release # export CFLAGS='-O2 -fpp -fp-model precise' - export CFLAGS="-fpp -O3 -nofixed -assume byterecl -fp-model precise -ip -diag-disable=10382" - export LDFLAGS="-O3" - OPTFLAG="-xCASCADELAKE" - # OPTFLAG="${CFLAGS} -xCORE-AVX2 -axSKYLAKE-AVX512,CASCADELAKE" # given in user training: does not work + # -ip or -ipo + export CFLAGS="-fpp -O3 -nofixed -assume byterecl -fp-model precise -ipo -diag-disable=10382,15009" + export LDFLAGS="-O3 -ipo" + # OPTFLAG="-xCASCADELAKE" + OPTFLAG="-march=broadwell -axSKYLAKE-AVX512,CASCADELAKE,SAPPHIRERAPIDS" + # OPTFLAG="${CFLAGS} -xCORE-AVX2 -axSKYLAKE-AVX512,CASCADELAKE" # given in user training: does not work # OPTFLAG="${CFLAGS} -xCASCADELAKE" # or -xCORE-AVX512; queues: express / normal # OPTFLAG="${CFLAGS} -xBROADWELL" # or -xCORE-AVX512; queues: expressbw / normalbw # OPTFLAG="${CFLAGS} -xSKYLAKE" # or -xSKYLAKE-AVX512 depends on performance; queues: normalsl @@ -405,6 +411,43 @@ host_vm_o() build_status } +## Lars Nieradzik @ aurora.lunarc.lu.se +host_auro() +{ + if [ -z ${PS3} ] ; then + . /etc/bashrc + else + . /etc/kshrc + fi + module purge + module load intel/2020a + module load netCDF-Fortran/4.5.2 + + export FC=ifort + export NETCDF_RT="/sw/easybuild/software/netCDF-Fortran/4.5.2-iimpi-2020a" + export NCDIR=${NETCDF_RT}"/lib" + export NCMOD=${NETCDF_RT}"/include" + if [[ ${1} == "debug" ]]; then + # debug + # export CFLAGS='-O0 -fpp -traceback -g -fp-model precise -ftz -fpe0' + #CLNexport CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv" + export CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv"export LDFLAGS="-O0" + OPTFLAG="" + else + # release + export CFLAGS='-O2 -fpp -fp-model precise' + export CFLAGS="-fpp -O3 -nofixed -assume byterecl -fp-model precise -ip -diag-disable=10382" + export LDFLAGS="-O3" + OPTFLAG="" + fi + export CFLAGS="${CFLAGS} ${OPTFLAG}" + export LDFLAGS="-L"${NCDIR}" "${LDFLAGS} + export LD="-lnetcdf -lnetcdff" + export MFLAGS="-j 8" + build_build + cd ../ + build_status +} clean_ask() { diff --git a/offline/build_mpi.ksh b/offline/build_mpi.ksh index 0cd4efd7e..1702da710 100755 --- a/offline/build_mpi.ksh +++ b/offline/build_mpi.ksh @@ -10,9 +10,9 @@ fi known_hosts() { if [ -z ${PS3} ] ; then - kh=(kh gadi pear mcin mc16 vm_o) + kh=(kh gadi petr mcin mc16 vm_o auro) else - set -A kh gadi pear mcin mc16 vm_o + set -A kh gadi petr mcin mc16 vm_o auro fi } @@ -20,9 +20,9 @@ known_hosts() known_domains() { if [ -z ${PS3} ] ; then - kd=(kd nci.org.au pear local local explor) + kd=(kd nci.org.au petr local local explor) else - set -A kd nci.org.au pear local local explor + set -A kd nci.org.au hpc local local explor fi } @@ -36,24 +36,32 @@ host_gadi() . /etc/kshrc fi module purge - module load intel-compiler/2019.5.281 - module load intel-mpi/2019.5.281 - module load netcdf/4.6.3 - - export FC=mpif90 + # module load intel-compiler/2019.5.281 + # module load intel-mpi/2019.5.281 + # module load netcdf/4.6.3 + module load intel-compiler-llvm/2023.0.0 + module load intel-mpi/2021.8.0 + module load netcdf/4.9.2 + + # export FC=mpif90 + export FC=mpiifort export NCMOD=${NETCDF_ROOT}"/include/Intel" + # -diag-disable=10382 <- e.g., option '-xHOST' setting '-xCORE-AVX2' + # -diag-disable=15009 <- has been targeted for automatic cpu dispatch if [[ ${1} == "debug" ]]; then # debug # export CFLAGS='-O0 -fpp -traceback -g -fp-model precise -ftz -fpe0' - export CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv" + export CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382,15009 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv" export LDFLAGS="-O0" OPTFLAG="" else # release # export CFLAGS='-O2 -fpp -fp-model precise' - export CFLAGS="-fpp -O3 -nofixed -assume byterecl -fp-model precise -ip -diag-disable=10382" - export LDFLAGS="-O3" - OPTFLAG="-xCASCADELAKE" + # -ip or -ipo + export CFLAGS="-fpp -O3 -nofixed -assume byterecl -fp-model precise -ipo -diag-disable=10382,15009" + export LDFLAGS="-O3 -ipo" + # OPTFLAG="-xCASCADELAKE" + OPTFLAG="-march=broadwell -axSKYLAKE-AVX512,CASCADELAKE,SAPPHIRERAPIDS" # OPTFLAG="-xCORE-AVX2 -axSKYLAKE-AVX512,CASCADELAKE" # given in user training: does not work # OPTFLAG="-xCASCADELAKE" # or -xCORE-AVX512; queues: express / normal # OPTFLAG="-xBROADWELL" # or -xCORE-AVX512; queues: expressbw / normalbw @@ -72,21 +80,25 @@ host_gadi() } -## pearcey.hpsc.csiro.au -host_pear() +## petrichor.hpsc.csiro.au +host_petr() { # export LD_PRELOAD=/apps/netcdf/4.3.3/lib/libnetcdf.so # export LD_PRELOAD=/apps/openmpi/1.8.4/lib/libopen-rte.so.7:/apps/openmpi/1.8.4/lib/libopen-pal.so.6 - if [ -z ${PS3} ] ; then + #if [ -z ${PS3} ] ; then . /apps/modules/Modules/default/init/ksh - fi + #fi # module add netcdf/4.3.3.1 openmpi/1.7.5 # module add netcdf/4.3.3.1 openmpi/1.8.8 + #module del intel-cc intel-fc + #module add intel-cc/16.0.1.150 intel-fc/16.0.1.150 + #module add netcdf/4.3.3.1 openmpi/1.8.8 + module del intel-cc intel-fc - module add intel-cc/16.0.1.150 intel-fc/16.0.1.150 - module add netcdf/4.3.3.1 openmpi/1.8.8 + module add intel-cc/2020.4.304 intel-fc/2020.4.304 + module add netcdf/4.8.0-intel20 openmpi/4.1.4-ofed54-intel20 export NCDIR=$NETCDF_ROOT'/lib/' export NCMOD=$NETCDF_ROOT'/include/' @@ -265,7 +277,7 @@ host_mc16() if [[ ${iintel} -eq 1 ]] ; then # INTEL /opt/intel/compilers_and_libraries/mac/bin/compilervars.sh intel64 - export FC=/usr/local/openmpi-4.0.5-ifort/bin/mpifort + export FC=/usr/local/openmpi-4.1.1-ifort/bin/mpifort # release export CFLAGS="-fpp -O3 -nofixed -assume byterecl -fp-model precise -ip -diag-disable=10382" export LDFLAGS="-O3" @@ -283,7 +295,7 @@ host_mc16() export PROG=cable-mpi-ifort elif [[ ${ignu} -eq 1 ]] ; then # GFORTRAN - export FC=/usr/local/openmpi-4.0.4-gfortran/bin/mpifort + export FC=/usr/local/openmpi-4.1.1-gfortran/bin/mpifort # release export CFLAGS="-cpp -O3 -Wno-aggressive-loop-optimizations -ffree-form -ffixed-line-length-132 -frecursive" export LDFLAGS="-O3" @@ -302,7 +314,7 @@ host_mc16() export PROG=cable-mpi-gfortran elif [[ ${inag} -eq 1 ]] ; then # NAG - export FC=/usr/local/openmpi-4.0.5-nagfor/bin/mpifort + export FC=/usr/local/openmpi-4.1.1-nagfor/bin/mpifort # release export CFLAGS="-O4" export LDFLAGS="-O4" @@ -395,7 +407,8 @@ host_vm_o() # OPTFLAG="${CFLAGS} -mtune=ivybridge" # ivy / k20 export CFLAGS="${CFLAGS} -D__INTEL__ -D__INTEL_COMPILER__" export LD="" - export NCROOT="/home/oqx29/zzy20/local/netcdf-fortran-4.4.4-ifort2018.0" + export NCCROOT="/home/oqx29/shared/local.save" + export NCROOT="${NCCROOT}/netcdf-fortran-4.4.4-ifort2018.0" else # GFORTRAN # 6.3.0 because of netcdf-fortran module load gcc/6.3.0 @@ -418,17 +431,17 @@ host_vm_o() # OPTFLAG="${CFLAGS} -mavx" # ivy / k20 export CFLAGS="${CFLAGS} -D__GFORTRAN__ -D__gFortran__" export LD="" - export NCROOT="/home/oqx29/zzy20/local/netcdf-fortran-4.4.4-gfortran63" + export NCCROOT="/home/oqx29/shared/local.gnu" + export NCROOT=${NCCROOT} fi # All compilers export CFLAGS="${CFLAGS} ${OPTFLAG}" export CFLAGS="${CFLAGS} -D__MPI__" # export CFLAGS="${CFLAGS} -D__C13DEBUG__" - export CFLAGS="${CFLAGS} -D__CRU2017__" + export CFLAGS="${CFLAGS} -D__CRU2020__" export CFLAGS="${CFLAGS} -D__NETCDF3__" - export NCCROOT="/home/oqx29/zzy20/local" export NCCLIB=${NCCROOT}"/lib" export NCLIB=${NCROOT}"/lib" export NCMOD=${NCROOT}"/include" @@ -440,6 +453,48 @@ host_vm_o() build_status } +## Lars Nieradzik @ aurora.lunarc.lu.se +host_auro() +{ + if [ -z ${PS3} ] ; then + . /etc/bashrc + else + . /etc/kshrc + fi + module purge + module load intel/2020a + module load netCDF-Fortran/4.5.2 + + export FC=mpiifort + export NETCDF_RT="/sw/easybuild/software/netCDF-Fortran/4.5.2-iimpi-2020a" + export NCDIR=${NETCDF_RT}"/lib" + export NCMOD=${NETCDF_RT}"/include" + if [[ ${1} == "debug" ]]; then + # debug + # export CFLAGS='-O0 -fpp -traceback -g -fp-model precise -ftz -fpe0' + #CLNexport CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv" + export CFLAGS="-fpp -O0 -debug extended -traceback -g -check all,noarg_temp_created -warn all -fp-stack-check -nofixed -assume byterecl -fp-model precise -diag-disable=10382 -fpe0" # -fpe-all=0 -no-ftz -ftrapuv"export LDFLAGS="-O0" + OPTFLAG="" + elif [[ $1 == "fastcomp" ]]; then + # fast compilation + export CFLAGS='-O0 -fpp -fp-model precise' + export CFLAGS="-fpp -O0 -nofixed -assume byterecl -fp-model precise -ip -diag-disable=10382" + export LDFLAGS="-O0" + else + # release + export CFLAGS='-O2 -fpp -fp-model precise' + export CFLAGS="-fpp -O3 -nofixed -assume byterecl -fp-model precise -ip -diag-disable=10382" + export LDFLAGS="-O3" + OPTFLAG="" + fi + export CFLAGS="${CFLAGS} ${OPTFLAG}" + export LDFLAGS="-L"${NCDIR}" "${LDFLAGS} + export LD="-lnetcdf -lnetcdff" + export MFLAGS="-j 8" + build_build + cd ../ + build_status +} clean_ask() { diff --git a/offline/cable_LUC_EXPT.F90 b/offline/cable_LUC_EXPT.F90 index 7316558f4..6df56cc70 100644 --- a/offline/cable_LUC_EXPT.F90 +++ b/offline/cable_LUC_EXPT.F90 @@ -219,7 +219,7 @@ SUBROUTINE LUC_EXPT_INIT(LUC_EXPT) yearstr = time_units(Idash-4:Idash-1) read(yearstr,*) LUC_EXPT%FirstYEAR ! write(*,*) 'LUH2 time units: ', TRIM(time_units), Idash, time_units(Idash-4:Idash-1) - write(*,*) 'LUH2 first year', LUC_EXPT%FirstYEAR + !write(*,*) 'LUH2 first year', LUC_EXPT%FirstYEAR xds = LUC_EXPT%xdimsize yds = LUC_EXPT%ydimsize ENDIF @@ -246,6 +246,9 @@ SUBROUTINE LUC_EXPT_INIT(LUC_EXPT) start=(/1,1,LUC_EXPT%CTSTEP/),count=(/xds,yds,1/) ) CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) DO k = 1, mland + !WRITE(*,*) "land kxy ",k, land_x(k), land_y(k) + !CALL FLUSH(6) + !WRITE(*,*) "land tmparr",tmparr( land_x(k), land_y(k) ) LUC_EXPT%grass(k) = tmparr( land_x(k), land_y(k) ) END DO ENDIF @@ -308,6 +311,8 @@ SUBROUTINE LUC_EXPT_INIT(LUC_EXPT) LUC_EXPT%crop = max(min(LUC_EXPT%crop, LUC_EXPT%grass), 0.0) LUC_EXPT%past = max(min(LUC_EXPT%grass-LUC_EXPT%crop, LUC_EXPT%past), 0.0) + write(*,*) "Finished reading in LUC files" + IF (TRIM(cable_user%MetType) .EQ. "bios") THEN ! read bios parameter file to NVIS Major Vegetation Group "biomes" @@ -391,7 +396,7 @@ SUBROUTINE LUC_EXPT_INIT(LUC_EXPT) LUC_EXPT%grass = LUC_EXPT%grass + (LUC_EXPT%primaryf+LUC_EXPT%secdf) * (1.0-CPC) LUC_EXPT%primaryf = LUC_EXPT%primaryf * CPC LUC_EXPT%secdf = LUC_EXPT%secdf * CPC - ! write(*,*) LUC_EXPT%grass(93), LUC_EXPT%primaryf(93), LUC_EXPT%secdf(93) + !write(*,*) LUC_EXPT%grass(93), LUC_EXPT%primaryf(93), LUC_EXPT%secdf(93) ELSE CALL READ_ClimateFile(LUC_EXPT) ! hot desert @@ -502,7 +507,9 @@ SUBROUTINE LUC_EXPT_INIT(LUC_EXPT) LUC_EXPT%primaryf = LUC_EXPT%primaryf * 0.7 END WHERE END WHERE - ENDIF + ENDIF + + write(*,*) "finished LUC_EXPT_INT" END SUBROUTINE LUC_EXPT_INIT diff --git a/offline/cable_bios_met_obs_params.F90 b/offline/cable_bios_met_obs_params.F90 index dc8702a08..146238e7b 100755 --- a/offline/cable_bios_met_obs_params.F90 +++ b/offline/cable_bios_met_obs_params.F90 @@ -554,8 +554,8 @@ MODULE cable_bios_met_obs_params TYPE(dmydate) :: dummydate ! Dummy date for when keeping the date is not required TYPE(dmydate),SAVE :: MetDate ! Date of met to access (equals current date for normals runs, but ! must be calculated for spinup and initialisation runs (for dates before 1900) - INTEGER(i4b),PARAMETER :: recycle_met_startdate = 1981 ! range for met to be recycled for spinup and initialisation - INTEGER(i4b),PARAMETER :: recycle_met_enddate = 2010 + INTEGER(i4b),PARAMETER :: recycle_met_startdate = 1951 ! range for met to be recycled for spinup and initialisation also need to set syear below + INTEGER(i4b),PARAMETER :: recycle_met_enddate = 1980 ! INTEGER(i4b) :: skipdays ! Days of met to skip when user_startdate is after bios_startdate TYPE(dmydate), SAVE :: bios_startdate, bios_enddate ! First and last dates found in bios met files (read from rain file) REAL(sp), PRIVATE, PARAMETER :: SecDay = 86400. @@ -926,7 +926,7 @@ SUBROUTINE cable_bios_init(dels,curyear,met,kend,ktauday) sdoy = 1 smoy = 1 !syear = 1690 - syear = 1981 + syear = 1951 ! AB 6/2024 set to 1951 for 1951-1980 spin period. write(*,*) 'prev:',previous_date%year,previous_date%month,previous_date%day write(*,*) 'run:', user_startdate%year, user_startdate%month, user_startdate%day ! For spinup and initialisation before bios met begins (1900), @@ -936,9 +936,10 @@ SUBROUTINE cable_bios_init(dels,curyear,met,kend,ktauday) MetDate%day = 1 MetDate%month = 1 IF (TRIM(MetForcing) .EQ. 'recycled') THEN - MetDate%Year = recycle_met_startdate + MOD(curyear-syear,recycle_met_enddate-recycle_met_startdate+1) - write(*,*) 'metdatestart,: ', MetDate%Year, recycle_met_startdate, curyear, syear, & - recycle_met_enddate, recycle_met_startdate, MOD(curyear-syear,recycle_met_enddate-recycle_met_startdate+1) + !AB 6/2024 use MODULO not MOD here to avoid negative values + MetDate%Year = recycle_met_startdate + MODULO(curyear-syear,recycle_met_enddate-recycle_met_startdate+1) + write(*,*) 'metdatestart,: ', MetDate%Year, recycle_met_startdate, curyear, syear, & + recycle_met_enddate, recycle_met_startdate, MODULO(curyear-syear,recycle_met_enddate-recycle_met_startdate+1) ELSE IF (TRIM(MetForcing) .EQ. 'actual' ) THEN MetDate%Year = curyear ENDIF @@ -1133,14 +1134,15 @@ SUBROUTINE cable_bios_read_met(MET, CurYear, ktau, dels ) TYPE(MET_TYPE), INTENT(INOUT) :: MET LOGICAL(lgt) :: newday -! real(sp),parameter:: RMW = 0.018016 ! molecular wt of water [kg/mol] -! real(sp),parameter:: RMA = 0.02897 ! atomic wt of C [kg/mol] - real(sp),parameter:: RMWbyRMA = 0.62188471 ! molecular wt of water [kg/mol] / atomic wt of C [kg/mol] +! real(sp),parameter:: RMW = 0.018016 ! molecular wt of water [kg/mol] +! real(sp),parameter:: RMA = 0.02897 ! atomic wt of C [kg/mol] + real(sp),parameter:: RMWbyRMA = 0.62188471 ! molecular wt of water [kg/mol] / atomic wt of C [kg/mol] + real(sp),parameter:: vp_min = 0.1 ! minimum value of vapour pressure [hPa] integer(i4b) :: iday integer(i4b) :: iland ! Loop counter through mland land cells integer(i4b) :: is, ie ! For each land cell, the start and ending index position within the larger cable spatial - ! vectors of the first and last tile for that land cell. - + ! vectors of the first and last tile for that land cell. + met%hod (landpt(:)%cstart) = REAL(MOD( (ktau-1) * NINT(dels), INT(SecDay)) ) / 3600. met%doy (landpt(:)%cstart) = INT(REAL(ktau-1) * dels / SecDay ) + 1 met%year(landpt(:)%cstart) = Curyear @@ -1153,6 +1155,7 @@ SUBROUTINE cable_bios_read_met(MET, CurYear, ktau, dels ) READ (swdown_unit) bios_rundate, swdown_day ! Packed vector of daily AWAP/BIOS swdown (MJ) READ (tairmax_unit) bios_rundate, tairmax_day ! Packed vector of daily AWAP/BIOS max air temp (deg C) READ (tairmin_unit) bios_rundate, tairmin_day ! Packed vector of daily AWAP/BIOS min air temp (deg C) + IF (TRIM(wind_file) .NE. 'none') THEN READ (wind_unit) bios_rundate, wind_day ! ENDIF @@ -1200,7 +1203,7 @@ SUBROUTINE cable_bios_read_met(MET, CurYear, ktau, dels ) READ (swdown_unit) dummydate, swdown_day READ (tairmax_unit) dummydate, tairmax_day READ (tairmin_unit) dummydate, tairmin_day - + IF (TRIM(wind_file) .NE. 'none') THEN READ (wind_unit) dummydate, wind_day ENDIF @@ -1232,6 +1235,7 @@ SUBROUTINE cable_bios_read_met(MET, CurYear, ktau, dels ) ! BACKSPACE(tairmin_unit) !endif + next_tairmin_day = tairmin_day prev_vp1500 = vp1500 next_vp0900 = vp0900 @@ -1247,17 +1251,17 @@ SUBROUTINE cable_bios_read_met(MET, CurYear, ktau, dels ) WG%VapPmbDay = esatf(tairmin_day) + !apply minimum value to vapour pressure to prevent negaive values IF (TRIM(vp0900_file) .NE. 'none') THEN - WG%VapPmb0900 = vp0900 - WG%VapPmb1500 = vp1500 - WG%VapPmb1500Prev = prev_vp1500 - WG%VapPmb0900Next = next_vp0900 - + WG%VapPmb0900 = MAX(vp0900, vp_min) + WG%VapPmb1500 = MAX(vp1500, vp_min) + WG%VapPmb1500Prev = MAX(prev_vp1500, vp_min) + WG%VapPmb0900Next = MAX(next_vp0900, vp_min) ELSE - WG%VapPmb0900 = WG%VapPmbDay - WG%VapPmb1500 = WG%VapPmbDay - WG%VapPmb1500Prev = WG%VapPmbDay - WG%VapPmb0900Next = WG%VapPmbDay + WG%VapPmb0900 = MAX(WG%VapPmbDay, vp_min) + WG%VapPmb1500 = MAX(WG%VapPmbDay, vp_min) + WG%VapPmb1500Prev = MAX(WG%VapPmbDay, vp_min) + WG%VapPmb0900Next = MAX(WG%VapPmbDay, vp_min) ENDIF if (swdown_file(1:4) .eq. 'rsds') then diff --git a/offline/cable_checks.F90 b/offline/cable_checks.F90 index 78cffdd7f..4bb2282c1 100644 --- a/offline/cable_checks.F90 +++ b/offline/cable_checks.F90 @@ -81,7 +81,7 @@ MODULE cable_checks_module ESoil = (/-0.0015,0.0015/), & TVeg = (/-0.0003,0.0003/), & ECanop = (/-0.0003,0.0003/), & - PotEvap = (/-0.0006,0.0006/), & + PotEvap = (/-0.005,0.005/), & !note should encompass Evap ACond = (/0.0,1.0/), & SoilWet = (/-0.4,1.2/), & Albedo = (/0.0,1.0/), & diff --git a/offline/cable_driver.F90 b/offline/cable_driver.F90 index c3acc6ed7..409690e7f 100644 --- a/offline/cable_driver.F90 +++ b/offline/cable_driver.F90 @@ -275,6 +275,8 @@ PROGRAM cable_offline_driver !___ unique unit/file identifiers for cable_diag: arbitrarily 5 here INTEGER :: iDiagZero=0 + INTEGER :: i + ! switches etc defined thru namelist (by default cable.nml) NAMELIST /CABLE/ & filename, & ! TYPE, containing input filenames @@ -740,11 +742,13 @@ PROGRAM cable_offline_driver if ( trim(cable_user%MetType) .eq. 'bios' ) call cable_bios_load_climate_params(climate) IF (cable_user%CALL_BLAZE) THEN +PRINT*,"CLN BLAZE INIT" CALL INI_BLAZE( mland, rad%latitude(landpt(:)%cstart), & rad%longitude(landpt(:)%cstart), BLAZE ) IF ( TRIM(BLAZE%BURNT_AREA_SRC) == "SIMFIRE" ) THEN +PRINT*,"CLN SIMFIRE INIT" CALL INI_SIMFIRE(mland ,SIMFIRE, & climate%modis_igbp(landpt(:)%cstart) ) !CLN here we need to check for the SIMFIRE biome setting ENDIF @@ -792,7 +796,7 @@ PROGRAM cable_offline_driver ! increment total timstep counter ktau_tot = ktau_tot + 1 - + ! globally (WRT code) accessible kend through USE cable_common_module ktau_gl = ktau_tot @@ -1007,11 +1011,12 @@ PROGRAM cable_offline_driver IF (liseod) THEN ! end of day IF ( cable_user%CALL_BLAZE ) THEN + PRINT*,"CLN CAlling BLAZE" CALL BLAZE_ACCOUNTING(BLAZE, climate, ktau, dels, YYYY, idoy) call blaze_driver(blaze%ncells, blaze, simfire, casapool, casaflux, & casamet, climate, rshootfrac, idoy, YYYY, 1, POP, veg) - + call write_blaze_output_nc( BLAZE, ktau.EQ.kend .AND. YYYY.EQ.cable_user%YearEnd) ENDIF ENDIF @@ -1082,8 +1087,10 @@ PROGRAM cable_offline_driver if ( (ktau == kend) .and. (YYYY == cable_user%YearEnd) .and. (RRRR == NRRRR) ) & call c13o2_close_output(c13o2_outfile_id) end if + count_sum_casa = 0 CALL zero_sum_casa(sum_casapool, sum_casaflux) + ! 13C if (cable_user%c13o2) call c13o2_zero_sum_pools(sum_c13o2pools) ENDIF @@ -1203,7 +1210,7 @@ PROGRAM cable_offline_driver WRITE( 12, '(F20.7)' ) new_sumbal ! written by previous trunk version CLOSE(12) ENDIF - ENDIF + ENDIF ENDIF ! consistency_check diff --git a/offline/cable_iovars.F90 b/offline/cable_iovars.F90 index ceda8b124..ed786703f 100644 --- a/offline/cable_iovars.F90 +++ b/offline/cable_iovars.F90 @@ -310,6 +310,7 @@ MODULE cable_IO_vars_module !! vh_js !! additional casa variables NBP = .FALSE., & + NEP = .FALSE., & dCdt = .FALSE., & TotSoilCarb = .FALSE., & TotLivBiomass = .FALSE., & diff --git a/offline/cable_mpicommon.F90 b/offline/cable_mpicommon.F90 index a24959634..a020ffd7d 100644 --- a/offline/cable_mpicommon.F90 +++ b/offline/cable_mpicommon.F90 @@ -136,7 +136,8 @@ MODULE cable_mpicommon ! Paul Ryan: add 3 missing 1D param -> 67 ! Matthias Cuntz: add 2 missing 1D for LUC -> 69 ! Matthias Cuntz: add 1 missing 1D for output -> 70 - INTEGER, PARAMETER :: ncasa_vec = 70 + ! INH #9238: adding one to faciliate potstemnpp -> 71 + INTEGER, PARAMETER :: ncasa_vec = 71 ! MPI: number of fields included in restart_t type for data ! that is returned only for creating a restart file at the end of the run ! INTEGER, PARAMETER :: nrestart = 16 diff --git a/offline/cable_mpimaster.F90 b/offline/cable_mpimaster.F90 index 4cb25c79f..e8fb2b26f 100644 --- a/offline/cable_mpimaster.F90 +++ b/offline/cable_mpimaster.F90 @@ -687,7 +687,7 @@ SUBROUTINE mpidrv_master(comm) endif !par disabled as blaze init moved below - ! ! Abort, if an error occurred during BLAZE/SIMFIRE init + ! ! Abort, if an error occurred during BLAZE/SIMFIRE init !CLN check again ! IF (BLAZE%ERR) CALL MPI_Abort(comm,0,ierr) IF (cable_user%POPLUC .AND. TRIM(cable_user%POPLUC_RunType) .EQ. 'static') & @@ -828,6 +828,8 @@ SUBROUTINE mpidrv_master(comm) call master_send_input(comm, blaze_in_ts, ktau) call INI_SIMFIRE(mland ,SIMFIRE, & climate%modis_igbp(landpt(:)%cstart) ) !CLN here we need to check for the SIMFIRE biome setting + WRITE(logn,*)"After ini_simf" + CALL FLUSH(logn) !par blaze restart not required uses climate data !allocate(simfire_restart_ts(wnp)) @@ -3638,7 +3640,7 @@ SUBROUTINE master_casa_params(comm, casabiome, casapool, casaflux, casamet, casa INTEGER(KIND=MPI_ADDRESS_KIND) :: text, tmplb INTEGER :: tsize, localtotal, remotetotal - INTEGER :: ierr + INTEGER :: ierr INTEGER, ALLOCATABLE, DIMENSION(:) :: casa_t INTEGER(KIND=MPI_ADDRESS_KIND) :: r1stride, r2stride, istride @@ -4848,7 +4850,7 @@ SUBROUTINE master_casa_params(comm, casabiome, casapool, casaflux, casamet, casa ! MPI: sanity check IF (bidx /= ntyp) THEN - WRITE(*,*) 'master: invalid number of casa_t param fields ',bidx,', fix it (02)!' + WRITE(*,*) 'master: invalid number of casa_t param fields ',bidx, ', fix it (02)!' CALL MPI_Abort(comm, 21, ierr) END IF @@ -7382,6 +7384,11 @@ SUBROUTINE master_casa_types(comm, casapool, casaflux, casamet, casabal, phen) CALL MPI_Get_address(casaflux%stemnpp(off), displs(bidx), ierr) blocks(bidx) = r2len + !this is equivalent MPI code to part of #9238 + bidx = bidx + 1 + CALL MPI_Get_address(casaflux%potstemnpp(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address(casaflux%fNminloss(off), displs(bidx), ierr) blocks(bidx) = r2len diff --git a/offline/cable_mpiworker.F90 b/offline/cable_mpiworker.F90 index 66b60c8fb..9114a5582 100644 --- a/offline/cable_mpiworker.F90 +++ b/offline/cable_mpiworker.F90 @@ -520,6 +520,8 @@ SUBROUTINE mpidrv_worker(comm) ! if (cable_user%call_pop) allocate(pop_to(mp), pop_cwd(mp), pop_str(mp)) call ini_blaze( mland, rad%latitude(landpt(:)%cstart), & rad%longitude(landpt(:)%cstart), blaze ) + CALL MPI_Comm_rank(comm, rank, ierr) + BLAZE%IAM = rank !par blaze restart not required uses climate data allocate(latitude(mland)) @@ -530,10 +532,12 @@ SUBROUTINE mpidrv_worker(comm) ! call MPI_recv(MPI_BOTTOM, 1, blaze_restart_t, 0, ktau_gl, comm, stat, ierr) !endif ! cln: burnt_area - if ( blaze%burnt_area_src == "SIMFIRE" ) then + if ( TRIM(blaze%burnt_area_src) == "SIMFIRE" ) then call MPI_recv(MPI_BOTTOM, 1, blaze_in_t, 0, ktau_gl, comm, stat, ierr) !CLN here we need to check for the SIMFIRE biome setting call INI_SIMFIRE(mland, SIMFIRE, climate%modis_igbp(landpt(:)%cstart)) + WRITE(wlogn,*)"After ini_simf" + CALL FLUSH(wlogn) !par blaze restart not required uses climate data !call worker_simfire_types(comm, mland, simfire, simfire_restart_t, simfire_inp_t, simfire_out_t) !if (.not. spinup) then @@ -6682,6 +6686,11 @@ SUBROUTINE worker_casa_type(comm, casapool, casaflux, casamet, casabal, phen) CALL MPI_Get_address(casaflux%stemnpp(off), displs(bidx), ierr) blocks(bidx) = r2len + !this is equivalent MPI code to parts of #9238 + bidx = bidx + 1 + CALL MPI_Get_address(casaflux%potstemnpp(off), displs(bidx), ierr) + blocks(bidx) = r2len + bidx = bidx + 1 CALL MPI_Get_address(casaflux%fNMinloss(off), displs(bidx), ierr) blocks(bidx) = r2len @@ -8854,11 +8863,16 @@ SUBROUTINE worker_spincasacnp(dels, kstart, kend, mloop, & if (mod(ktau/ktauday,loy)==1) then ! (assumes 70% of wood NPP is allocated above ground) casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(LOY,dp) / 1000.0_dp casabal%Crootmean = casapool%cplant(:,3) / real(LOY,dp) / 1000.0_dp else casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + & + casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(LOY,dp) / 1000.0_dp casabal%Crootmean = casabal%Crootmean + casapool%cplant(:,3) / real(LOY,dp) / 1000.0_dp @@ -8869,6 +8883,7 @@ SUBROUTINE worker_spincasacnp(dels, kstart, kend, mloop, & endif ! end of year else casaflux%stemnpp = 0.0_dp + casaflux%potstemnpp = 0.0_dp !#9238 endif ! CALL_POP !CLN CALL BLAZE_DRIVER(...) @@ -9016,11 +9031,15 @@ SUBROUTINE worker_spincasacnp(dels, kstart, kend, mloop, & if (mod(ktau/ktauday,LOY) == 1) then casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp ! (assumes 70% of wood NPP is allocated above ground) + !#9238 + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(LOY,dp) / 1000.0_dp casabal%Crootmean = casapool%cplant(:,3) / real(LOY,dp) / 1000.0_dp else casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + & + casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(LOY,dp) / 1000.0_dp casabal%Crootmean = casabal%Crootmean + casapool%cplant(:,3) / real(LOY,dp) / 1000.0_dp @@ -9037,6 +9056,7 @@ SUBROUTINE worker_spincasacnp(dels, kstart, kend, mloop, & endif ! end of year else casaflux%stemnpp = 0.0_dp + casaflux%potstemnpp = 0.0_dp endif ! CALL_POP write(wlogn,*) 'idoy ', idoy @@ -9113,6 +9133,7 @@ SUBROUTINE worker_CASAONLY_LUC(dels, kstart, kend, veg, soil, casabiome, casapoo ! more variables to store the spinup pool size over the last 10 loops. Added by Yp Wang 30 Nov 2012 real(dp) :: StemNPP(mp,2) + real(dp) :: PotStemNPP(mp) !#9238 integer :: stat(MPI_STATUS_SIZE) integer :: ierr, rank @@ -9155,11 +9176,15 @@ SUBROUTINE worker_CASAONLY_LUC(dels, kstart, kend, veg, soil, casabiome, casapoo IF (idoy==1) THEN ! (assumes 70% of wood NPP is allocated above ground) casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + !#9238 + casaflux%potstemnpp = casaflux%stemnpp + (casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = casamet%glai casabal%Cleafmean = casapool%cplant(:,1) / real(mdyear,dp) / 1000.0_dp casabal%Crootmean = casapool%cplant(:,3) / real(mdyear,dp) / 1000.0_dp ELSE casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + casaflux%potstemnpp = casaflux%potstemnpp + (casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7_dp + & + casaflux%fracClabile * casaflux%cgpp) casabal%LAImax = max(casamet%glai, casabal%LAImax) casabal%Cleafmean = casabal%Cleafmean + casapool%cplant(:,1) / real(mdyear,dp) / 1000.0_dp casabal%Crootmean = casabal%Crootmean +casapool%cplant(:,3) / real(mdyear,dp) / 1000.0_dp @@ -9180,6 +9205,7 @@ SUBROUTINE worker_CASAONLY_LUC(dels, kstart, kend, veg, soil, casabiome, casapoo flush(wlogn) StemNPP(:,1) = casaflux%stemnpp StemNPP(:,2) = 0.0_dp + PotStemNPP(:) = casaflux%potstemnpp !#9238 CALL MPI_Comm_rank(icomm, rank, ierr) write(wlogn,*) diff --git a/offline/cable_output.F90 b/offline/cable_output.F90 index b1510b7ab..3f879ac04 100644 --- a/offline/cable_output.F90 +++ b/offline/cable_output.F90 @@ -59,7 +59,7 @@ MODULE cable_output_module Qle, Qh, Qg, NEE, fbeam, SWnet, & LWnet, SoilMoist, SoilTemp, Albedo, & visAlbedo, nirAlbedo, SoilMoistIce, & - Qs, Qsb, Evap, BaresoilT, SWE, SnowT, & + Qs, Qsb, Evap, PotEvap, BaresoilT, SWE, SnowT, & RadT, VegT, Ebal, Wbal, AutoResp, RootResp, & StemResp,LeafResp, HeteroResp, GPP, NPP, LAI, & ECanop, TVeg, ESoil, CanopInt, SnowDepth, & @@ -70,7 +70,7 @@ MODULE cable_output_module snm, snmsl, tran, albs, albsn, cw, lqsn, lwsnl, mrfsofr, & mrlqso, mrlsl, snc, snd, snw, snwc, tcs, tgs, ts, tsl, & tsn, tsns, & - NBP, TotSoilCarb, TotLivBiomass, & + NBP, NEP, TotSoilCarb, TotLivBiomass, & TotLittCarb, SoilCarbFast, SoilCarbSlow, SoilCarbPassive, & LittCarbMetabolic, LittCarbStructural, LittCarbCWD, & PlantCarbLeaf, PlantCarbFineRoot, PlantCarbWood, & @@ -200,6 +200,7 @@ MODULE cable_output_module ! [umol/m2/s] REAL(KIND=4), POINTER, DIMENSION(:) :: NBP => null() + REAL(KIND=4), POINTER, DIMENSION(:) :: NEP => null() REAL(KIND=4), POINTER, DIMENSION(:) :: dCdt => null() ! [kg C /m2] REAL(KIND=4), POINTER, DIMENSION(:) :: TotSoilCarb => null() @@ -572,6 +573,13 @@ SUBROUTINE open_output_file(dels, soil, veg, bgc, rough) ALLOCATE(out%Evap(mp)) out%Evap = zero4 ! initialise END IF + IF(output%flux .OR. output%PotEvap) THEN + CALL define_ovar(ncid_out, ovid%PotEvap,'PotEvap', 'kg/m^2/s', & + 'Potential evaporation', patchout%PotEvap, 'dummy', & + xID, yID, zID, landID, patchID, tID) + ALLOCATE(out%PotEvap(mp)) + out%PotEvap = zero4 ! initialise + END IF IF(output%flux .OR. output%ECanop) THEN CALL define_ovar(ncid_out, ovid%Ecanop, 'ECanop', 'kg/m^2/s', & 'Wet canopy evaporation', patchout%ECanop, 'dummy', & @@ -1221,13 +1229,22 @@ SUBROUTINE open_output_file(dels, soil, veg, bgc, rough) IF(output%carbon .OR. output%NBP) THEN CALL define_ovar(ncid_out, ovid%NBP, 'NBP', 'umol/m^2/s', & - 'Net Biosphere Production (uptake +ve)' & + 'Net Biosphere Production (uptake +ve, includes fire, harvest and clearing fluxes)' & , patchout%NBP, & 'dummy', xID, yID, zID, landID, patchID, tID) ALLOCATE(out%NBP(mp)) out%NBP = zero4 ! initialise ENDIF + IF(output%carbon .OR. output%NEP) THEN + CALL define_ovar(ncid_out, ovid%NEP, 'NEP', 'umol/m^2/s', & + 'Net Ecosystem Production (uptake +ve)' & + , patchout%NEP, & + 'dummy', xID, yID, zID, landID, patchID, tID) + ALLOCATE(out%NEP(mp)) + out%NEP = zero4 ! initialise + ENDIF + IF (output%casa) THEN CALL define_ovar(ncid_out, ovid%dCdt, 'dCdt', 'umol/m^2/s', & @@ -1237,7 +1254,7 @@ SUBROUTINE open_output_file(dels, soil, veg, bgc, rough) out%dCdt = zero4 ! initialise CALL define_ovar(ncid_out, ovid%TotSoilCarb, 'TotSoilCarb', 'kg C/m^2', & - 'Total Soil and Litter Carbon', patchout%TotSoilCarb, & + 'Total Soil Carbon', patchout%TotSoilCarb, & 'dummy', xID, yID, zID, landID, patchID, tID) ALLOCATE(out%TotSoilCarb(mp)) out%TotSoilCarb = zero4 ! initialise @@ -1923,8 +1940,9 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss IF (leaps) THEN ! If currently a leap year: if (is_leapyear(CurYear)) then - !! vh_js !! - IF(ANY(INT(real(lastdayl+dday) * 24. * 3600. / dels) == ktau)) THEN + !! vh_js !! git issue #204 + !IF(ANY(INT(real(lastdayl+dday) * 24. * 3600. / dels) == ktau)) THEN + IF(ANY(NINT(real(lastdayl+dday) * 24. * 3600. / dels) == ktau)) THEN out_month = MOD(out_month, 12) + 1 ! can only be 1 - 12 ! write to output file this time step writenow = .TRUE. @@ -1937,8 +1955,8 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss END IF ELSE ! not currently a leap year ! last time step of month - !! vh_js !! - IF(ANY(INT(real(lastday+dday) * 24. * 3600. / dels) == ktau)) THEN + !! vh_js !! git issue #204 + IF(ANY(NINT(real(lastday+dday) * 24. * 3600. / dels) == ktau)) THEN ! increment output month counter out_month = MOD(out_month, 12) + 1 ! can only be 1 - 12 ! write to output file this time step @@ -1954,8 +1972,8 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss END IF ELSE ! not using leap year timing in this run - !! vh_js !! - IF(ANY(INT((real((lastday+dday))*24.*3600./real(INT(dels))))==ktau)) THEN ! last time step of month + !! vh_js !! !!changed see above and git issue #204 + IF(ANY(NINT(real(lastday+dday)*24.*3600./dels) == ktau)) THEN ! last time step of month ! IF(ANY(((lastday+dday)*24*3600/INT(dels))==ktau)) THEN ! last time step of month ! increment output month counter out_month = MOD(out_month, 12) + 1 ! can only be 1 - 12 @@ -2215,6 +2233,20 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss out%Evap = zero4 END IF END IF + ! PotEvap: Potential evaporation [kg/m^2/s] + IF(output%flux .OR. output%Evap) THEN + ! Add current timestep's value to total of temporary output variable: + out%PotEvap = out%PotEvap + toreal4(canopy%epot / dels) + IF(writenow) THEN + ! Divide accumulated variable by number of accumulated time steps: + out%PotEvap = out%PotEvap * rinterval + ! Write value to file: + CALL write_ovar(out_timestep, ncid_out, ovid%PotEvap, 'PotEvap', out%PotEvap, & + ranges%PotEvap, patchout%PotEvap, 'default', met) + ! Reset temporary output variable: + out%PotEvap = zero4 + END IF + END IF ! ECanop: interception evaporation [kg/m^2/s] IF(output%flux .OR. output%ECanop) THEN ! Add current timestep's value to total of temporary output variable: @@ -3245,19 +3277,28 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss END IF END IF - ! NBP and turnover fluxes [umol/m^2/s] + ! NBP and turnover fluxes [umol/m^2/s] - + ! 2023-10-10 use new output variable NEP if wish to access NBP + ! without the disturbance fluxes IF (output%carbon .OR. output%NBP) THEN + !INH BLAZE - NBP to include fire (and harvest) ! Add current timestep's value to total of temporary output variable: + ! Add in the smeared value of the harvest and clearing fluxes IF (cable_user%POPLUC) THEN out%NBP = out%NBP + (-toreal4((casaflux%Crsoil-casaflux%cnpp & - - casapool%dClabiledt) * gd2umols)) !- & - !REAL((casaflux%FluxCtohwp + casaflux%FluxCtoclear )/86400.0_r_2 & - !/ 1.201E-5_r_2, 4) + - casapool%dClabiledt + & + REAL(casaflux%FluxCtohwp + casaflux%FluxCtoclear)) & + * gd2umols)) ELSE out%NBP = out%NBP + (-toreal4((casaflux%Crsoil-casaflux%cnpp & - casapool%dClabiledt) * gd2umols)) ENDIF + IF (cable_user%call_blaze) THEN + out%NBP = out%NBP - toreal4((casaflux%fluxCtoCO2_plant_fire & + + casaflux%fluxCtoCO2_litter_fire) * gd2umols) + ENDIF + IF (writenow) THEN ! Divide accumulated variable by number of accumulated time steps: out%NBP = out%NBP * rinterval @@ -3268,6 +3309,24 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss out%NBP = zero4 END IF ENDIF + + IF (output%carbon .OR. output%NEP) THEN + ! Add current timestep's value to total of temporary output variable: + ! INH BLAZE - NEP doesn't include fire or harvest fluxes + out%NEP = out%NEP + (-toreal4((casaflux%Crsoil-casaflux%cnpp & + - casapool%dClabiledt) * gd2umols)) + + IF (writenow) THEN + ! Divide accumulated variable by number of accumulated time steps: + out%NEP = out%NEP * rinterval + ! Write value to file: + CALL write_ovar(out_timestep, ncid_out, ovid%NEP, 'NEP', out%NEP, & + ranges%NEE, patchout%NEP, 'default', met) + ! Reset temporary output variable: + out%NEP = zero4 + END IF + ENDIF + IF (output%casa) THEN ! Add current timestep's value to total of temporary output variable: out%dCdt = out%dCdt + toreal4((casapool%ctot-casapool%ctot_0) * gd2umols) @@ -3397,7 +3456,9 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss ! plant carbon [kg C m-2] IF (output%casa) THEN - out%TotSoilCarb = out%TotSoilCarb + toreal4((SUM(casapool%csoil,2)+SUM(casapool%clitter,2)) / 1000.0_r_2) + !out%TotSoilCarb = out%TotSoilCarb + toreal4((SUM(casapool%csoil,2)+SUM(casapool%clitter,2)) / 1000.0_r_2) + !litter not counted in TotalSoilCarbon JK 18/9/2023 + out%TotSoilCarb = out%TotSoilCarb + toreal4(SUM(casapool%csoil,2) / 1000.0_r_2) IF (writenow) THEN ! Divide accumulated variable by number of accumulated time steps: out%TotSoilCarb = out%TotSoilCarb * rinterval diff --git a/params_bios/def_soil_params.txt b/params_bios/def_soil_params.txt new file mode 100755 index 000000000..82d2e6692 --- /dev/null +++ b/params_bios/def_soil_params.txt @@ -0,0 +1,33 @@ +c Soil parameters (Zobler ?) +c +9 ! no of soil types +c +c isoil +c 1 Coarse sand/Loamy sand +c 2 Medium clay loam/silty clay loam/silt loam +c 3 Fine clay +c 4 Coarse-medium sandy loam/loam +c 5 Coarse-fine sandy clay +c 6 Medium-fine silty clay +c 7 Coarse-medium-fine sandy clay loam +c 8 Organic peat +c 9 Permanent ice +c Details of parameter values for each soil type from Eva's file soil.txt +c1 2 3 4 5 6 7 8 9 +0.08 0.33 0.17 0.20 0.06 0.25 0.15 0.70 0.33 ! Silt fraction +0.09 0.30 0.67 0.20 0.42 0.48 0.27 0.17 0.30 ! Clay fraction +0.83 0.37 0.16 0.60 0.52 0.27 0.58 0.13 0.37 ! Sand fraction +0.072 0.216 0.286 0.135 0.219 0.283 0.175 0.395 0.216 ! swilt +0.143 0.301 0.367 0.218 0.310 0.370 0.255 0.450 0.301 ! sfc +0.398 0.479 0.482 0.443 0.426 0.482 0.420 0.451 0.479 ! ssat +4.20 7.10 11.4 5.15 10.4 10.4 7.12 5.83 7.10 ! bch +166.e-6 4.e-6 1.e-6 21.e-6 2.e-6 1.e-6 6.e-6 800.e-6 1.e-6 ! hyds +-.106 -.591 -.405 -.348 -.153 -.49 -.299 -.356 -.153 ! sucs +1600. 1600. 1381. 1373. 1476. 1521. 1373. 1537. 910. ! new rhosoil values +850. 850. 850. 850. 850. 850. 850. 1920. 2100. ! css + +1600. 1595. 1381. 1373. 1476. 1521. 1373. 1537. 1455. 1000. ! rhosoil (changed, YP nov 2007) +1600. 1600. 1600. 1600. 1600. 1600. 1600. 1300. 910. 1600. ! old rhosoil values +1600. 1595. 1381. 1373. 1476. 1521. 1373. 1537. 1455. 1595. ! new rhosoil values + + diff --git a/params_bios/def_veg_params.txt b/params_bios/def_veg_params.txt new file mode 100755 index 000000000..be6b140c3 --- /dev/null +++ b/params_bios/def_veg_params.txt @@ -0,0 +1,240 @@ +CSIRO veg type parameters (2nd guess calibration) +17 ! number of vegetation types +1 forest evergreen_needleleaf ! veg number, type and name +17.0 0.01 0.001 0.055 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.09 0.30 0.010 0.160 0.390 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.09 0.30 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 8.6 1.0 0.10 2.0 9.0 0.5 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 40.0e-6 3.0000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 2.0 0.943 1.8 20.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 200 10217 876 184 367 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.28 0.85 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 2.346064 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.1 ! gamma, gmmax25 +2 forest evergreen_broadleaf +35.0 -0.40 0.0050 0.025 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.09 0.29 0.010 0.160 0.390 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.09 0.29 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir +20.0 1.0 0.10 0.5 14.0 4.0000000E-01 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 55.0e-6 0.600 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 2.0 0.962 4.0 3.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 300 16833 1443 303 606 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) + 9.0 20268.0 0.25 0.85 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.02 3.0000000E+00 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 + 6.6488719E-03 0.12 ! gamma, gmmax25 +3 deciduous deciduous_needleleaf +15.5 0.01 0.001 0.040 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.075 0.30 0.010 0.160 0.390 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.075 0.30 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 4.6 1.0 0.10 2.0 9.00 0.5 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 40.0e-6 3.0000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + 5 10 2.0 0.966 2.0 10.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 200 5967 511 107 214 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.17 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.28 0.85 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 2.346064 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.1 ! gamma, gmmax25 +4 deciduous deciduous_broadleaf +20.0 0.25 0.080 0.150 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.09 0.29 0.010 0.160 0.390 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.09 0.29 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 8.6 1.0 0.10 2.0 8.0 0.5 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 60.0e-6 2.2000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + 5 15 2.0 0.961 2.0 13.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 300 12000 1029 216 432 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.28 0.85 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 4.447321 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma, gmmax25 +5 shrub shrub + 0.6 0.01 0.005 0.100 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.09 0.30 0.010 0.200 0.430 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.09 0.30 0.010 0.005 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.400 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 4.4 0.0 0.10 2.0 5.00 0.5 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 40.0e-6 1.0000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.964 2.5 2.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 159 5000 500 100 250 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.28 0.85 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 4.22 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.15 ! gamma, gmmax25 +6 grass C3 grassland + 0.567 -0.30 0.010 0.300 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.11 0.340 0.010 0.360 0.580 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.11 0.340 0.010 0.220 0.380 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.250 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 6.0 0.0 0.10 2.0 7.0 0.5 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 60.0e-6 1.5000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.943 0.5 2.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 250 0 500 275 314 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 20268.0 0.28 0.85 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.01 4.5 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.25 ! gamma, gmmax25 +7 grass C4 grassland + 0.567 -0.30 0.01 0.3 1.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.11 0.34 0.010 0.360 0.580 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.11 0.34 0.010 0.220 0.380 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.250 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 6.0 0.0 0.10 1.0 7.00 0.5 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 10.0e-6 2.8000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.943 1.0 0.3 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 250 0 500 275 314 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 20268.0 0.04 0.8 0.025 ! a1, d0, alpha, convex, cfrd +0.04 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.020000 1.616178 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.8 ! gamma, gmmax25 +8 grass Tundra + 0.567 -0.30 0.010 0.300 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.075 0.32 0.010 0.360 0.580 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.075 0.32 0.010 0.220 0.380 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.250 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 6.0 0.0 0.10 2.0 5.00 0.5 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 40.0e-6 2.5000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.943 0.5 0.3 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 250 0 500 275 314 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.28 0.85 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 2.222156 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.15 ! gamma, gmmax25 +9 crop C3 cropland + 0.55 -0.30 0.010 0.300 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.11 0.34 0.010 0.327 0.548 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.11 0.34 0.010 0.184 0.317 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 6.0 0.0 0.10 2.0 7.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 80.0e-6 1.5000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 2.0 0.961 0.5 0.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 150 0 607 149 300 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.07 0.8 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 5.789377 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.3 ! gamma, gmmax25 +10 crop C4 cropland + 0.55 -0.30 0.010 0.300 1.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.11 0.34 0.010 0.327 0.548 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.11 0.34 0.010 0.184 0.317 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 6.0 0.0 0.10 2.0 1.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 8.00e-5 1.0000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 2.0 0.961 0.5 0.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 150 0 607 149 300 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +4.0 1500.0 0.05 0.80 0.025 ! a1, d0, alpha, convex, cfrd +0.04 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 1.616178 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 1.0 ! gamma, gmmax25 +11 wetgrass wetland + 0.567 -0.30 0.010 0.300 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.108 0.343 0.010 0.360 0.580 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.075 0.146 0.010 0.220 0.380 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 6.0 0.0 0.10 2.0 7.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn +60.00e-6 1.5000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.943 1.8 2.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 250 0 500 275 314 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.15 0.01 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 5.248500 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma +12 grass empty + 0.2 0.100 0.003 0.030 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.055 0.190 0.010 0.081 0.196 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.023 0.198 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.300 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 1.0 0.0 0.10 2.0 1.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 1.70e-5 1.0000 0.0832 0.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.975 3.1 2.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 1 0 1 1 1 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.15 0.01 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 5.248500 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma, gmmax25 +13 notused empty + 6.017 0.00 0.015 0.242 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.091 0.310 0.010 0.283 0.504 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.059 0.163 0.010 0.138 0.237 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.090 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 1.0 0.0 0.10 2.0 1.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 1.00e-6 1.0000 0.0832 1.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 2.0 0.961 3.0 0.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 0.1 0 0.1 0.1 0.1 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.15 0.01 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 0.000000 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma, gmmax25 +14 noveg barren + 0.2 0.00 0.001 0.030 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.238 0.457 0.010 0.081 0.196 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.039 0.189 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.151 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 0.0 0.0 0.10 2.0 1.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 1.70e-5 1.0000 0.0832 0.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.961 1.0 0.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot + 0 0 0 1 1 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.15 0.01 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 5.248500 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma, gmmax25 +15 noveg urban + 0.2 0.00 0.001 0.030 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.143 0.275 0.010 0.081 0.196 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.023 0.113 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 0.0 0.0 0.10 2.0 1.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 1.70e-5 1.0000 0.0832 0.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.961 1.0 0.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 1 0 1 1 1 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.20 0.01 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 5.248500 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma +16 noveg lakes + 0.2 0.00 0.001 0.030 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.143 0.275 0.010 0.081 0.196 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.023 0.113 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 0.0 0.0 0.10 2.0 1.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 1.70e-5 1.0000 0.0832 0.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.961 1.0 0.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 1 0 1 1 1 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.20 0.01 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 5.248500 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma +17 noveg ice + 0.2 0.00 0.001 0.030 0.0 ! canopy hgt(m),leaf angle,lf width(m),lf length(m),C4 fraction +0.159 0.305 0.010 0.081 0.196 0.010 ! rholeaf-vis,nir,therm, rhowood-vis,nir,therm +0.026 0.113 0.010 0.001 0.001 0.010 ! tauleaf-vis,nir,therm, tauwood-vis,nir,therm +0.100 0.225 0.020 1.00 ! rhosoil-vis,nir,therm; xalbnir + 0.0 0.0 0.10 2.0 1.00 0.001 ! LAImax(m2/m2),WoodAI(m2/m2),canst1,shelrb,vegcf,extkn + 1.70e-5 1.0000 0.0832 0.0 ! vcmax(mol/m2/s), rp20, rpcoeff(/oC), rs20 + -15 -10 4.0 0.961 1.0 0.0 ! tvjmin(oC), tvjmax(oC), vbeta, betaroot, rootdepth, clitt(tC/ha) + 0 0 0 1 1 ! pool: leaf, wood, root, soilfast, soilslow (gC/m2) +1.0 0.03 0.14 2.0 0.5 ! rate: leaf, wood, root, soilfast, soilslow (/year) +9.0 1500.0 0.20 0.01 0.015 ! a1, d0, alpha, convex, cfrd +0.01 404.9e-6 278.4e-3 59430.0 36000.0 ! gswmin,conkc0,conko0,ekc,eko +0.000000 5.248500 ! g0c3 OR g0c4, g1c3 OR g1c4 depending on frac4 +0.01 0.2 ! gamma diff --git a/params_bios/pftlookup.csv b/params_bios/pftlookup.csv new file mode 100755 index 000000000..e6aef4496 --- /dev/null +++ b/params_bios/pftlookup.csv @@ -0,0 +1,262 @@ +CSIRO vegetation type,,,,,,,,,,,,,,,,,,,,,,,,,,, +CSIRO,"(ice,water,urban:0)/grass:1/shrub:2/woody:3",,,,,,,,,,,,,,,,,,,,,,,,,, +CSIRO type,,,,,,,,,,,,,,,,,,,,,,,,,,, +1,3,Evergreen Needleleaf Forest,,,,,,,,,,,,,,,,,,,,,,,,, +2,3,Evergreen Broadleaf Forest,,,,,,,,,,,,,,,,,,,,,,,,, +3,3,Deciduous Needleleaf Forest,,,,,,,,,,,,,,,,,,,,,,,,, +4,3,Deciduous Broadleaf Forest,,,,,,,,,,,,,,,,,,,,,,,,, +5,2,shrub,,,,,,,,,,,,,,,,,,,,,,,,, +6,1,C3 grass,,,,,,,,,,,,,,,,,,,,,,,,, +7,1,C4 grass,,,,,,,,,,,,,,,,,,,,,,,,, +8,1,tundra,,,,,,,,,,,,,,,,,,,,,,,,, +9,1,C3 crop,,,,,,,,,,,,,,,,,,,,,,,,, +10,1,C4 crop,,,,,,,,,,,,,,,,,,,,,,,,, +11,0,wetland,,,,,,,,,,,,,,,,,,,,,,,,, +12,0,not used,,,,,,,,,,,,,,,,,,,,,,,,, +13,0,not used,,,,,,,,,,,,,,,,,,,,,,,,, +14,1,barren,,,,,,,,,,,,,,,,,,,,,,,,, +15,0,urban,,,,,,,,,,,,,,,,,,,,,,,,, +16,0,lakes,,,,,,,,,,,,,,,,,,,,,,,,, +17,0,ice,,,,,,,,,,,,,,,,,,,,,,,,, +nv1,Kroot,rootdepth,kuptake,Krootlen,KminN,Kuplabp,Fracherb,leaf,age,wood,age,froot,age,met,age,str,age,cwd,age,mic,age,slow,age,pass,age,klabile,SLA +,1/m,m,m/g,C,gN/m2,gP/m2,year,year,year,year,year,year,year,year,year,year,,,,,,,,,,, +1,5.5,1.5,2,14.87805,2,0.5,0.068,4,20,0.7,0.0565,1.14,5.71,0.7345,84.75,1414,0.2,0.009,,,,,,,,, +2,3.9,1.5,1.9,14.38597,2,0.5,0.406,1.0,10,0.7, 0.0565,2.32,5.5, 0.0565,276,887,0.2,0.012,,,,,,,,, +3,5.5,1.5,2,14.02597,2,0.5,0.068,0.52343,20,0.7,0.0565,1.14,5.71,0.7345,84.75,1414,0.2,0.0231,,,,,,,,, +4,3.9,1.5,2,18.94737,2,0.5,0.134,2,10,0.7,0.0565,1.14,5.71,0.7345,84.75,1414,0.2,0.02646,,,,,,,,, +5,2,0.5,1.8,32.30769,2,0.5,0.022,1.44,4,0.7,0.0565,1.14,28.3,0.7910,84.75,1414,0.2,0.00992,,,,,,,,, +6,5.5,0.5,2,84,2,0.5,0.109,0.5,1,0.28918,0.0565,2.3,12.7,0.0565,276,887,0.2,0.01,,,,,,,,, +7,5.5,0.5,2,84,2,0.5,0.109,0.5,1,0.21404,0.0565,2.3,12.7,0.0565,276,887,0.2,0.03,,,,,,,,, +8,5.5,0.5,2,84,2,0.5,0.109,1,1,0.5403,0.226,3.40,28.3,0.685,28.25,1414,0.2,0.0267,,,,,,,,, +9,5.5,0.5,1.6,120.5,2,0.5,0.14,1,1,0.28935,0.226,3.40,28.3,0.685,141.25,1414,0.2,0.02959,,,,,,,,, +10,5.5,0.5,1.6,120.5,2,0.5,0.14,1,1,0.37,0.226,3.40,28.3,0.685,141.25,565,0.2,0.02242,,,,,,,,, +11,5.5,0.5,1.6,0,2,0.5,0,1,1,1,0.226,3.40,28.3,0.685,28.25,565,0.2,0.02,,,,,,,,, +12,5.5,0.5,1.8,0,2,0.5,0,1,1,1,0.226,3.40,28.3,0.685,28.25,565,0.2,0.02,,,,,,,,, +13,5.5,0.5,1.8,0,2,0.5,0,1,1,1,0.226,3.40,28.3,0.685,28.25,565,0.2,0.02,,,,,,,,, +14,2,0.5,1.8,30.76923,2,0.5,0.01,0.43293,5,2,0.226,3.40,28.3,0.685,28.25,5.65,0.2,0.02447,,,,,,,,, +15,2,0.5,1.8,0,2,0.5,0,1,1,1,0.226,3.40,28.3,0.685,28,5.65,0.2,0.02,,,,,,,,, +16,5.5,1.5,1.8,0,2,0.5,0,1,1,1,0.226,3.40,28.3,0.685,28.25,5.65,0.2,0.02,,,,,,,,, +17,5.5,0.5,1.8,0,2,0.5,0,1,1,1,0.226,3.40,28.3,0.685,28.25,5.65,0.2,0.02,,,,,,,,, +NV2,Calloc_leaf,Calloc_wood,Calloc_froot,rmleaf,rmwood,rmfroot,,,,,,,,,,,,,,,,,,,,, +fraction,fraction,fraction,1/year,1/year,1/year,1/year,,,,,,,,,,,,,,,,,,,,, +1,0.20937,0.39063,0.4,0.1,40,40,,,,,,,,,,,,,,,,,,,,, +2,0.3,0.3,0.4,0.1,10,10,,,,,,,,,,,,,,,,,,,,, +3,0.20937,0.59063,0.2,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +4,0.24149,0.55851,0.3,0.1,15,15,,,,,,,,,,,,,,,,,,,,, +5,0.37169,0.26927,0.35904,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +6,0.5,0,0.5,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +7,0.5,0,0.5,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +8,0.35,0.07168,0.65,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +9,0.35,0,0.65,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +10,0.35,0,0.65,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +11,0.5,0,0.5,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +12,0.5,0,0.5,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +13,0.5,0,0.5,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +14,0.2,0.1848,0.44352,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +15,0.5,0,0.5,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +16,0.6,0.4,0,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +17,0.5,0,0.5,0.1,20,20,,,,,,,,,,,,,,,,,,,,, +nv3,C:N leaf ,C:N wood,C:N froot,Ntrans_leaf,Ntrans_wood,Ntrans_frt,lignin leaf,lignin CWD,lignin froot,C:N mic,C:N slow,C:N pass,C:Nmicmin,C:Nslowmin,C:Npassmin,C:Nmaxmic,C:Nslowmax,C:Npassmax,Laimax,Laimin,,,,,,, +gc/gn,gc/gn,g C/gN,gC/gN,fraction,fraction,fraction,g lignin/gC,g lignin/gC,g lignin/gC,gC/gN,gC/gN,gC/gN,gC/gN,gC/gN,gC/gN,gC/gN,gC/gN,gC/gN,m2/m2,m2/m2,,,,,,, +1,54.92146975,238.10001,73.7,0.5,0.95,0.9,0.1,0.4,0.1,5.4,26.91,26.91,5.4,26.91,26.91,8,30,30,10,0,,,,,,, +2,40,134.89999,61.2,0.5,0.95,0.9,0.1,0.4,0.1,7.71,13.54,13.54,7.71,13.54,13.54,8,30,30,10,0.5,,,,,,, +3,27.74159076,243.8,75,0.5,0.95,0.9,0.1,0.4,0.1,7.11,26.91,26.91,7.11,26.91,26.91,8,30,30,10,0.5,,,,,,, +4,47.88484729,312.400032,126.4000065,0.5,0.95,0.9,0.1,0.4,0.1,6.69,16.2,16.2,6.69,16.2,16.2,8,30,30,10,0.35,,,,,,, +5,38.95561,142.10001,67.1,0.5,0.95,0.9,0.1,0.4,0.1,6.17,16.63,16.63,6.17,16.63,16.63,8,20,20,10,0.1,,,,,,, +6,27.31688,150,64.5,0.5,0.95,0.9,0.1,0.4,0.1,5.66,11.4,11.4,5.66,11.4,11.4,8,20,20,4,0.3,,,,,,, +7,30.01159,150,62.7,0.5,0.95,0.9,0.1,0.4,0.1,6,13.29,13.29,6,13.29,13.29,8,30,30,4,0.1,,,,,,, +8,24.80956,147.3,69,0.5,0.95,0.9,0.1,0.4,0.1,8.06,20.91,20.91,8.06,20.91,20.91,8,20,20,3,0.1,,,,,,, +9,27.31688,150,60.7,0.5,0.95,0.9,0.1,0.4,0.1,6.17,10.71,10.71,6.17,10.71,10.71,8,20,20,6,0.1,,,,,,, +10,25,125,71,0.5,0.95,0.9,0.1,0.4,0.1,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,6,0.1,,,,,,, +11,30,150,71,0.5,0.95,0.9,0.15,0.4,0.15,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,5,0.05,,,,,,, +12,30,150,71,0.5,0.95,0.9,0.15,0.4,0.15,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,5,0.05,,,,,,, +13,30,150,71,0.5,0.95,0.9,0.15,0.4,0.15,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,5,0.05,,,,,,, +14,30,150,71,0.5,0.95,0.9,0.15,0.4,0.15,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,0.05,0.05,,,,,,, +15,40,150,71,0.5,0.95,0.9,0.15,0.4,0.15,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,6,0.05,,,,,,, +16,40,135,71,0.5,0.95,0.9,0.25,0.4,0.25,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,1,0.05,,,,,,, +17,40,150,71,0.5,0.95,0.9,0.1,0.4,0.1,6.51,14.06,14.06,6.51,14.06,14.06,8,20,20,0,0,,,,,,, +,Leaf C,Wood C,Froot C,met C,str C,CWD C,mic C,slow C,pass C,,,,,,,,,,,,,,,,,, +unit,g C/m2,g C/m2,g C/m2,g C/m2,g C/m2,g C/m2,g C/m2,g C/m2,g C/m2,,,,,,,,,,,,,,,,,, +1,384.6037,0.01,250,6.57702,209.17276,606.02551,528.664,13795.93945,4425.39648,,,,,,,,,,,,,,,,,, +2,273,0.01,2586,44.63457,433.76257,1150.76477,11.37765,311.80923,13201.81348,,,,,,,,,,,,,,,,,, +3,96.59814,0.01,220,7.12712,277.77332,776.73303,597.07849,16121.12012,5081.80176,,,,,,,,,,,,,,,,,, +4,150.26376,0.01,220,10.97797,312.54916,888.56952,405.55539,11153.25195,5041.19238,,,,,,,,,,,,,,,,,, +5,88,0.01,140,3.22937,39.44449,111.5864,168.04506,4465.47803,1386.47705,,,,,,,,,,,,,,,,,, +6,137.17143,0,263,28.57245,50.91091,0,425.64313,5694.43652,4179.92041,,,,,,,,,,,,,,,,,, +7,137.17143,0,263,28.57245,50.91091,0,425.64313,5694.43652,4179.92041,,,,,,,,,,,,,,,,,, +8,137.17143,0,263,28.57245,50.91091,0,425.64313,5694.43652,4179.92041,,,,,,,,,,,,,,,,,, +9,160,0,240,28.57245,50.91091,0,512.42474,6855.43848,5032.13721,,,,,,,,,,,,,,,,,, +10,160,0,240,28.57245,50.91091,0,512.42474,6855.43848,5032.13721,,,,,,,,,,,,,,,,,, +11,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,,,,, +12,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,,,,, +13,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,,,,, +14,0,0,0,1.45775,4.95634,28.44085,57.77585,1325.05225,517.17194,,,,,,,,,,,,,,,,,, +15,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,,,,, +16,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,,,,, +17,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,,,,, +IGBP:,Tkshed,xkleafcoldmax,xkleafcoldexp,xkleafdrymax,xkleafdryexp,Tkchill,Tkwarm,GDD2stdy,nd2onset,nd2grow,nd2dorm,phena,phenb,,,,,,,,,,,,,, +,K,1/year,1/year,K,K,DDK,day,day,day,??,??,phenc,,,,,,,,,,,,,,, +1,268,0.2,3,0.1,3,273.14999,268.14999,200,30,15,10,667,-0.0304,68,,,,,,,,,,,,, +2,260,0.1,3,0.1,3,260,260,200,30,15,10,667,-0.0304,0,,,,,,,,,,,,, +3,263.15,0.1,3,0.1,3,273.14999,268.14999,200,30,15,10,667,-0.0304,0,,,,,,,,,,,,, +4,268.15,0.6,3,1,3,273.14999,268.14999,200,30,15,10,667,-0.0304,0,,,,,,,,,,,,, +5,277.14999,1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +6,275.14999,0.2,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +7,275.14999,0.2,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +8,275.14999,0.2,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +9,278.14999,0.3,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +10,278.14999,0.3,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +11,277.14999,0.1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +12,277.14999,0.1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +13,277.14999,0.1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +14,277.14999,0.1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +15,277.14999,0.1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +16,277.14999,0.1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +17,283.14999,0.1,3,0.1,3,273.14999,268.14999,100,30,15,10,638,-0.01,68,,,,,,,,,,,,, +,N/Cleafmi,N/Cleafmx,N/Cwdmin,N/Cwdmax,N/Cfrtmin,N/Cfrtmax,xNminloss,xNleach,nfixrate,,,,,,,,,,,,,,,,,, +,g N/g C,g N/g C,g N/g C,g N/g C,g N/g C,g N/g C,fraction,1/year,gn/m2/yr,,,,,,,,,,,,,,,,,, +1,0.014285714,0.021849379,0.002099958,0.002099958,0.008333333,0.008333333,0.05,0.05,0.08,,,,,,,,,,,,,,,,,, +2,0.025,0.035,0.003706449,0.003706449,0.008895479,0.008895479,0.05,0.05,2.6,,,,,,,,,,,,,,,,,, +3,0.01802348,0.043256351,0.002050861,0.002050861,0.008333333,0.008333333,0.05,0.05,0.21,,,,,,,,,,,,,,,,,, +4,0.020883433,0.020883433,0.003201024,0.003201024,0.008333333,0.008333333,0.05,0.05,1.64,,,,,,,,,,,,,,,,,, +5,0.014285714,0.030804292,0.003518649,0.003518649,0.008333333,0.008333333,0.05,0.05,0.37,,,,,,,,,,,,,,,,,, +6,0.018303701,0.043928882,0.003333333,0.003333333,0.008333333,0.008333333,0.05,0.05,0.95,,,,,,,,,,,,,,,,,, +7,0.033320461,0.033320461,0.006666667,0.006666667,0.015948963,0.015948963,0.05,0.05,0.95,,,,,,,,,,,,,,,,,, +8,0.020153521,0.048368452,0.003394433,0.003394433,0.008333333,0.008333333,0.05,0.05,0.95,,,,,,,,,,,,,,,,,, +9,0.018303701,0.043928882,0.003333333,0.003333333,0.008333333,0.008333333,0.05,0.05,4,,,,,,,,,,,,,,,,,, +10,0.02,0.048,0.004,0.0096,0.008333333,0.008333333,0.05,0.05,4,,,,,,,,,,,,,,,,,, +11,0.01667,0.04,0.00333,0.008,0.00704,0.0169,0.05,0.05,0,,,,,,,,,,,,,,,,,, +12,0.01667,0.04,0.00333,0.008,0.00704,0.0169,0.05,0.05,0,,,,,,,,,,,,,,,,,, +13,0.01667,0.04,0.00333,0.008,0.00704,0.0169,0.05,0.05,0,,,,,,,,,,,,,,,,,, +14,0.01667,0.04,0.00333,0.008,0.00704,0.0169,0.05,0.05,0.35,,,,,,,,,,,,,,,,,, +15,0.0125,0.03,0.00333,0.008,0.00704,0.0169,0.05,0.05,0,,,,,,,,,,,,,,,,,, +16,0.0125,0.03,0.0037,0.00889,0.00704,0.0169,0.05,0.05,0,,,,,,,,,,,,,,,,,, +17,0.0125,0.03,0.00333,0.008,0.00704,0.0169,0.05,0.05,0,,,,,,,,,,,,,,,,,, +,Nleaf,Nwood,Nfrt,N met,N Str,Ncwd,N mic,N slow,N Pass,N Nmin,,,,,,,,,,,,,,,,, +vegtype,gN/m2,gN/m2,gN/m2,gN/m2,gN/m2,gN/m2,gN/m2,gN/m2,gN/m2,gN /m2,,,,,,,,,,,,,,,,, +1,7.54125,31.46159,6.09756,0.06448,1.39449,2.4241,52.8664,919.72931,295.02643,1000,,,,,,,,,,,,,,,,, +2,9.9,102,38,0.74391,2.89175,8.52418,1.13777,20.78728,880.12085,1000,,,,,,,,,,,,,,,,, +3,1.60997,22.73361,5.36585,0.05939,1.85182,3.10693,59.70785,1074.74133,338.78677,1000,,,,,,,,,,,,,,,,, +4,3.75659,80.24989,5.36585,0.13722,2.08366,6.582,40.55554,743.55017,336.0795,1000,,,,,,,,,,,,,,,,, +5,2.93333,2.75556,3.41463,0.05382,0.26296,0.82657,16.80451,297.69852,92.4318,1000,,,,,,,,,,,,,,,,, +6,4.57238,0,6.41463,0.47621,0.33941,0,42.56431,379.62912,278.66135,1000,,,,,,,,,,,,,,,,, +7,4.57238,0,6.41463,0.47621,0.33941,0,42.56431,379.62912,278.66135,1000,,,,,,,,,,,,,,,,, +8,4.57238,0,6.41463,0.47621,0.33941,0,42.56431,379.62912,278.66135,1000,,,,,,,,,,,,,,,,, +9,5.33333,0,5.85366,0.47621,0.33941,0,51.24247,457.02921,335.4758,1000,,,,,,,,,,,,,,,,, +10,5.33333,0,5.85366,0.47621,0.33941,0,51.24247,457.02921,335.4758,1000,,,,,,,,,,,,,,,,, +11,0,0,0,0,0,0,0,0,0,1000,,,,,,,,,,,,,,,,, +12,0,0,0,0,0,0,0,0,0,1000,,,,,,,,,,,,,,,,, +13,0,0,0,0,0,0,0,0,0,1000,,,,,,,,,,,,,,,,, +14,0.5,0.12593,1.53659,0.01822,0.03304,0.21067,5.77758,88.33681,34.47813,1000,,,,,,,,,,,,,,,,, +15,0,0,0,0,0,0,0,0,0,1000,,,,,,,,,,,,,,,,, +16,0,0,0,0,0,0,0,0,0,1000,,,,,,,,,,,,,,,,, +17,0,0,0,0,0,0,0,0,0,1000,,,,,,,,,,,,,,,,, +,N/Pleafmin,N/Pleafmx,N/Pwdmin,N/Pwdmax,N/Pfrtmin,N/Pfrtmax,fpptoL(leaf),fpptoL(wd),fpptoL(frt),,,,,,,,,,,,,,,,,, +,gN/gP,gN/gP,gN/gP,gN/gP,gN/gP,gN/gP,fraction,fraction,fraction,,,,,,,,,,,,,,,,,, +1,10.92308,12.07288,20.30167,22.43869,20.29341,22.42955,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +2,15.0,40.0,15.0,60.0,15.0,40.0,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +3,9.25484,10.22903,17.48344,19.3238,17.39767,19.229,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +4,12.73848,14.07938,19.08018,21.08862,19.0601,21.06643,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +5,12.07217,13.34292,22.46036,24.8246,22.49363,24.86138,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +6,13.51473,14.93733,15,15,15.63498,17.28077,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +7,14.05,15.52895,15,15,16.08255,17.77545,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +8,12.578,13.902,15.96,17.64,14.49241,16.01793,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +9,15.12262,16.71447,20.52,20.52,22.69109,25.07962,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +10,10,10,15,15,15,15,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +11,13,13,15,15,15,15,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +12,10,10,15,15,15,15,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +13,10,10,15,15,15,15,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +14,16.2336,17.9424,17.5275,19.3725,22.13268,24.46244,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +15,10,10,15,15,15,15,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +16,10,10,15,15,15,15,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +17,10,10,15,15,15,15,0.5,0.95,0.9,,,,,,,,,,,,,,,,,, +,xkmlabp,xpsorbmax,xfpleach,kplab,xkpsorb,kpocc,N:Psoil,,,,,,,,,,,,,,,,,,,, +soilorder,gP/m2,gP/m2,no,dimen,1/year,1/year,1/year,mic,slow,pass,,,,,,,,,,,,,,,,, +1,74.5408,439.46057,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +2,68.1584,937.17798,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +3,77.952,915.3808,0.0005,2.5,8,8,0.00137,0.00001,0.00003,,,,,,,,,,,,,,,,,, +4,64.41918,600.88434,0.0005,2.5,8,8,0.00137,0.00001,0.00003,,,,,,,,,,,,,,,,,, +5,64.41918,446.90811,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +6,70.5856,160.58224,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +7,64.5888,249.53581,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +8,54.1692,461.30975,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +9,9.7704,43.63956,0.0005,2.5,8,8,0.00137,0.00003,0.00003,,,,,,,,,,,,,,,,,, +10,28.29,175.49261,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +11,63.963,227.50909,0.0005,2.5,8,8,0.00137,0.00003,0.00003,,,,,,,,,,,,,,,,,, +12,32.402,377.26175,0.0005,2.5,8,8,0.00137,0.00002,0.00003,,,,,,,,,,,,,,,,,, +Pleaf,Pwood,Pfroot,Pmet,Pstr,Pcwd,Pmic,Pslow,Ppass,Plab,Psorb,Pocc,,,,,,,,,,,,,,,, +vegtype,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,gP/m2,,,,,,,,,,,,,,, +1,0.19165,0.95398,0.07666,0.00438,0.06972,0.101,6.87263,119.56481,38.35344,26.737,126.73,138.571,,,,,,,,,,,,,,, +2,0.415,5.88,1.95,0.02976,0.14459,0.19179,0.14791,2.70235,114.41571,19.947,92.263,120.374,,,,,,,,,,,,,,, +3,0.11599,0.64438,0.08055,0.00475,0.09259,0.12946,7.76202,139.71637,44.04228,29.107,134.63901,138.22,,,,,,,,,,,,,,, +4,0.13545,2.42478,0.1411,0.00732,0.10418,0.14809,5.27222,96.66152,43.69033,30.509,132.01199,148.08299,,,,,,,,,,,,,,, +5,0.02282,0,0.03708,0.00215,0.01315,0.0186,2.18459,38.70081,12.01613,23.206,173.47,114.496,,,,,,,,,,,,,,, +6,0.15125,0,0.15125,0.01905,0.01697,0.1,5.53336,49.35178,36.22598,25.538,186.207,145.16299,,,,,,,,,,,,,,, +7,0.15125,0,0.15125,0.01905,0.01697,0.1,5.53336,49.35178,36.22598,25.538,186.207,145.16299,,,,,,,,,,,,,,, +8,0.15125,0,0.15125,0.01905,0.01697,0.1,5.53336,49.35178,36.22598,25.538,186.207,145.16299,,,,,,,,,,,,,,, +9,0.15125,0,0.15125,0.01905,0.01697,0.1,6.66152,59.4138,43.61185,27.729,155.51801,158.884,,,,,,,,,,,,,,, +10,0.15125,0,0.15125,0.01905,0.01697,0.1,6.66152,59.4138,43.61185,27.729,155.51801,158.884,,,,,,,,,,,,,,, +11,0,0,0,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,, +12,0,0,0,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,, +13,0,0,0,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,, +14,0.007,0,0.00875,0.00097,0.00165,0.1,0.75109,11.48379,4.48216,21.038,255.78999,108.897,,,,,,,,,,,,,,, +15,0,0,0,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,, +16,0,0,0,0,0,0,0,0,0,0,0,0,,,,,,,,,,,,,,, +17,0,0,0,0,0,0,0,0,0,0.103,1.176,0.688,,,,,,,,,,,,,,, +,xnpmax,q01soil,xkoplitter,xkoptsoil,prodptase,cosnpup,maxfineL,maxcwd,nintercept,"nslope(only this will be optimized, not the intercept)",,,,,,,,,,,,,,,,, +vegtype,unitless,unitless,unitless,unitless,??,gN/gP,gC/m2,gC/m2,micromol/m2/s,micromol/m2/s/(gN/m2),,,,,,,,,,,,,,,,, +1,1.51086,1.85,1.0,1.0,0.5,40,1524,1795,6.32,5.439102211,,,,,,,,,,,,,,,,, +2,1.27916,1.85,1.0,1.0,0.2,25,384,613,4.19,14.97784995,,,,,,,,,,,,,,,,, +3,1.59108,1.85,1.0,1.0,0.5,40,1527,1918,6.32,41.19765503,,,,,,,,,,,,,,,,, +4,1.18607,1.85,1.0,1.0,0.5,40,887,1164,5.73,46.5176652,,,,,,,,,,,,,,,,, +5,1.35808,1.85,1.0,1.0,0.5,40,157,107,14.71,33.93960517,,,,,,,,,,,,,,,,, +6,1.45622,1.85,1.0,1.0,0.5,40,361,420,6.42,45.56635616,,,,,,,,,,,,,,,,, +7,1.45622,1.85,1.0,1.0,0.5,40,225,228,6.42,10.94216798,,,,,,,,,,,,,,,,, +8,1.45622,1.85,1.0,1.0,0.5,40,913,573,14.71,49.94216798,,,,,,,,,,,,,,,,, +9,1.21038,1.85,1.0,1.0,0.5,40,660,811,4.71,21.78,,,,,,,,,,,,,,,,, +10,1.21038,1.85,1.0,1.0,0.5,40,100,100,14.71,23.15,,,,,,,,,,,,,,,,, +11,1.45622,1.85,0.4,1,0.5,40,100,100,14.71,23.15,,,,,,,,,,,,,,,,, +12,1.36599,1.85,0.4,0.65,4,40,100,100,7,10,,,,,,,,,,,,,,,,, +13,1.21038,1.85,0.4,0.5,0.5,40,100,100,14.71,23.15,,,,,,,,,,,,,,,,, +14,1,1.85,2,2,0.5,40,83,23,14.71,23.15,,,,,,,,,,,,,,,,, +15,1.39965,1.85,0.4,0.5,0.5,40,100,100,12.80014,20.14434,,,,,,,,,,,,,,,,, +16,1,1.85,0.4,1,0.5,40,100,100,14.71,23.15,,,,,,,,,,,,,,,,, +17,1,1.85,0.4,1,0.5,40,100,100,14.71,23.15,,,,,,,,,,,,,,,,, +,la_to_sa,disturbance_interval,vcmax_walker_scalar, +vegtype,unitless,years,unitless,unitless,unitless,unitless, +1,5000, 100, 1.0, +2, 3.0000000E+03, 100, 1.2, +3,5000, 100, 1.0, +4,5000, 100, 1.0, +5,5000, 100, 1.0, +6,5000, 100, 1.0, +7,5000, 100, 1.0, +8,5000, 100, 1.0, +9,5000, 100, 1.0, +10,5000, 100, 1.0, +11,5000, 100, 1.0, +12,5000, 100, 1.0, +13,5000, 100, 1.0, +14,5000, 100, 1.0, +15,5000, 100, 1.0, +16,5000, 100, 1.0, +17,5000, 100, 1.0, +DAMM_EnzPool, DAMM_KMO2,DAMM_KMcp, DAMM_Ea, DAMM_alpha , +vegtype,unitless,unitless,unitless,unitless,kJ/mol,unitless, +1,10.0, 0.01, 0.1, 62, -1.0, +2, 1.0, 0.001, 0.01, 58, 0.0, +3, 10.0, 0.01, 0.1, 62, -1.0, +4, 10.0, 0.01, 0.1, 62, -1.0, +5, 10.0, 0.01, 0.1, 62, -1.0, +6, 10.0, 0.01, 0.1, 58, 0.0, +7, 10.0, 0.01, 0.1, 58, 0.0, +8, 10.0, 0.01, 0.1, 62, -1.0, +9, 10.0, 0.01, 0.1, 62, -1.0, +10,10.0, 0.01, 0.1, 62, -1.0, +11,10.0, 0.01, 0.1, 62, -1.0, +12,10.0, 0.01, 0.1, 62, -1.0, +13,10.0, 0.01, 0.1, 62, -1.0, +14,10.0, 0.01, 0.1, 62, -1.0, +15,10.0, 0.01, 0.1, 62, -1.0, +16,10.0, 0.01, 0.1, 62, -1.0, +17,10.0, 0.01, 0.1, 62, -1.0, \ No newline at end of file diff --git a/scripts/cablepop/run_bios_future.sh b/scripts/cablepop/run_bios_future.sh new file mode 100755 index 000000000..844280ea5 --- /dev/null +++ b/scripts/cablepop/run_bios_future.sh @@ -0,0 +1,1364 @@ +#!/usr/bin/env bash + +# Gadi +# https://opus.nci.org.au/display/Help/How+to+submit+a+job + #PBS -N AGCD_2023_0.25_6 + #PBS -P x45 + # express / normal / copyq (2x24, cascadelake) + #PBS -q normal + # Typical for global or Aust continent at 0.25, 192 GB memory and 48 cpus, + # maybe 12 hours walltime +# Typical for small runs, fewer cpus than pixels + #PBS -l walltime=24:00:00 + #PBS -l mem=96GB + #PBS -l ncpus=48 + # #PBS -l jobfs=1GB + #PBS -l storage=gdata/x45 + #PBS -l software=netCDF:MPI:Intel:GNU + #PBS -r y + #PBS -l wd + #PBS -j oe + #PBS -S /bin/bash + #PBS -M alison.bennett@csiro.au + #PBS -m ae + +# script varied from original run_cable-pop.sh script for BIOS3 future runs - most of systems/other users stuff stripped out +# inh599@gadi harman@gadi 2023 + +system=ab7412@gadi + +# MPI run or single processor run +# nproc should fit with job tasks +dompi=1 # 0: normal run: ./cable + # 1: MPI run: mpiexec -n ${nproc} ./cable_mpi +nproc=4 # Number of cores for MPI runs + # must be same as above: SBATCH -n nproc or PBS -l ncpus=nproc + +# -------------------------------------------------------------------- +# +# Full Cable run with biomass spinup, POP, land-use change, etc. +# +# This script uses CRU-JRA forcing. +# +# Global meteo and land-use change data can be used with a mask giving land points. +# In step 0, the land mask can be extracted for a single point, an area +# or a number of random points can be chosen. +# Alternatively, single site met, LUH2, forcing and mask can be extracted from the global data sets. +# +# The run sequence is as follows: +# 1. Create a climate restart file using Cable's default vegetation distribution. +# 2. First phase of spinup with static land use, fixed atmospheric CO2 and +# N deposition from 1700, and 30 years of repeated meteorology. +# Zero initial biomass stocks, POP and climate. +# 3. Bring biomass stocks into equilibrium, restricting labile P and mineral N pools. +# Repeat a and b several times. +# a) Start from restart files. +# b) Use dump files for the biophysics. Quasi-equilibrium of soil and litter pools +# using an analytic steady-state solution. +# 4. Same as 3 but without any restriction on labile P and mineral N pools. +# Repeat a and b several times. +# 5. Second phase of spinup with dynamic land use, atmospheric CO2 and N deposition. +# a) Dynamic land use from 1580 to 1699, using still fixed atmospheric CO2 and +# N deposition from 1700, and 30 years of repeated meteorology. +# b) Run from 1700 to 1950 with dynamic land use, varying atmospheric CO2 and N deposition, +# but still with 30 years of repeated meteorology. +# 6. Final historical run +# a) using AGCD forcing from 1900 to GCMstart, everything dynamic +# b) CCAM-derived historical data from GCMstart to GCMswitch, everything dynamic +# 7. Future run, everything dynamic using CCAM-derived forcing +# +# Written, Matthias Cuntz, Aug 2019, following the run scripts,namelists provided by V Haverd +# Modified, Jurgen Knauer, 2020 - gm_explicit, coordination, acclimation +# - bios, plume, future runs +# Matthias Cuntz, Mar 2021 - functions into run_cable-pop_lib.sh +# Ian Harman, October 2023 - streamlined for BIOS binary only +# - and CCAM-derived future runs. +# +# -------------------------------------------------------------------- +# Sequence switches +# +# imeteo no longer active - removed +# doextract no longer active - removed +# randompoints no longer active - removed + +experiment=AGCD_2023_0.25_6 #experiment name + +# Step 0 +purge_restart=1 # 1/0: Do/Do not delete all restart files (completely new run, e.g. if settings changed) +# Step 1 +doclimate=1 # 1/0: Do/Do not create climate restart file +# Step 2 +dofromzero=1 # 1/0: Do/Do not first spinup phase from zero biomass stocks +# Step 3 +doequi1=1 # 1/0: Do/Do not bring biomass stocks into quasi-equilibrium with restricted P and N pools +nequi1=4 # number of times to repeat steps in doequi1 +# Step 4 +doequi2=1 # 1/0: Do/Do not bring biomass stocks into quasi-equilibrium with unrestricted P and N pools +nequi2=4 # number of times to repeat steps in doequi2 +# Step 5a +doiniluc=0 # 1/0: Do/Do not spinup with dynamic land use (5a) +# Step 5b +doinidyn=1 # 1/0: Do/Do not full dynamic spinup from 1700 to 1899 (5b) +# Step 6 +dofinal1=1 # 1/0: Do/Do not final run from 1900 to GCMstart +dofinal2=0 # 1/0: Do/Do not final run from GCMstart to GCMswitch +# Step 7 +dofuture=0 # 1/0: Do/Do not future runs GCMswtich to GCMend + +# -------------------------------------------------------------------- +# Other switches +restarttype='' # 'None' 'AGCD_1950' 'AGCD_1978' 'GCM_2014' +landmasktype='mask' # 'mask' 'land' # determines the GlobalLandMask. Must match output%grid: mask = gridded, land = points. + +# MetType +mettype='bios' # 'bios' only +domain='aust_0.25_pts' # bios domain - 'acttest9','reccap1000pts','aust_0.25_pts','australia' +GCM='' # 'NCC-NorESM2-MM' 'ECMWF-ERA5' 'CNRM-ESM2-2' +RCP='historical' # 'historical', 'ssp126', 'ssp370', 'evaluation' - note no future run if historical +GCMstart=2024 # start year for CCAM derived meteorology - must be between 1951-2014 (GCM), 1979-2021 (ERA5) +GCMsw= # start year of 'future' in CCAM derived meteorology (2015 for CCAM met, 2022 for ERA5) +GCMend= # end year for CCAM derived meteorology - must be less than 2100 + +# Cable science switches +explicit_gm=0 # 1/0: explicit (finite) or implicit mesophyll conductance +use_LUTgm=1 # 1/0: Do/Do not use lookup table for parameter conversion accounting for gm (only used if explicit_gm=1) +Rubisco_params="Bernacchi_2002" # "Bernacchi_2002" or "Walker_2013" +coordinate_photosyn=1 # 1/0: Do/Do not coordinate photosynthesis +coord=T # T/F: version of photosyn. optimisation (optimised(F) or forced (T)) +acclimate_photosyn=1 # 1/0: Do/Do not acclimate photosynthesis +call_pop=1 # 1/0: Do/Do not use POP population dynamics model, coupled to CASA +call_blaze=0 # 1/0 Do/Do not use BLAZE fire model. +doc13o2=0 # 1/0: Do/Do not calculate 13C +c13o2_simple_disc=0 # 1/0: simple or full 13C leaf discrimination + +#INH need to add a top level switch for S0, S1, S2, S3 type experiments? + +#switch dependent stuff +if [[ "${domain}" == "aust_0.25_pts" ]] ; then + degrees=0.25 +else + degrees=0.05 +fi + +# -------------------------------------------------------------------- +# Setup +# + +set -e + +trap cleanup 1 2 3 6 + +pid=$$ +isdir="${PWD}" +prog=$0 +pprog=$(basename ${prog}) +pdir=$(dirname ${prog}) +tmp=${TMPDIR:-"/tmp"} +system=$(echo ${system} | tr A-Z a-z) +sys=${system#*@} +user=${system%@*} + +# +# Special things on specific computer system such as loading modules ---------------- +# + +export mpiexecdir= + +#if [[ "${sys}" == "pearcey" ]] ; then +# # prog is slurm_script +# pdir=${isdir} +# module del intel-cc intel-fc +# module add intel-cc/16.0.1.150 intel-fc/16.0.1.150 +# module unload intel-mpi/5.0.1.035 +# module add netcdf/4.3.3.1 openmpi/1.8.8 +if [[ "${sys}" == "gadi" ]] ; then +# INH I couldn't get this if/fi to work - ?due to not running through PBS +# ACB: got it working running through PBS. + pdir=${isdir} + #. /etc/bashrc + module purge + # module load intel-compiler/2019.5.281 + # module load intel-mpi/2019.5.281 + # module load netcdf/4.6.3 + # module load intel-compiler/2021.5.0 + # module load intel-mpi/2021.5.1 + # module load netcdf/4.8.0 + # # module load hdf5/1.10.5 + module load intel-compiler-llvm/2023.0.0 + module load intel-mpi/2021.8.0 + module load netcdf/4.9.2 + #if [[ ${randompoints} -eq 0 ]] ; then module load nco/4.9.2 ; fi # needed for cropping outputs + export mpiexecdir=/apps/intel-mpi/2019.5.281/intel64/bin +fi + +if [[ ! -z ${mpiexecdir} ]] ; then export mpiexecdir="${mpiexecdir}/" ; fi + +# +# Directories of things ---------------------------------------------------------- +# +# Relative directories must be relative to the directory of this script, +# not relative to the directory from which this script is launched (if different) +# nor relative to the run path. +# +if [[ "${system}" == "inh599@gadi" || "${system}" == "harman@gadi" ]] ; then + # Run directory: runpath="${sitepath}/run" + #sitepath="/g/data/x45/BIOS3_output/${experiment}" # Results + sitepath="/scratch/x45/inh599/BIOStests/${experiment}" # Results + workpath="/home/599/inh599/JAC/CABLE/BLAZEruns" # run directory + cablehome="/home/599/inh599/JAC/CABLE/BLAZE_9184" # model home +elif [[ "${system}" == "ab7412@gadi" ]] ; then + # Run directory: runpath="${sitepath}/run" + #sitepath="/g/data/x45/BIOS3_output/${experiment}" # Results + sitepath="/scratch/x45/ab7412/CABLE_BIOS/${experiment}" # Results + workpath="/home/563/ab7412/CABLE_run/BIOS/CCAM" # run directory + cablehome="/home/563/ab7412/cable_code/Github/CABLE" +else + echo "System not known." + exit 1 +fi + +# Cable executable +if [[ ${dompi} -eq 1 ]] ; then + exe="${cablehome}/offline/cable-mpi" + else + exe="${cablehome}/offline/cable" +fi + +# CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) + aux="/g/data/x45/CABLE-AUX" + BlazeDataPath="/g/data/x45/Data_BLAZE" + +# Global Mask + SurfaceFile="${aux}/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc" # note that SurfaceFile does not need subsetting + +# Met is assumed to be BIOS + if [[ "${mettype}" == "bios" ]] ; then + GlobalMetPath="/g/data/x45/BIOS3_forcing/${domain}/met/" # last slash is needed | ACB: metpath for spinup + ParamPath="/g/data/x45/BIOS3_forcing/${domain}/params/" # only in bios.nml + GlobalTransitionFilePath="/g/data/x45/LUH2/v3h/${degrees}deg_aust/EXTRACT" #LUC information + + #set landmask dependent up on land or mask switch + if [[ "${landmasktype}" == "mask" ]] ; then + degrees_msk=${degrees/0./} # remove 0. from degrees + GlobalLandMaskFile="/g/data/x45/BIOS3_forcing/${domain}/australia_op_maskv2ctr${degrees_msk}" # no file extension | ACB: Landmask file. + elif [[ "${landmasktype}" == "land" ]] ; then + GlobalLandMaskFile="/g/data/x45/BIOS3_forcing/${domain}/${domain}" # no file extension | ACB: Landmask file. + fi + + fi + + +# Run directory +runpath="${sitepath}/run" + +# Cable parameters +if [[ "${mettype}" == 'bios' ]] ; then + namelistpath="${workpath}/namelists_bios" + filename_veg="${workpath}/params_bios/def_veg_params.txt" + filename_soil="${workpath}/params_bios/def_soil_params.txt" + casafile_cnpbiome="${workpath}/params_bios/pftlookup.csv" +fi + +# Other scripts +ScriptsPath="${cablehome}/scripts" + +# Mask (AB: I think this can be removed as it's overwritten further down) +LandMaskFile="${sitepath}/mask/${experiment}_landmask.nc" + +# Met +if [[ "${mettype}" == 'bios' ]] ; then + MetPath="${sitepath}/met/bios_${degrees}deg" + ClimateFile="${sitepath}/mask/bios_climate_rst.nc" + if [[ "${sys}" == "gadi" ]]; then + if [[ (${doclimate} -eq 0) && (! -f ${ClimateFile}) ]] ; then + ClimateFile="/g/data/x45/BIOS3_output/bio_climate_acttest9/bios_climate_rst.nc" + fi + fi +fi + +# LUC (AB - I think this can be removed as it is overwritten further down) +TransitionFilePath="${sitepath}/LUH2/v3/1deg" + +# gm lookup tables +gm_lut_bernacchi_2002="${cablehome}/params/gm_LUT_351x3601x7_1pt8245_Bernacchi2002.nc" +gm_lut_walker_2013="${cablehome}/params/gm_LUT_351x3601x7_1pt8245_Walker2013.nc" + +# 13C +filename_d13c_atm="${cablehome}/params/graven_et_al_gmd_2017-table_s1-delta_13c-1700-2025.txt" + +# -------------------------------------------------------------------- +# Start Script +# -------------------------------------------------------------------- + +# -------------------------------------------------------------------- +# Helper functions, most functions are in plumber_cable-pop_lib.sh +# + +source ${pdir}/run_cable-pop_lib.sh + +# usage of script +function usage() +{ + printf "${pprog} [-h]\n" + printf "Runs Cable on a single grid cell with spinup, POP, land-use change, etc.\n" + printf "Behaviour of the script is controlled by switches at the top of the script (ca. line 101ff).\n" + printf "\n" + printf "Options\n" + printf " -h Prints this help screen.\n" +} + +# cleanup at end or at trap +function cleanup() +{ + \rm -f ${tmp}/*.${pid}* + exit 1 +} + +# returns argument to extract lat and lon with ncks +function nckslatlon() +{ + vars=$(ncvarlist ${1}) + if [[ -z $(isin latitude ${vars}) ]] ; then ilat="lat" ; else ilat="latitude" ; fi + if [[ -z $(isin longitude ${vars}) ]] ; then ilon="lon" ; else ilon="longitude" ; fi + if [[ -z $(echo ${2} | cut -f 3 -d ",") || -z $(echo ${2} | cut -f 4 -d ",") ]] ; then + iilat=$(echo ${2} | cut -f 1 -d ",") + iilon=$(echo ${2} | cut -f 2 -d ",") + echo "-d ${ilat},${iilat} -d ${ilon},${iilon}" + else + iilat1=$(echo ${2} | cut -f 1 -d ",") + iilat2=$(echo ${2} | cut -f 2 -d ",") + iilon1=$(echo ${2} | cut -f 3 -d ",") + iilon2=$(echo ${2} | cut -f 4 -d ",") + echo "-d ${ilat},${iilat1},${iilat2} -d ${ilon},${iilon1},${iilon2}" + fi +} + +# -------------------------------------------------------------------------------------------------- +# Preparation +# +# Get options +while getopts "h" option ; do + case ${option} in + h) usage; exit;; + *) printf "Error ${pprog}: unimplemented option.\n\n" 1>&2; usage 1>&2; exit 1;; + esac +done +shift $((${OPTIND} - 1)) + +# +# get directories +mkdir -p ${sitepath}/mask +pdir=$(abspath ${pdir}) +cd ${pdir} +adir=$(abspath ${aux}) +exe=$(absfile ${exe}) +mkdir -p ${runpath} +rdir=$(abspath ${runpath}) +ndir=$(abspath ${namelistpath}) +sdir=$(abspath ${ScriptsPath}) + +# +# prepare run directory +cd ${rdir} +mkdir -p logs +mkdir -p outputs +mkdir -p restart +ln -sf ${adir} +# ln -sf ${exe} +cp ${exe} ./ +iexe=$(basename ${exe}) +cd ${pdir} + +# +# set stacksize to unlimited if permitted, otherwise to 15 bit if possible +set +e +ulimit -s unlimited 2> /dev/null || ulimit -s 32768 +set -e + +# -------------------------------------------------------------------- +# Info +# +t1=$(date +%s) +printf "Started at %s\n" "$(date)" + +printf "\nSetup\n" +printf " Serial / Parallel\n" +printf " dompi=${dompi}\n" +printf " nproc=${nproc}\n" +printf "\n" +printf " Sequence\n" +printf " experiment=${experiment}\n" +#printf " randompoints=${randompoints}\n" +printf " latlon=${latlon}\n" +printf " doclimate=${doclimate}\n" +printf " dofromzero=${dofromzero}\n" +printf " doequi1=${doequi1}\n" +printf " nequi1=${nequi1}\n" +printf " doequi2=${doequi2}\n" +printf " nequi2=${nequi2}\n" +printf " doiniluc=${doiniluc}\n" +printf " doinidyn=${doinidyn}\n" +printf " dofinal1=${dofinal1}\n" +printf " dofinal2=${dofinal2}\n" +printf " dofuture=${dofuture}\n" +printf "\n" +printf " Options\n" +printf " mettype=${mettype}\n" +printf " metmodel=${metmodel}\n" +printf " RCP=${RCP}\n" +printf " explicit_gm=${explicit_gm}\n" +printf " use_LUTgm=${use_LUTgm}\n" +printf " Rubisco_params=${Rubisco_params}\n" +printf " coordinate_photosyn=${coordinate_photosyn}\n" +printf " coord=${coord}\n" +printf " acclimate_photosyn=${acclimate_photosyn}\n" +printf " call_pop=${call_pop}\n" +printf " doc13o2=${doc13o2}\n" +printf " c13o2_simple_disc=${c13o2_simple_disc}\n" +printf "\n" +printf " Directories\n" +printf " sitepath=${sitepath}\n" +printf " cablehome=${cablehome}\n" +printf " exe=${exe}\n" +printf " aux=${aux}\n" +printf " GlobalLandMaskFile=${GlobalLandMaskFile}\n" +printf " SurfaceFile=${SurfaceFile}\n" +printf " GlobalMetPath=${GlobalMetPath}\n" +printf " GlobalTransitionFilePath=${GlobalTransitionFilePath}\n" +printf " runpath=${runpath}\n" +printf " namelistpath=${namelistpath}\n" +printf " filename_veg=${filename_veg}\n" +printf " filename_soil=${filename_soil}\n" +printf " casafile_cnpbiome=${casafile_cnpbiome}\n" +printf " LandMaskFile=${LandMaskFile}\n" +printf " MetPath=${MetPath}\n" +printf " ClimateFile=${ClimateFile}\n" +printf " TransitionFilePath=${TransitionFilePath}\n" +printf " gm_lut_bernacchi_2002=${gm_lut_bernacchi_2002}\n" +printf " gm_lut_walker_2013=${gm_lut_walker_2013}\n" +printf " filename_d13c_atm=${filename_d13c_atm}\n" +printf "\n" + +# -------------------------------------------------------------------- +# Prep input - all done in preprocessing +# +# -------------------------------------------------------------------- +# Prepare sequence +# +#BIOS configuration paths - historical meteorology and landmask +MetPath=$(abspath ${GlobalMetPath}) +TransitionFilePath=$(abspath ${GlobalTransitionFilePath}) +LandMaskFile=$(absfile ${GlobalLandMaskFile}) + +# absolute paths of other parameter files +ClimateFile=$(absfile ${ClimateFile}) +filename_veg=$(absfile ${filename_veg}) +filename_soil=$(absfile ${filename_soil}) +casafile_cnpbiome=$(absfile ${casafile_cnpbiome}) +gm_lut_bernacchi_2002=$(absfile ${gm_lut_bernacchi_2002}) +gm_lut_walker_2013=$(absfile ${gm_lut_walker_2013}) +filename_d13c_atm=$(absfile ${filename_d13c_atm}) +if [[ "${Rubisco_params}" == "Bernacchi_2002" ]] ; then + filename_gm_lut=${gm_lut_bernacchi_2002} +elif [[ "${Rubisco_params}" == "Walker_2013" ]] ; then + filename_gm_lut=${gm_lut_walker_2013} +else + filename_gm_lut="" +fi + + +# delete all restart files if required +if [[ ${purge_restart} -eq 1 ]] ; then + rm -f ${rdir}/restart/* +fi + +# make a copy of the run script and save into the log directory + +rs_name=$(basename "$0") +new_name="run_script_${rs_name%.sh}.sh" +copy_path="${rdir}/logs/${new_name}" +cp "$0" "$copy_path" +chmod 755 "$copy_path" +echo "run script copied to:" $copy_path + +#make a copy of the parameter files and save into the log directory +copy_path="${rdir}/logs" +cp ${filename_veg} "$copy_path" +cp ${filename_soil} "$copy_path" +cp ${casafile_cnpbiome} "$copy_path" +echo "parameter file " ${filename_veg} " copied to: " $copy_path +echo "parameter file " ${filename_soil} " copied to: " $copy_path +echo "parameter file " ${casafile_cnpbiome} " copied to: " $copy_path + +# Write standard namelists with options that are common to all steps of the sequence. +# They can, however, be overwritten in later steps. + +# global meteo namelist file - start with the historical information +if [[ "${mettype}" == "bios" ]] ; then + cat > ${tmp}/sedtmp.${pid} << EOF + met_path = "${MetPath}/" + param_path = "${ParamPath}" + landmaskflt_file = "${GlobalLandMaskFile}.flt" + landmaskhdr_file = "${GlobalLandMaskFile}.hdr" + rain_file = "1900010120231231_rain_recal_b2405.bin" + swdown_file = "1900010120231231_rad_b2405.bin" + tairmax_file = "1900010120231231_tmax_noclim_b2405.bin" + tairmin_file = "1900010120231231_tmin_noclim_b2405.bin" + wind_file = "1900010120231231_windspeed_ms_b2405.bin" + vp0900_file = "1900010120231231_vph09_b2405.bin" + vp1500_file = "1900010120231231_vph15_b2405.bin" + co2_file = "1700_2023_trendy_global_co2_ann.bin" +EOF + applysed ${tmp}/sedtmp.${pid} ${ndir}/bios.nml ${rdir}/bios_${experiment}.nml +fi + +# global landuse change namelist +cat > ${tmp}/sedtmp.${pid} << EOF + TransitionFilePath = "${TransitionFilePath}" + ClimateFile = "${ClimateFile}" + YearStart = 1700 + YearEnd = 2017 +EOF +applysed ${tmp}/sedtmp.${pid} ${ndir}/LUC.nml ${rdir}/LUC_${experiment}.nml + +# Blaze namelist !CLN CHECK - NB blazeTStep is overwritten in code +cat > ${tmp}/sedtmp.${pid} << EOF + blazeTStep = "annually" ! Call frequency ("daily", "monthly", "annually") + BurnedAreaSource = "SIMFIRE" ! Burnt Area ("PRESCRIBED", "SIMFIRE", "GFED4") + BurnedAreaFile = "${BlazeDataPath}/BA_Aust_2001-2019.nc" ! used for Prescribed fires !CLN not available for now! + SIMFIRE_REGION = "ANZ" ! ("ANZ", "EUROPE", "GLOBAL") + HydePath = "${BlazeDataPath}/HYDE3.1" ! Path to Hyde3.1 population density data + BurnedAreaClimatologyFile = "${BlazeDataPath}/simfire_monthly_ba.nc" ! BA climatology file (needed when blazeTStep!="annually") +EOF +applysed ${tmp}/sedtmp.${pid} ${ndir}/blaze.nml ${rdir}/blaze_${experiment}.nml +cp ${rdir}/blaze_${experiment}.nml ${rdir}/blaze.nml + +# global Cable namelist +cat > ${tmp}/sedtmp.${pid} << EOF + filename%met = "${mettype}" + filename%veg = "${filename_veg}" + filename%soil = "${filename_soil}" + filename%type = "${SurfaceFile}" + filename%out = "outputs/${mettype}_out_cable.nc" + filename%restart_in = "restart/${mettype}_cable_rst.nc" + filename%restart_out = "restart/${mettype}_cable_rst.nc" + casafile%cnpbiome = "${casafile_cnpbiome}" + casafile%out = "outputs/${mettype}_out_casa.nc" + casafile%cnpipool = "restart/${mettype}_casa_rst.nc" + casafile%cnpepool = "restart/${mettype}_casa_rst.nc" + cable_user%CASA_OUT_FREQ = "monthly" + cable_user%POP_restart_in = "restart/pop_${mettype}_ini.nc" + cable_user%POP_restart_out = "restart/pop_${mettype}_ini.nc" + cable_user%LUC_restart_in = "restart/${mettype}_LUC_rst.nc" + cable_user%LUC_restart_out = "restart/${mettype}_LUC_rst.nc" + cable_user%LUC_outfile = "outputs/${mettype}_out_LUC.nc" + cable_user%climate_restart_in = "restart/${mettype}_climate_rst.nc" + cable_user%climate_restart_out = "restart/${mettype}_climate_rst.nc" + cable_user%RunIden = "${mettype}" + cable_user%MetType = "${mettype}" + output%averaging = "monthly" + output%grid = "mask" + leaps = .false. + cable_user%SOIL_STRUC = "sli" + cable_user%Rubisco_parameters = "${Rubisco_params}" + cable_user%CALL_POP = .false. + cable_user%coordinate_photosyn = .false. + cable_user%acclimate_photosyn = .false. + cable_user%explicit_gm = .false. + cable_user%gm_LUT_file = "${filename_gm_lut}" + cable_user%c13o2 = .false. + cable_user%c13o2_simple_disc = .false. + cable_user%c13o2_delta_atm_file = "${filename_d13c_atm}" + cable_user%c13o2_outfile = "outputs/${mettype}_out_casa_c13o2.nc" + cable_user%c13o2_restart_in_flux = "restart/${mettype}_c13o2_flux_rst.nc" + cable_user%c13o2_restart_out_flux = "restart/${mettype}_c13o2_flux_rst.nc" + cable_user%c13o2_restart_in_pools = "restart/${mettype}_c13o2_pools_rst.nc" + cable_user%c13o2_restart_out_pools = "restart/${mettype}_c13o2_pools_rst.nc" + cable_user%c13o2_restart_in_luc = "restart/${mettype}_c13o2_luc_rst.nc" + cable_user%c13o2_restart_out_luc = "restart/${mettype}_c13o2_luc_rst.nc" + cable_user%CALL_BLAZE = .false. +EOF +if [[ ${call_pop} -eq 1 ]] ; then + sed -i -e "/cable_user%CALL_POP/s/=.*/= .true./" ${tmp}/sedtmp.${pid} +fi +if [[ ${coordinate_photosyn} -eq 1 ]] ; then + sed -i -e "/cable_user%coordinate_photosyn/s/=.*/= .true./" ${tmp}/sedtmp.${pid} +fi +if [[ ${acclimate_photosyn} -eq 1 ]] ; then + sed -i -e "/cable_user%acclimate_photosyn/s/=.*/= .true./" ${tmp}/sedtmp.${pid} +fi +if [[ ${explicit_gm} -eq 1 ]] ; then + sed -i -e "/cable_user%explicit_gm/s/=.*/= .true./" ${tmp}/sedtmp.${pid} +fi +if [[ ${call_blaze} -eq 1 ]] ; then + sed -i -e "/cable_user%CALL_BLAZE/s/=.*/= .true./" ${tmp}/sedtmp.${pid} +fi +if [[ ${doc13o2} -eq 1 ]] ; then + sed -i -e "/cable_user%c13o2/s/=.*/= .true./" ${tmp}/sedtmp.${pid} + if [[ ${c13o2_simple_disc} -eq 1 ]] ; then + sed -i -e "/cable_user%c13o2_simple_disc/s/=.*/= .true./" ${tmp}/sedtmp.${pid} + fi +fi +applysed ${tmp}/sedtmp.${pid} ${ndir}/cable.nml ${rdir}/cable_${experiment}.nml + + +# -------------------------------------------------------------------- +# Sequence +# + + +# -------------------------------------------------------------------- +# 1. Create climate restart file +if [[ ${doclimate} -eq 1 ]] ; then + echo "1. Create climate restart file" + rid="climate_restart" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "spinup" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + echo "L605" + # LUC + cp ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + # do not calculate 13C because there is no 13C in the climate restart file + cat > ${tmp}/sedtmp.${pid} << EOF + filename%restart_in = "" + cable_user%CLIMATE_fromZero = .true. + cable_user%YearStart = 1951 + cable_user%YearEnd = 1980 + icycle = 2 + spincasa = .false. + cable_user%CASA_fromZero = .true. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .true. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1980 + cable_user%limit_labile = .true. + casafile%cnpipool = "" + cable_user%POP_fromZero = .true. + cable_user%POP_out = "ini" + cable_user%POP_restart_in = "" + cable_user%POPLUC = .false. + cable_user%POPLUC_RunType = "static" + cable_user%c13o2 = .false. +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + echo "L632" + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + echo "L641" + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + imv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc + cp ${mettype}_climate_rst.nc ${ClimateFile} + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc + cd .. + cd ${pdir} +fi + +# -------------------------------------------------------------------- +# 2. First spinup phase from zero biomass +if [[ ${dofromzero} -eq 1 ]] ; then + echo "2. First spinup from zero biomass" + rid="zero_biomass" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "spinup" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + # LUC + cp ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable namelist + cat > ${tmp}/sedtmp.${pid} << EOF + filename%restart_in = "" + cable_user%CLIMATE_fromZero = .true. + cable_user%YearStart = 1951 + cable_user%YearEnd = 1980 + icycle = 2 + spincasa = .false. + cable_user%CASA_OUT_FREQ = "monthly" + cable_user%CASA_fromZero = .true. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .true. + output%averaging = "monthly" + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1960 + cable_user%limit_labile = .true. + casafile%cnpipool = "" + cable_user%POP_fromZero = .true. + cable_user%POP_out = "ini" + cable_user%POP_restart_in = "" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" + cable_user%c13o2_restart_in_flux = "" + cable_user%c13o2_restart_in_pools = "" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + imv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc ${mettype}_casa_rst.nc ${mettype}_cable_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc ${mettype}_out_casa_c13o2.nc + cd .. + cd ${pdir} +fi + + +# -------------------------------------------------------------------- +# 3. Biomass into quasi-equilibrium with restricted N and P pools +if [[ ${doequi1} -eq 1 ]] ; then + echo "3. Bring biomass into quasi-equilibrium with restricted N and P pools" + for ((iequi1=1; iequi1<=${nequi1}; iequi1++)) ; do + # 3a. 30 year run starting from restart files + echo " 3a. 30 year spinup from accumulated biomass; iequi1=${iequi1}/${nequi1}" + #rid="spinup_limit_labile" + rid="spinup_limit_labile${iequi1}" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "spinup" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + # LUC + cp ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable namelist + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = 1951 + cable_user%YearEnd = 1980 + icycle = 2 + spincasa = .false. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .true. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1960 + cable_user%limit_labile = .true. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc ${mettype}_casa_rst.nc ${mettype}_cable_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc ${mettype}_out_casa_c13o2.nc + cd .. + cd ${pdir} + + # + # 3b. analytic quasi-equilibrium of biomass pools + echo " 3b. Analytic solution of biomass pools" + rid="spin_casa_limit_labile${iequi1}" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "spinup" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + # LUC + cp ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = 1951 + cable_user%YearEnd = 1980 + icycle = 12 + spincasa = .true. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .true. + cable_user%CASA_DUMP_WRITE = .false. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1980 + cable_user%limit_labile = .true. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_casa_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc + if [[ ${dompi} -eq 0 ]] ; then # no output only restart if MPI + cd ../outputs + renameid ${rid} ${mettype}_out_casa.nc ${mettype}_out_casa_c13o2.nc + cd .. + fi + cd ${pdir} + done +fi + + +# -------------------------------------------------------------------- +# 4. Biomass into quasi-equilibrium without restricted N and P pools +if [[ ${doequi2} -eq 1 ]] ; then + echo "4. Bring biomass into quasi-equilibrium without restricted N and P pools" + for ((iequi2=1; iequi2<=${nequi2}; iequi2++)) ; do + # 4a. 30 year run starting from restart files + echo " 4a. 30 year spinup from accumulated biomass; iequi2=${iequi2}/${nequi2}" + + rid="spinup_nutrient_limited${iequi2}" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "spinup" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + # LUC + cp ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = 1951 + cable_user%YearEnd = 1980 + icycle = 2 + spincasa = .false. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .true. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1980 + cable_user%limit_labile = .false. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc ${mettype}_casa_rst.nc ${mettype}_cable_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc ${mettype}_out_casa_c13o2.nc + cd .. + cd ${pdir} + # + # 4b. analytic quasi-equilibrium of biomass pools + echo " 4b. Analytic solution of biomass pools" + rid="spin_casa_nutrient_limited${iequi2}" + + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "spinup" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + # LUC + cp ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = 1951 + cable_user%YearEnd = 1980 + icycle = 12 + spincasa = .true. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .true. + cable_user%CASA_DUMP_WRITE = .false. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1980 + cable_user%limit_labile = .false. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_casa_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc + if [[ ${dompi} -eq 0 ]] ; then # no output only restart if MPI + cd ../outputs + #renameid ${rid} ${mettype}_out_casa.nc ${mettype}_out_casa_c13o2.nc + cd .. + fi + cd ${pdir} + done +fi + +# -------------------------------------------------------------------- +# 5a. First dynamic land use +if [[ ${doiniluc} -eq 1 ]] ; then + echo "5a. First dynamic land use" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + YearStart=1580 + YearEnd=1699 + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "spinup" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + rid=${YearStart}_${YearEnd} + # LUC + cat > ${tmp}/sedtmp.${pid} << EOF + YearStart = ${YearStart} + YearEnd = ${YearEnd} +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = ${YearStart} + cable_user%YearEnd = ${YearEnd} + icycle = 12 + spincasa = .false. + cable_user%CASA_OUT_FREQ = "annually" + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .true. + cable_user%CASA_DUMP_WRITE = .false. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1980 + cable_user%limit_labile = .false. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "init" + cable_user%LUC_restart_in = "" + cable_user%c13o2_restart_in_luc = "" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_casa_rst.nc ${mettype}_LUC_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_pools_rst.nc ${mettype}_c13o2_luc_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_LUC.nc + cd .. + cd ${pdir} +fi + + +# -------------------------------------------------------------------- +# 5b. Second full dynamic spinup +if [[ ${doinidyn} -eq 1 ]] ; then + echo "5b. Full dynamic spinup" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + YearStart=1700 + YearEnd=1950 + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "premet" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + rid=${YearStart}_${YearEnd} + # LUC + cat > ${tmp}/sedtmp.${pid} << EOF + YearStart = 1900 + YearEnd = 1900 +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = ${YearStart} + cable_user%YearEnd = ${YearEnd} + icycle = 2 + spincasa = .false. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .false. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1980 + cable_user%limit_labile = .false. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc ${mettype}_casa_rst.nc ${mettype}_cable_rst.nc + copyid ${rid} ${mettype}_LUC_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc ${mettype}_c13o2_luc_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc ${mettype}_out_LUC.nc + renameid ${rid} ${mettype}_out_casa_c13o2.nc + cd .. + cd ${pdir} +fi + + +# -------------------------------------------------------------------- +# 6a. Final run - 1900 to GCMstart +if [[ ${dofinal1} -eq 1 ]] ; then + echo "6. Final run part 1" + # Met forcing + if [[ "${mettype}" == "bios" ]] ; then + YearStart=1951 + value=$(expr $GCMstart - 1) + YearEnd=${value} + cat > ${tmp}/sedtmp.${pid} << EOF + Run = "standard" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + rid=${YearStart}_${YearEnd} + # LUC + cat > ${tmp}/sedtmp.${pid} << EOF + YearStart = 1900 + YearEnd = 1900 +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = ${YearStart} + cable_user%YearEnd = ${YearEnd} + icycle = 2 + spincasa = .false. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .false. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1980 + cable_user%limit_labile = .false. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + rid=${YearStart}_${YearEnd}_${rcpd} + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc ${mettype}_casa_rst.nc ${mettype}_cable_rst.nc + copyid ${rid} ${mettype}_LUC_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc ${mettype}_c13o2_luc_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc ${mettype}_out_LUC.nc + renameid ${rid} ${mettype}_out_casa_c13o2.nc + cd .. + cd ${pdir} +fi + +#----- +#update the path to the CCAM derived meteorology +if [[ "${domain}" == "australia" ]] ; then + domain="aust_0.05_pts" +fi +if [[ "${mettype}" == "bios" ]] ; then + MetPath="/g/data/x45/BIOS3_forcing/CCAM/${GCM}/historical/${domain}/met/" # last slash is needed # need to update path if evaluation +fi +#----- + +# 6b. Final run - GCMstart to GCMswitch + + +if [[ ${dofinal2} -eq 1 ]] ; then + echo "6. Final run - part 2" + # check restart switch and copy restarts if required + if [[ "${restarttype}" == "AGCD_1950" ]] ; then + restart_path="/g/data/x45/BIOS3_forcing/CCAM/restart_files/${restarttype}/${domain}/" + cd ${restart_path} + cp *.nc ${rdir}/restart + fi + + + # Met forcing - update to use GCM information + if [[ "${mettype}" == "bios" ]] ; then + YearStart=${GCMstart} + value=$(expr $GCMsw - 1) + YearEnd=${value} + + # update files + cat > ${tmp}/sedtmp.${pid} << EOF + met_path = "${MetPath}" + rain_file = "pr_Adjust_${GCM}_historical_${YearStart}_${YearEnd}.bin" + swdown_file = "solar_Adjust_${GCM}_historical_${YearStart}_${YearEnd}.bin" + tairmax_file = "tasmax_Adjust_${GCM}_historical_${YearStart}_${YearEnd}.bin" + tairmin_file = "tasmin_Adjust_${GCM}_historical_${YearStart}_${YearEnd}.bin" + wind_file = "sfcWind_Adjust_${GCM}_historical_${YearStart}_${YearEnd}.bin" + vp0900_file = "vph09_Adjust_${GCM}_historical_${YearStart}_${YearEnd}.bin" + vp1500_file = "vph15_Adjust_${GCM}_historical_${YearStart}_${YearEnd}.bin" + co2_file = "0000_2014_CO2_time_series_ccam_historical.bin" + Run = "standard" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + fi + rid=${YearStart}_${YearEnd} + # LUC + cat > ${tmp}/sedtmp.${pid} << EOF + YearStart = 1900 + YearEnd = 1900 +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = ${YearStart} + cable_user%YearEnd = ${YearEnd} + icycle = 2 + spincasa = .false. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .false. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1960 + cable_user%limit_labile = .false. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc ${mettype}_casa_rst.nc ${mettype}_cable_rst.nc + copyid ${rid} ${mettype}_LUC_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc ${mettype}_c13o2_luc_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc ${mettype}_out_LUC.nc + renameid ${rid} ${mettype}_out_casa_c13o2.nc + cd .. + cd ${pdir} +fi + + + +# -------------------------------------------------------------------- +# 7. Future run +# update the path to the CCAM derived meteorology +if [[ "${domain}" == "australia" ]] ; then + domain="aust_0.05_pts" +fi +if [[ "${mettype}" == "bios" ]] ; then + MetPath="/g/data/x45/BIOS3_forcing/CCAM/${GCM}/${RCP}/${domain}/met/" # last slash is needed +fi + +if [[ (${dofuture} -eq 1) && ("${RCP}" != "historical") ]] ; then + echo "7. Future run" + rcpnd=$(echo ${RCP} | sed "s|\.||") + rcpd=$(echo ${RCP} | sed "s|\.|p|") + + if [[ "${restarttype}" == "GCM_2014" ]] ; then + restart_path="/g/data/x45/BIOS3_forcing/CCAM/restart_files/${GCM}/${domain}/" + cd ${restart_path} + cp *.nc ${rdir}/restart + fi + + # Met forcing + YearStart=${GCMsw} + YearEnd=${GCMend} + cat > ${tmp}/sedtmp.${pid} << EOF + met_path = "${MetPath}" + rain_file = "pr_Adjust_${GCM}_${RCP}_${GCMsw}_${GCMend}.bin" + swdown_file = "solar_Adjust_${GCM}_${RCP}_${GCMsw}_${GCMend}.bin" + tairmax_file = "tasmax_Adjust_${GCM}_${RCP}_${GCMsw}_${GCMend}.bin" + tairmin_file = "tasmin_Adjust_${GCM}_${RCP}_${GCMsw}_${GCMend}.bin" + wind_file = "sfcWind_Adjust_${GCM}_${RCP}_${GCMsw}_${GCMend}.bin" + vp0900_file = "vph09_Adjust_${GCM}_${RCP}_${GCMsw}_${GCMend}.bin" + vp1500_file = "vph15_Adjust_${GCM}_${RCP}_${GCMsw}_${GCMend}.bin" + Run = "standard" + RCP = "${RCP}" + CO2 = "varying" + co2_file = "2015_2500_CO2_time_series_ccam_${RCP}.bin" + NDEP = "varying" + NDEPfile = "${NdepPath}/RCP${rcpnd}/ndep_total_2000-2109_1.0x1.0_FD.nc" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml + rid=${YearStart}_${YearEnd}_${rcpd} + # LUC + cat > ${tmp}/sedtmp.${pid} << EOF + YearStart = 1900 + YearEnd = 1900 +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/LUC_${experiment}.nml ${rdir}/LUC.nml + # Cable + cat > ${tmp}/sedtmp.${pid} << EOF + cable_user%CLIMATE_fromZero = .false. + cable_user%YearStart = ${YearStart} + cable_user%YearEnd = ${YearEnd} + icycle = 2 + spincasa = .false. + cable_user%CASA_fromZero = .false. + cable_user%CASA_DUMP_READ = .false. + cable_user%CASA_DUMP_WRITE = .false. + cable_user%CASA_SPIN_STARTYEAR = 1951 + cable_user%CASA_SPIN_ENDYEAR = 1960 + cable_user%limit_labile = .false. + cable_user%POP_fromZero = .false. + cable_user%POP_out = "ini" + cable_user%POPLUC = .true. + cable_user%POPLUC_RunType = "static" +EOF + applysed ${tmp}/sedtmp.${pid} ${rdir}/cable_${experiment}.nml ${rdir}/cable.nml + # run model + cd ${rdir} + irm logs/log_cable.txt logs/log_out_cable.txt + if [[ ${dompi} -eq 1 ]] ; then + ${mpiexecdir}mpiexec -n ${nproc} ./${iexe} > logs/log_out_cable.txt + else + ./${iexe} > logs/log_out_cable.txt + fi + # save output + renameid ${rid} ${mettype}.nml LUC.nml cable.nml + mv *_${rid}.nml restart/ + cd logs + renameid ${rid} log_cable.txt log_out_cable.txt + cd ../restart + copyid ${rid} ${mettype}_climate_rst.nc ${mettype}_casa_rst.nc ${mettype}_cable_rst.nc pop_${mettype}_ini.nc + copyid ${rid} ${mettype}_c13o2_flux_rst.nc ${mettype}_c13o2_pools_rst.nc + cd ../outputs + renameid ${rid} ${mettype}_out_cable.nc ${mettype}_out_casa.nc + renameid ${rid} ${mettype}_out_casa_c13o2.nc + cd .. + cd ${pdir} +fi + +# -------------------------------------------------------------------- +# Finish +# +cd ${isdir} + +t2=$(date +%s) +dt=$((t2-t1)) +printf "\n" +if [[ ${dt} -lt 60 ]] ; then + printf "Finished at %s in %i seconds.\n" "$(date)" ${dt} +else + dm=$(echo "(${t2}-${t1})/60." | bc -l) + printf "Finished at %s in %.2f minutes.\n" "$(date)" ${dm} +fi + + +exit diff --git a/scripts/run_cable-pop.sh b/scripts/run_cable-pop.sh index dd86a3e0d..0d23155b0 100755 --- a/scripts/run_cable-pop.sh +++ b/scripts/run_cable-pop.sh @@ -1,36 +1,51 @@ #!/usr/bin/env bash -# -# Explor / Pearcey (launch with: sbatch --ignore-pbs) + +# Explor / Pearcey / Aurora # https://slurm.schedmd.com/sbatch.html +#SBATCH --ignore-pbs # Name - 8 letters and digits -#SBATCH -J x0003-s0 -#SBATCH -o %x-%j.out -#SBATCH -e %x-%j.out -# Explor partitions (sinfo): std (2x16, parallel), sky (2x16, parallel, AVX512), hf (2x4, serial), -# P100 (2x16, GPU), GTX (2x16, GPU), ivy (2x8, parallel), k20 (2x8, GPU) -#SBATCH -p std -# -N Nodes / -n tasks (mpiexec, srun, ...) / -c cpus_per_task (OpenMP, make-j, ...) -#SBATCH -N 1 -#SBATCH -n 32 -#SBATCH --ntasks-per-node=32 +#SBATCH --job-name=bios9 +#SBATCH --output=%x-%j.out +#SBATCH --error=%x-%j.out +# -N nodes / -n tasks (mpiexec, srun, ...) +# -c cpus_per_task (OpenMP, make -j, ...) +#SBATCH --nodes=1 +#SBATCH --ntasks=4 +#SBATCH --ntasks-per-node=4 # Check memory on *nix with /usr/bin/time -v ./prog # time (day-hh:mm:ss) / memory (optional, units K,M,G,T) -#SBATCH -t 03:59:59 -#SBATCH --mem=100G -# notify: Valid type values are NONE,BEGIN,END,FAIL,REQUEUE,ALL,STAGE_OUT,TIME_LIMIT,TIME_LIMIT_90/80/50,ARRAY_TASKS -#SBATCH --mail-type=FAIL,STAGE_OUT,TIME_LIMIT +#SBATCH --time=01:00:00 +#SBATCH --mem=4G +#SBATCH --mail-type=FAIL,STAGE_OUT,TIME_LIMIT,INVALID_DEPEND,END + +# section cuntz@explor +#SBATCH --account=oqx29 +# Explor partitions (sinfo): +# https://explor.univ-lorraine.fr/new_queue/ +# debug, std, gpu +#SBATCH --partition=std +# old hf partitions are cne[01-16] +# #SBATCH --constraint=HF +#SBATCH --exclude=cnf[01-08],cnh[01-02],cni[01-24],cnj[01-64],cnk[01-08] #SBATCH --mail-user=matthias.cuntz@inrae.fr -# + +# # section nieradzik@aurora +# #SBATCH --qos=test -t 15:00 +# #SBATCH --mail-user=lars.nieradzik@nateko.lu.se + # Gadi # https://opus.nci.org.au/display/Help/How+to+submit+a+job -#PBS -N x0001-s1 +#PBS -N mc_01 #PBS -P x45 # express / normal / copyq (2x24, cascadelake) -# expressbw / normalbw (2x14, broadwell) / normalsl (2x16, skylake)- ex-Raijin nodes #PBS -q normal -#PBS -l walltime=04:30:00 -#PBS -l mem=100GB -#PBS -l ncpus=24 +# Typical for global or Aust continent at 0.25, 192 GB memory and 48 cpus, +# maybe 12 hours walltime + +# Typical for small runs, fewer cpus than pixels +#PBS -l walltime=02:00:00 +#PBS -l mem=48GB +#PBS -l ncpus=4 # #PBS -l jobfs=1GB #PBS -l storage=gdata/x45 #PBS -l software=netCDF:MPI:Intel:GNU @@ -39,16 +54,24 @@ #PBS -j oe #PBS -S /bin/bash #PBS -M matthias.cuntz@inrae.fr +#PBS -m ae -# cuntz@explor, cuntz@mc16, cuntz@mcinra, moc801@gadi cuntz@gadi + +# cuntz@explor, cuntz@mcinra, moc801@gadi cuntz@gadi # kna016@pearcey knauer@pearcey, jk8585@gadi knauer@gadi -system=cuntz@mc16 + +# bri220@pearcey, pcb599@gadi briggs@gadi +# yc3714@gadi villalobos@gadi +# nieradzik@aurora +# inh599@gadi harman@gadi + +system=inh599@gadi # MPI run or single processor run # nproc should fit with job tasks -dompi=0 # 0: normal run: ./cable +dompi=1 # 0: normal run: ./cable # 1: MPI run: mpiexec -n ${nproc} ./cable_mpi -nproc=2 # Number of cores for MPI runs +nproc=4 # Number of cores for MPI runs # must be same as above: SBATCH -n nproc or PBS -l ncpus=nproc # -------------------------------------------------------------------- @@ -95,22 +118,23 @@ nproc=2 # Number of cores for MPI runs # but # namelistpath="$(dirname ${workpath})/namelists" # with -# workpath="/home/599/jk8585/CABLE_run/gm_acclim_coord/global_runs" +#workpath="/home/599/jk8585/CABLE_run/gm_acclim_coord/global_runs" # cablehome="/home/599/jk8585/CABLE_code" # -> changed to similar of ScriptsPath="$(dirname ${workpath})/scripts" # 3. Need plume.nml, bios.nml, gm_LUT_*.nc -# 4. output%grid = "mask" (in gm_acclim_coord) or "land" (default before) +# 4. output%grid = "mask" (in gm_acclim_coord) or "land" (default before) [PB:Always has to be "mask"] # 5. What should be for Run in bios.nml after 1. Climate restart? # 6. Why is YearEnd different for plume (1849) compared to cru (1699) in 5a. First dynamic land use? -# 7. Do we need chunking in 5a, 5b, 6, and 7? -# 8. Do we need cropping output to latlon region at the end: is this not in step 0 with ${doextractsite} -eq 1? +# 7. Do we need chunking in 5a, 5b, 6, and 7? [PB: unnecessary at this point, but possibly for 0.05degs] +# 8. Do we need cropping output to latlon region at the end: is this not in step 0 with ${doextractsite} -eq 1? [PB: Not needed for # BIOS + #ASKJK - changes in comparison to gm_acclim_coord # -------------------------------------------------------------------- # Sequence switches # -imeteo=2 # 0: Use global meteo, land use and mask +imeteo=0 # 0: Use global meteo, land use and mask # 1: Use local mask, but global meteo and land use (doextractsite=1) # 2: Use local meteo, land use and mask (doextractsite=2) # Step 0 @@ -119,7 +143,8 @@ doextractsite=0 # 0: Do not extract local meteo, land use nor mask # 1: Do extract only mask at specific site/region (imeteo=1) # 2: Do extract meteo, land use and mask at specific site/region (imeteo=2) # Does not work with randompoints /= 0 but with latlon - experiment=HarvardForest + + experiment=blaze02 randompoints=0 # <0: use -1*randompoints from file ${LandMaskFilePath}/${experiment}_points.csv if existing # 0: use latlon # >0: generate and use randompoints random grid points from GlobalLandMaskFile @@ -128,22 +153,24 @@ doextractsite=0 # 0: Do not extract local meteo, land use nor mask # latlon=-34.5,-33.5,149.5,156.5 # latlon=42.5,43.5,109.5,110.5 # latlon=-44.0,-10.0,110.0,155.0 # Australia + + # Step 1 doclimate=1 # 1/0: Do/Do not create climate restart file # Step 2 dofromzero=1 # 1/0: Do/Do not first spinup phase from zero biomass stocks # Step 3 doequi1=1 # 1/0: Do/Do not bring biomass stocks into quasi-equilibrium with restricted P and N pools -nequi1=1 # number of times to repeat steps in doequi1 +nequi1=4 # number of times to repeat steps in doequi1 # Step 4 -doequi2=1 # 1/0: Do/Do not bring biomass stocks into quasi-equilibrium with unrestricted P and N pools -nequi2=1 # number of times to repeat steps in doequi2 +doequi2=0 # 1/0: Do/Do not bring biomass stocks into quasi-equilibrium with unrestricted P and N pools +nequi2=4 # number of times to repeat steps in doequi2 # Step 5a -doiniluc=1 # 1/0: Do/Do not spinup with dynamic land use (5a) +doiniluc=0 # 1/0: Do/Do not spinup with dynamic land use (5a) # Step 5b -doinidyn=1 # 1/0: Do/Do not full dynamic spinup from 1700 to 1899 (5b) +doinidyn=0 # 1/0: Do/Do not full dynamic spinup from 1700 to 1899 (5b) # Step 6 -dofinal=1 # 1/0: Do/Do not final run from 1900 to 2017 +dofinal=0 # 1/0: Do/Do not final run from 1900 to 2017 # Step 7 dofuture=0 # 1/0: Do/Do not future runs (plume only) @@ -152,9 +179,10 @@ dofuture=0 # 1/0: Do/Do not future runs (plume only) # # MetType -mettype="cru" # "cru", "plume", "bios" -metmodel="hadgem2" # "hadgem2", "ipsl" (only used if mettype="plume") -RCP="hist" # "hist", "2.6", "4.5", "6.0", "8.5" (no future runs if RCP="hist") +mettype='bios' # 'cru', 'plume', 'bios' +degrees=0.05 # bios only: resolution of met and LUC (0.05 or 0.25) +metmodel='hadgem2' # 'hadgem2', 'ipsl' (only used if mettype='plume') +RCP='hist' # 'hist', '2.6', '4.5', '6.0', '8.5' (no future runs if RCP='hist') # Cable explicit_gm=0 # 1/0: explicit (finite) or implicit mesophyll conductance @@ -162,11 +190,13 @@ use_LUTgm=1 # 1/0: Do/Do not use lookup table for parameter conversion a Rubisco_params="Bernacchi_2002" # "Bernacchi_2002" or "Walker_2013" coordinate_photosyn=1 # 1/0: Do/Do not coordinate photosynthesis coord=F # T/F: version of photosyn. optimisation (optimised(F) or forced (T)) -acclimate_photosyn=0 # 1/0: Do/Do not acclimate photosynthesis +acclimate_photosyn=1 # 1/0: Do/Do not acclimate photosynthesis call_pop=1 # 1/0: Do/Do not use POP population dynamics model, coupled to CASA doc13o2=0 # 1/0: Do/Do not calculate 13C c13o2_simple_disc=0 # 1/0: simple or full 13C leaf discrimination +####### PB NOTE COMPARE SETUPS FROM HERE DOWN + # -------------------------------------------------------------------- # Setup # @@ -181,7 +211,6 @@ prog=$0 pprog=$(basename ${prog}) pdir=$(dirname ${prog}) tmp=${TMPDIR:-"/tmp"} - system=$(echo ${system} | tr A-Z a-z) sys=${system#*@} user=${system%@*} @@ -200,20 +229,20 @@ if [[ "${sys}" == "explor" ]] ; then # unset I_MPI_PMI_LIBRARY # export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${HOME}/local/lib:${HOME}/local/netcdf-fortran-4.4.4-ifort2018.0/lib # export mpiexecdir=/soft/env/soft/all/intel/2018.3/compilers_and_libraries_2018.5.274/linux/mpi/intel64/bin - # # INTEL / OpenMPI - load mpi module first, otherwise intel module will not pre-pend LD_LIBRARY_PATH - # module load openmpi/3.0.0/intel18 - # module load intel/2018.5 - # export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${HOME}/local/lib:${HOME}/local/netcdf-fortran-4.4.4-ifort2018.0/lib - # export mpiexecdir=/opt/soft/hf/openmpi-3.0.0-intel18/bin - # GNU / OpenMPI - module load gcc/6.3.0 - module load openmpi/3.0.1/gcc/6.3.0 - export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${HOME}/local/lib:${HOME}/local/netcdf-fortran-4.4.4-gfortran63/lib - export mpiexecdir=/opt/soft/hf/openmpi/3.0.1/gcc/6.3.0/bin + # INTEL / OpenMPI - load mpi module first, otherwise intel module will not pre-pend LD_LIBRARY_PATH + module load openmpi/3.0.0/intel18 + module load intel/2018.5 + export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:/home/oqx29/shared/local.save/lib:/home/oqx29/shared/local.save/netcdf-fortran-4.4.4-ifort2018.0/lib + export mpiexecdir=/opt/soft/hf/openmpi-3.0.0-intel18/bin + # # GNU / OpenMPI + # module load gcc/6.3.0 + # module load openmpi/3.0.1/gcc/6.3.0 + # export LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:${HOME}/local/lib:${HOME}/local/netcdf-fortran-4.4.4-gfortran63/lib + # export mpiexecdir=/opt/soft/hf/openmpi/3.0.1/gcc/6.3.0/bin if [[ ${doextractsite} -ge 1 ]] ; then module load python/intel/2019/3 ; fi elif [[ "${sys}" == "mc16" ]] ; then - # export mpiexecdir=/usr/local/openmpi-4.0.4-gfortran/bin - export mpiexecdir=/usr/local/openmpi-4.0.5-ifort/bin + # export mpiexecdir=/usr/local/openmpi-4.1.1-gfortran/bin + export mpiexecdir=/usr/local/openmpi-4.1.1-ifort/bin elif [[ "${sys}" == "mcinra" ]] ; then export mpiexecdir=/usr/local/openmpi-3.1.4-gfortran/bin # export mpiexecdir=/usr/local/openmpi-3.1.5-ifort/bin @@ -224,24 +253,38 @@ elif [[ "${sys}" == "pearcey" ]] ; then module add intel-cc/16.0.1.150 intel-fc/16.0.1.150 module unload intel-mpi/5.0.1.035 module add netcdf/4.3.3.1 openmpi/1.8.8 -elif [[ "${sys}" == "raijin" ]] ; then - module del intel-cc intel-fc - module add intel-cc/16.0.1.150 intel-fc/16.0.1.150 - module add netcdf/4.3.3.1 elif [[ "${sys}" == "gadi" ]] ; then pdir=${isdir} . /etc/bashrc module purge - module load intel-compiler/2019.5.281 - module load intel-mpi/2019.5.281 - module load netcdf/4.6.3 - # module load hdf5/1.10.5 + # module load intel-compiler/2019.5.281 + # module load intel-mpi/2019.5.281 + # module load netcdf/4.6.3 + # module load intel-compiler/2021.5.0 + # module load intel-mpi/2021.5.1 + # module load netcdf/4.8.0 + # # module load hdf5/1.10.5 + module load intel-compiler-llvm/2023.0.0 + module load intel-mpi/2021.8.0 + module load netcdf/4.9.2 if [[ ${doextractsite} -ge 1 ]] ; then module load python3/3.7.4 export PYTHONPATH=${PYTHONPATH}:/g/data/x45/python/lib/python3.7/site-packages fi if [[ ${randompoints} -eq 0 ]] ; then module load nco/4.9.2 ; fi # needed for cropping outputs export mpiexecdir=/apps/intel-mpi/2019.5.281/intel64/bin +elif [[ "${sys}" == "aurora" ]] ; then + pdir=${isdir} + module purge + module load intel/2020a + module load netCDF-Fortran/4.5.2 + if [[ ${doextractsite} -ge 1 ]] ; then + module load GCCcore/10.3.0 Python/3.9.5 + export PYTHONPATH=${PYTHONPATH} #CLN not copied!#:/g/data/x45/python/lib/python3.7/site-packages + echo 'Extraction not possible at the moment. Set Py-Path!' + exit -666 + fi + export mpiexecdir="" fi if [[ ! -z ${mpiexecdir} ]] ; then export mpiexecdir="${mpiexecdir}/" ; fi @@ -307,8 +350,11 @@ fi if [[ "${system}" == "cuntz@explor" ]] ; then # Run directory: runpath="${sitepath}/run_xxx" cablebase="/home/oqx29/zzy20/prog/cable" - sitepath="${cablebase}/runs/single_sites/${experiment}" + sitepath="${cablebase}/runs/bios9/${experiment}" cablehome="${cablebase}/branches/NESP2pt9_BLAZE" + cabledata="/home/oqx29/shared/cable" + metdata="/home/oqx29/shared/met_forcing" + workpath=${cablehome} # Cable executable if [[ ${dompi} -eq 1 ]] ; then exe="${cablehome}/offline/cable-mpi" @@ -316,16 +362,43 @@ if [[ "${system}" == "cuntz@explor" ]] ; then exe="${cablehome}/offline/cable" fi # CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) - aux="${cablebase}/CABLE-AUX" - # Global Mask - for create_landmask.py - GlobalLandMaskFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" - SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting - # # Global Mask - for global run - # GlobalLandMaskFile="/home/oqx29/zzy20/data/crujra/daily_1deg/glob_ipsl_1x1.nc" - # Global CRU - GlobalMetPath="/home/oqx29/zzy20/data/crujra/daily_1deg" - # Global LUC - GlobalTransitionFilePath="/home/oqx29/zzy20/data/LUH2_v3_1deg/" + aux="${cabledata}/CABLE-AUX" + # BLAZE directory + BlazeDataPath="${cabledata}/Data_BLAZE" + # Global MET, MASK, LUH + if [[ "${mettype}" == "cru" ]] ; then + # Global MASK + SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting + # Global MET + # GlobalLandMaskFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" + GlobalLandMaskFile="${cabledata}/ipbes/masks/glob_ipsl_1x1.nc" + # GlobalMetPath="${cabledata}/CRUJRA2022/daily_1deg" + GlobalMetPath="${metdata}/CRUJRA2022/daily_1deg" + # Global LUC + GlobalTransitionFilePath="${cabledata}/LUH2/GCB_2019/1deg/EXTRACT" + elif [[ "${mettype}" == "plume" ]] ; then + # Global MASK + SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting + # Global MET + # GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalLandMaskFile="${cabledata}/ipbes/masks/gridinfo_CSIRO_1x1.nc" + GlobalMetPath="${cabledata}/ipbes/${metmodel}/1deg" + # only in plume.nml + CO2Path="${cabledata}/ipbes/co2" + NdepPath="${cabledata}/ipbes/ndep" + # Global LUC + GlobalTransitionFilePath="${cabledata}/LUH2/GCB_2019/1deg/EXTRACT" + elif [[ "${mettype}" == "bios" ]] ; then + # Global MASK + SurfaceFile="${aux}/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc" # note that SurfaceFile does not need subsetting + # Global MET + GlobalLandMaskFile="${cabledata}/BIOS3_forcing/acttest9/acttest9" # no file extension + GlobalMetPath="${cabledata}/BIOS3_forcing/acttest9/met/" # last slash is needed + ParamPath="${cabledata}/BIOS3_forcing/acttest9/params/" # only in bios.nml + # Global LUC + GlobalTransitionFilePath="${cabledata}/LUH2/v3h/${degrees}deg_aust/EXTRACT" + fi + elif [[ "${system}" == "cuntz@mc16" || "${system}" == "cuntz@mcinra" ]] ; then # Run directory: runpath="${sitepath}/run_xxx" cablebase="/Users/cuntz/prog/vanessa/cable" @@ -345,11 +418,13 @@ elif [[ "${system}" == "cuntz@mc16" || "${system}" == "cuntz@mcinra" ]] ; then SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting GlobalMetPath= GlobalTransitionFilePath= + elif [[ "${system}" == "moc801@gadi" || "${system}" == "cuntz@gadi" ]] ; then # Run directory: runpath="${sitepath}/run_xxx" # sitepath="/home/801/moc801/prog/cable/runs/single_sites/${experiment}" sitepath="/scratch/x45/moc801/cable/c13" cablehome="/home/801/moc801/prog/cable/branches/NESP2pt9_BLAZE" + workpath=${cablehome} # Cable executable if [[ ${dompi} -eq 1 ]] ; then exe="${cablehome}/offline/cable-mpi" @@ -358,13 +433,41 @@ elif [[ "${system}" == "moc801@gadi" || "${system}" == "cuntz@gadi" ]] ; then fi # CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) aux="/g/data/x45/CABLE-AUX" - # Global Mask - # GlobalLandMaskFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" - GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" - # Global CRU - GlobalMetPath="/g/data/x45/crujra/daily_1deg" - # Global LUC - GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2018/1deg/EXTRACT" + # BLAZE directory + BlazeDataPath="/g/data/x45/Data_BLAZE" + # Global MET, MASK, LUH + if [[ "${mettype}" == "cru" ]] ; then + # Global MASK + SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting + # Global MET + # GlobalLandMaskFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" + GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalMetPath="/g/data/x45/CRUJRA2020/daily_1deg" + # Global LUC + GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2019/1deg/EXTRACT" + elif [[ "${mettype}" == "plume" ]] ; then + # Global MASK + SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting + # Global MET + # GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalLandMaskFile="/g/data/x45/ipbes/masks/gridinfo_CSIRO_1x1.nc" + GlobalMetPath="/g/data/x45/ipbes/${metmodel}/1deg" + # only in plume.nml + CO2Path="/g/data/x45/ipbes/co2" + NdepPath="/g/data/x45/ipbes/ndep" + # Global LUC + GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2019/1deg/EXTRACT" + elif [[ "${mettype}" == "bios" ]] ; then + # Global MASK + SurfaceFile="${aux}/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc" # note that SurfaceFile does not need subsetting + # Global MET + GlobalLandMaskFile="/g/data/x45/BIOS3_forcing/acttest9/acttest9" # no file extension + GlobalMetPath="/g/data/x45/BIOS3_forcing/acttest9/met/" # last slash is needed + ParamPath="/g/data/x45/BIOS3_forcing/acttest9/params/" # only in bios.nml + # Global LUC + GlobalTransitionFilePath="/g/data/x45/LUH2/v3h/${degrees}deg_aust/EXTRACT" + fi + elif [[ "${system}" == "kna016@pearcey" || "${system}" == "knauer@pearcey" ]] ; then # Run directory: runpath="${sitepath}/run_xxx" sitepath="/OSM/CBR/OA_GLOBALCABLE/work/Juergen/CABLE_run/parallel_runs/${experiment}" @@ -384,6 +487,7 @@ elif [[ "${system}" == "kna016@pearcey" || "${system}" == "knauer@pearcey" ]] ; GlobalMetPath="/OSM/CBR/OA_GLOBALCABLE/work/CRU-JRA55/crujra/daily_1deg" # Global LUC GlobalTransitionFilePath="/OSM/CBR/OA_GLOBALCABLE/work/LUH2/v3/1deg" + elif [[ "${system}" == "jk8585@gadi" || "${system}" == "knauer@gadi" ]] ; then # Run directory: runpath="${sitepath}/run" sitepath="/g/data/x45/jk8585/global_runs/gm_acclim_coord/${experiment}" @@ -411,40 +515,222 @@ elif [[ "${system}" == "jk8585@gadi" || "${system}" == "knauer@gadi" ]] ; then CO2Path="/g/data/x45/ipbes/co2" NdepPath="/g/data/x45/ipbes/ndep" elif [[ "${mettype}" == "bios" ]] ; then + GlobalLandMaskFile="/g/data/x45/BIOS3_forcing/acttest9/acttest9" # no file extension + GlobalMetPath="/g/data/x45/BIOS3_forcing/acttest9/met/" # last slash is needed + ParamPath="/g/data/x45/BIOS3_forcing/acttest9/params/" # only in bios.nml + GlobalTransitionFilePath="/g/data/x45/LUH2/v3h/${degrees}deg_aust/EXTRACT" + fi + # Global LUC + GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2019/1deg/EXTRACT" + +elif [[ "${system}" == "yc3714@gadi" || "${system}" == "villalobos@gadi" ]] ; then + # Run directory: runpath="${sitepath}/run" + sitepath="/g/data/x45/BIOS3_output/${experiment}" # Results + workpath="/home/563/yc3714/CSIRO/CABLE_run/BIOS3_blaze" # run directory + cablehome="/home/563/yc3714/CSIRO/CABLE_code/9011/NESP2pt9_BLAZE" # model home + # Cable executable + if [[ ${dompi} -eq 1 ]] ; then + exe="${cablehome}/offline/cable-mpi" + else + exe="${cablehome}/offline/cable" + fi + # CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) + aux="/g/data/x45/CABLE-AUX" + # Global Mask + + SurfaceFile="${aux}/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc" # note that SurfaceFile does not need subsetting + + # Global Met + if [[ "${mettype}" == "cru" ]] ; then + GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalMetPath="/g/data/x45/CRUJRA2020/daily_1deg" + elif [[ "${mettype}" == "plume" ]] ; then + GlobalLandMaskFile="/g/data/x45/ipbes/masks/gridinfo_CSIRO_1x1.nc" + GlobalMetPath="/g/data/x45/ipbes/${metmodel}/1deg" + # only in plume.nml + CO2Path="/g/data/x45/ipbes/co2" + NdepPath="/g/data/x45/ipbes/ndep" + elif [[ "${mettype}" == "bios" ]] ; then + GlobalLandMaskFile="/g/data/x45/BIOS3_forcing/acttest9/acttest9" # no file extension + GlobalMetPath="/g/data/x45/BIOS3_forcing/acttest9/met/" # last slash is needed + ParamPath="/g/data/x45/BIOS3_forcing/acttest9/params/" # only in bios.nml + GlobalTransitionFilePath="/g/data/x45/LUH2/v3h/${degrees}deg_aust/EXTRACT" + fi + # Global LUC + # GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2019/1deg/EXTRACT" + +elif [[ "${system}" == "inh599@gadi" || "${system}" == "harman@gadi" ]] ; then + # Run directory: runpath="${sitepath}/run" + #sitepath="/g/data/x45/BIOS3_output/${experiment}" # Results + sitepath="/scratch/x45/inh599/BIOStests/${experiment}" # Results + workpath="/home/599/inh599/JAC/CABLE/BLAZEruns" # run directory + cablehome="/home/599/inh599/JAC/CABLE/BLAZE_9184" # model home + # Cable executable + if [[ ${dompi} -eq 1 ]] ; then + exe="${cablehome}/offline/cable-mpi" + else + exe="${cablehome}/offline/cable" + fi + # CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) + aux="/g/data/x45/CABLE-AUX" + # Global Mask + SurfaceFile="${aux}/offline/gridinfo_CSIRO_CRU05x05_4tiles.nc" # note that SurfaceFile does not need subsetting + # Global Met + if [[ "${mettype}" == "cru" ]] ; then + GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalMetPath="/g/data/x45/CRUJRA2020/daily_1deg" + elif [[ "${mettype}" == "plume" ]] ; then + GlobalLandMaskFile="/g/data/x45/ipbes/masks/gridinfo_CSIRO_1x1.nc" + GlobalMetPath="/g/data/x45/ipbes/${metmodel}/1deg" + # only in plume.nml + CO2Path="/g/data/x45/ipbes/co2" + NdepPath="/g/data/x45/ipbes/ndep" + elif [[ "${mettype}" == "bios" ]] ; then + GlobalLandMaskFile="/g/data/x45/BIOS3_forcing/acttest9/acttest9" # no file extension + GlobalMetPath="/g/data/x45/BIOS3_forcing/acttest9/met/" # last slash is needed + ParamPath="/g/data/x45/BIOS3_forcing/acttest9/params/" # only in bios.nml + GlobalTransitionFilePath="/g/data/x45/LUH2/v3h/${degrees}deg_aust/EXTRACT" + fi + # Global LUC + # GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2019/1deg/EXTRACT" + +elif [[ "${system}" == "bri220@pearcey" || "${system}" == "briggs@pearcey" ]] ; then + # Run directory: runpath="${sitepath}/run_xxx" + sitepath="/OSM/CBR/OA_GLOBALCABLE/work/Peter/CABLE_run/parallel_runs/${experiment}" + cablehome="/OSM/CBR/OA_GLOBALCABLE/work/Peter/CABLE_code" + # Cable executable + if [[ ${dompi} -eq 1 ]] ; then + exe="${cablehome}/NESP2pt9_BLAZE/offline/cable-mpi" + else + exe="${cablehome}/NESP2pt9_BLAZE/offline/cable" + fi + # CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) + aux="/OSM/CBR/OA_GLOBALCABLE/work/Vanessa/CABLE-AUX" + # Global Mask + GlobalLandMaskFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" + # Global CRU + GlobalMetPath="/OSM/CBR/OA_GLOBALCABLE/work/CRU-JRA55/crujra/daily_1deg" + # Global LUC + GlobalTransitionFilePath="/OSM/CBR/OA_GLOBALCABLE/work/LUH2/v3/1deg" + +elif [[ "${system}" == "pcb599@gadi" || "${system}" == "briggs@gadi" ]] ; then + # Run directory: runpath="${sitepath}/run_xxx" + sitepath="/g/data/x45/BIOS3_output/${experiment}" + workpath="/home/599/pcb599/CABLE_run/BIOS3/run" + cablehome="/home/599/pcb599/CABLE_code/NESP2pt9_BLAZE" + # Cable executable + if [[ ${dompi} -eq 1 ]] ; then + exe="${cablehome}/offline/cable-mpi" + else + exe="${cablehome}/offline/cable" + + fi + # CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) + aux="/g/data/x45/CABLE-AUX" + # Global Mask + GlobalLandMaskFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" + SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting + # Global LUC + GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2019/1deg/EXTRACT" + # Global Met + if [[ "${mettype}" == 'plume' ]] ; then + GlobalMetPath="/g/data/x45/ipbes/${metmodel}/1deg" + CO2Path="/g/data/x45/ipbes/co2" + NdepPath="/g/data/x45/ipbes/ndep" + GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalLandMaskFile="/g/data/x45/ipbes/masks/gridinfo_CSIRO_1x1.nc" + elif [[ "${mettype}" == 'bios' ]] ; then GlobalLandMaskFile="/g/data/x45/BIOS3_forcing/acttest9/acttest9" # no file extension GlobalMetPath="/g/data/x45/BIOS3_forcing/acttest9/met/" # last slash is needed - # only in bios.nml ParamPath="/g/data/x45/BIOS3_forcing/acttest9/params/" + GlobalTransitionFilePath="/g/data/x45/LUH2/v3h/${degrees}deg_aust/EXTRACT" + elif [[ "${mettype}" == 'cru' ]] ; then + GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalMetPath="/g/data/x45/CRUJRA2020/daily_1deg" fi + +elif [[ "${system}" == "nieradzik@aurora" ]] ; then + # Run directory: runpath="${sitepath}/run_xxx" + sitepath="/home/x_larni/STOREDIR/RUNDIR/CABLE/${experiment}" + workpath="/home/x_larni/SRC/CABLE/NESP2pt9_BLAZE" + cablehome="/home/x_larni/SRC/CABLE/NESP2pt9_BLAZE" + # Cable executable + if [[ ${dompi} -eq 1 ]] ; then + exe="${cablehome}/offline/cable-mpi" + else + exe="${cablehome}/offline/cable" + fi + # CABLE-AUX directory (uses offline/gridinfo_CSIRO_1x1.nc and offline/modis_phenology_csiro.txt) + aux="/home/x_larni/STOREDIR/DATA/CABLE-AUX" + # Global Mask + GlobalLandMaskFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" + SurfaceFile="${aux}/offline/gridinfo_CSIRO_1x1.nc" # note that SurfaceFile does not need subsetting # Global LUC GlobalTransitionFilePath="/g/data/x45/LUH2/GCB_2019/1deg/EXTRACT" + # Global Met + if [[ "${mettype}" == 'plume' ]] ; then + GlobalMetPath="/g/data/x45/ipbes/${metmodel}/1deg" + CO2Path="/g/data/x45/ipbes/co2" + NdepPath="/g/data/x45/ipbes/ndep" + GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalLandMaskFile="/g/data/x45/ipbes/masks/gridinfo_CSIRO_1x1.nc" + elif [[ "${mettype}" == 'bios' ]] ; then + GlobalLandMaskFile="/home/x_larni/STOREDIR/DATA/CABLE_INPUT/acttest9/acttest9" # no file extension + GlobalMetPath="/home/x_larni/STOREDIR/DATA/CABLE_INPUT/acttest9/met/" # last slash is needed + ParamPath="/home/x_larni/STOREDIR/DATA/CABLE_INPUT/acttest9/params/" + GlobalTransitionFilePath="/home/x_larni/STOREDIR/DATA/CABLE_INPUT/LUH2/v3h/${degrees}deg_aust/EXTRACT" + elif [[ "${mettype}" == 'cru' ]] ; then + GlobalLandMaskFile="/g/data/x45/ipbes/masks/glob_ipsl_1x1.nc" + GlobalMetPath="/g/data/x45/CRUJRA2020/daily_1deg" + fi + else echo "System not known." exit 1 fi # Run directory -runpath="${sitepath}/run_20210204" -# runpath="${sitepath}/run" +#runpath="${sitepath}/run_20210618" +runpath="${sitepath}/run" # Cable parameters -namelistpath="${cablehome}/namelists" -filename_veg="${cablehome}/params/def_veg_params.txt" -filename_soil="${cablehome}/params/def_soil_params.txt" -casafile_cnpbiome="${cablehome}/params/pftlookup.csv" +if [[ "${mettype}" == 'bios' ]] ; then + namelistpath="${workpath}/namelists_bios" + filename_veg="${workpath}/params_bios/def_veg_params.txt" + filename_soil="${workpath}/params_bios/def_soil_params.txt" + casafile_cnpbiome="${workpath}/params_bios/pftlookup.csv" +else + namelistpath="${workpath}/namelists" + filename_veg="${workpath}/params/def_veg_params.txt" + filename_soil="${workpath}/params/def_soil_params.txt" + casafile_cnpbiome="${workpath}/params/pftlookup.csv" +fi # Other scripts ScriptsPath="${cablehome}/scripts" # Mask LandMaskFile="${sitepath}/mask/${experiment}_landmask.nc" -# CRU -MetPath="${sitepath}/met/cru_jra_1deg" -ClimateFile="${sitepath}/mask/cru_climate_rst.nc" -if [[ "${sys}" == "gadi" ]]; then - if [[ (${doclimate} -eq 0) && (! -f ${ClimateFile}) ]] ; then - ClimateFile="/g/data/x45/ipbes/cable_climate/ipsl_climate_rst_glob_1deg.nc" +# Met +if [[ "${mettype}" == 'bios' ]] ; then + MetPath="${sitepath}/met/bios_${degrees}deg" + ClimateFile="${sitepath}/mask/bios_climate_rst.nc" + if [[ "${sys}" == "gadi" ]]; then + if [[ (${doclimate} -eq 0) && (! -f ${ClimateFile}) ]] ; then + ClimateFile="/g/data/x45/BIOS3_output/bio_climate_acttest9/bios_climate_rst.nc" + fi + fi +else + MetPath="${sitepath}/met/cru_jra_1deg" + ClimateFile="${sitepath}/mask/cru_climate_rst.nc" + if [[ "${sys}" == "gadi" ]]; then + if [[ (${doclimate} -eq 0) && (! -f ${ClimateFile}) ]] ; then + ClimateFile="/g/data/x45/ipbes/cable_climate/ipsl_climate_rst_glob_1deg.nc" + fi fi fi # LUC -TransitionFilePath="${sitepath}/LUH2/v3/1deg" +#TransitionFilePath="${sitepath}/LUH2/v3/1deg" +TransitionFilePath="/g/data/x45/LUH2/v3h/${degrees}deg_aust/EXTRACT" +#TransitionFilePath="/home/x_larni/STOREDIR/DATA/CABLE_INPUT/LUH2/v3h/${degrees}deg_aust/EXTRACT" # LN + # gm lookup tables gm_lut_bernacchi_2002="${cablehome}/params/gm_LUT_351x3601x7_1pt8245_Bernacchi2002.nc" gm_lut_walker_2013="${cablehome}/params/gm_LUT_351x3601x7_1pt8245_Walker2013.nc" @@ -814,6 +1100,19 @@ cat > ${tmp}/sedtmp.${pid} << EOF EOF applysed ${tmp}/sedtmp.${pid} ${ndir}/LUC.nml ${rdir}/LUC_${experiment}.nml +# Blaze namelist !CLN CHECK + +cat > ${tmp}/sedtmp.${pid} << EOF + blazeTStep = "annually" ! Call frequency ("daily", "monthly", "annually") + BurnedAreaSource = "SIMFIRE" ! Burnt Area ("PRESCRIBED", "SIMFIRE", "GFED4") + BurnedAreaFile = "${BlazeDataPath}/BA_Aust_2001-2019.nc" ! used for Prescribed fires !CLN not available for now! + SIMFIRE_REGION = "ANZ" ! ("ANZ", "EUROPE", "GLOBAL") + HydePath = "${BlazeDataPath}/HYDE3.1" ! Path to Hyde3.1 population density data + BurnedAreaClimatologyFile = "${BlazeDataPath}/simfire_monthly_ba.nc" ! BA climatology file (needed when blazeTStep!="annually") +EOF +applysed ${tmp}/sedtmp.${pid} ${ndir}/blaze.nml ${rdir}/blaze_${experiment}.nml +cp ${rdir}/blaze_${experiment}.nml ${rdir}/blaze.nml + # global Cable namelist cat > ${tmp}/sedtmp.${pid} << EOF filename%met = "${mettype}" @@ -857,6 +1156,7 @@ cat > ${tmp}/sedtmp.${pid} << EOF cable_user%c13o2_restart_out_pools = "restart/${mettype}_c13o2_pools_rst.nc" cable_user%c13o2_restart_in_luc = "restart/${mettype}_c13o2_luc_rst.nc" cable_user%c13o2_restart_out_luc = "restart/${mettype}_c13o2_luc_rst.nc" + cable_user%CALL_BLAZE = .TRUE. EOF if [[ ${call_pop} -eq 1 ]] ; then sed -i -e "/cable_user%CALL_POP/s/=.*/= .true./" ${tmp}/sedtmp.${pid} @@ -912,14 +1212,14 @@ EOF filename%restart_in = "" cable_user%CLIMATE_fromZero = .true. cable_user%YearStart = 1860 - cable_user%YearEnd = 1861 + cable_user%YearEnd = 1889 icycle = 2 spincasa = .false. cable_user%CASA_fromZero = .true. cable_user%CASA_DUMP_READ = .false. cable_user%CASA_DUMP_WRITE = .true. cable_user%CASA_SPIN_STARTYEAR = 1860 - cable_user%CASA_SPIN_ENDYEAR = 1861 + cable_user%CASA_SPIN_ENDYEAR = 1869 cable_user%limit_labile = .true. casafile%cnpipool = "" cable_user%POP_fromZero = .true. @@ -983,7 +1283,7 @@ EOF filename%restart_in = "" cable_user%CLIMATE_fromZero = .true. cable_user%YearStart = 1860 - cable_user%YearEnd = 1861 + cable_user%YearEnd = 1889 icycle = 2 spincasa = .false. cable_user%CASA_OUT_FREQ = "monthly" @@ -992,7 +1292,7 @@ EOF cable_user%CASA_DUMP_WRITE = .true. output%averaging = "all" cable_user%CASA_SPIN_STARTYEAR = 1860 - cable_user%CASA_SPIN_ENDYEAR = 1861 + cable_user%CASA_SPIN_ENDYEAR = 1869 cable_user%limit_labile = .true. casafile%cnpipool = "" cable_user%POP_fromZero = .true. @@ -1034,8 +1334,8 @@ if [[ ${doequi1} -eq 1 ]] ; then for ((iequi1=1; iequi1<=${nequi1}; iequi1++)) ; do # 3a. 30 year run starting from restart files echo " 3a. 30 year spinup from accumulated biomass; iequi1=${iequi1}/${nequi1}" - rid="spinup_limit_labile" - # rid="spinup_limit_labile${iequi}" + #rid="spinup_limit_labile" + rid="spinup_limit_labile${iequi1}" # Met forcing if [[ "${mettype}" == "cru" ]] ; then cp ${rdir}/cru_${experiment}.nml ${rdir}/cru.nml @@ -1057,14 +1357,14 @@ EOF cat > ${tmp}/sedtmp.${pid} << EOF cable_user%CLIMATE_fromZero = .false. cable_user%YearStart = 1840 - cable_user%YearEnd = 1841 + cable_user%YearEnd = 1859 icycle = 2 spincasa = .false. cable_user%CASA_fromZero = .false. cable_user%CASA_DUMP_READ = .false. cable_user%CASA_DUMP_WRITE = .true. cable_user%CASA_SPIN_STARTYEAR = 1860 - cable_user%CASA_SPIN_ENDYEAR = 1861 + cable_user%CASA_SPIN_ENDYEAR = 1869 cable_user%limit_labile = .true. cable_user%POP_fromZero = .false. cable_user%POP_out = "ini" @@ -1095,8 +1395,8 @@ EOF # # 3b. analytic quasi-equilibrium of biomass pools echo " 3b. Analytic solution of biomass pools" - rid="spinup_analytic_limit_labile" - # rid="spin_casa_limit_labile${iequi}" + #rid="spinup_analytic_limit_labile" + rid="spin_casa_limit_labile${iequi1}" # Met forcing if [[ "${mettype}" == "cru" ]] ; then cp ${rdir}/cru_${experiment}.nml ${rdir}/cru.nml @@ -1118,14 +1418,14 @@ EOF cat > ${tmp}/sedtmp.${pid} << EOF cable_user%CLIMATE_fromZero = .false. cable_user%YearStart = 1840 - cable_user%YearEnd = 1841 + cable_user%YearEnd = 1859 icycle = 12 spincasa = .true. cable_user%CASA_fromZero = .false. cable_user%CASA_DUMP_READ = .true. cable_user%CASA_DUMP_WRITE = .false. cable_user%CASA_SPIN_STARTYEAR = 1840 - cable_user%CASA_SPIN_ENDYEAR = 1841 + cable_user%CASA_SPIN_ENDYEAR = 1859 cable_user%limit_labile = .true. cable_user%POP_fromZero = .false. cable_user%POP_out = "ini" @@ -1166,8 +1466,8 @@ if [[ ${doequi2} -eq 1 ]] ; then for ((iequi2=1; iequi2<=${nequi2}; iequi2++)) ; do # 4a. 30 year run starting from restart files echo " 4a. 30 year spinup from accumulated biomass; iequi2=${iequi2}/${nequi2}" - rid="spinup" - # rid="spinup${iequi}" + #rid="spinup" + rid="spinup_nutrient_limited${iequi2}" # Met forcing if [[ "${mettype}" == "cru" ]] ; then cp ${rdir}/cru_${experiment}.nml ${rdir}/cru.nml @@ -1189,14 +1489,14 @@ EOF cat > ${tmp}/sedtmp.${pid} << EOF cable_user%CLIMATE_fromZero = .false. cable_user%YearStart = 1840 - cable_user%YearEnd = 1841 + cable_user%YearEnd = 1859 icycle = 2 spincasa = .false. cable_user%CASA_fromZero = .false. cable_user%CASA_DUMP_READ = .false. cable_user%CASA_DUMP_WRITE = .true. cable_user%CASA_SPIN_STARTYEAR = 1860 - cable_user%CASA_SPIN_ENDYEAR = 1861 + cable_user%CASA_SPIN_ENDYEAR = 1869 cable_user%limit_labile = .false. cable_user%POP_fromZero = .false. cable_user%POP_out = "ini" @@ -1227,8 +1527,8 @@ EOF # # 4b. analytic quasi-equilibrium of biomass pools echo " 4b. Analytic solution of biomass pools" - rid="spinup_analytic" - # rid="spin_casa${iequi}" + #rid="spinup_analytic" + rid="spin_casa_nutrient_limited${iequi2}" # Met forcing if [[ "${mettype}" == "cru" ]] ; then cp ${rdir}/cru_${experiment}.nml ${rdir}/cru.nml @@ -1250,14 +1550,14 @@ EOF cat > ${tmp}/sedtmp.${pid} << EOF cable_user%CLIMATE_fromZero = .false. cable_user%YearStart = 1840 - cable_user%YearEnd = 1841 + cable_user%YearEnd = 1859 icycle = 12 spincasa = .true. cable_user%CASA_fromZero = .false. cable_user%CASA_DUMP_READ = .true. cable_user%CASA_DUMP_WRITE = .false. cable_user%CASA_SPIN_STARTYEAR = 1840 - cable_user%CASA_SPIN_ENDYEAR = 1841 + cable_user%CASA_SPIN_ENDYEAR = 1859 cable_user%limit_labile = .false. cable_user%POP_fromZero = .false. cable_user%POP_out = "ini" @@ -1334,7 +1634,7 @@ EOF cable_user%CASA_DUMP_READ = .true. cable_user%CASA_DUMP_WRITE = .false. cable_user%CASA_SPIN_STARTYEAR = 1840 - cable_user%CASA_SPIN_ENDYEAR = 1841 + cable_user%CASA_SPIN_ENDYEAR = 1859 cable_user%limit_labile = .false. cable_user%POP_fromZero = .false. cable_user%POP_out = "ini" @@ -1392,7 +1692,7 @@ EOF YearStart=1700 YearEnd=1899 cat > ${tmp}/sedtmp.${pid} << EOF - Run = "spinup" + Run = "premet" EOF applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml fi @@ -1411,14 +1711,14 @@ EOF cat > ${tmp}/sedtmp.${pid} << EOF cable_user%CLIMATE_fromZero = .false. cable_user%YearStart = ${YearStart} - cable_user%YearEnd = $(( ${YearStart} + 1 )) + cable_user%YearEnd = ${YearEnd} icycle = 2 spincasa = .false. cable_user%CASA_fromZero = .false. cable_user%CASA_DUMP_READ = .false. cable_user%CASA_DUMP_WRITE = .false. cable_user%CASA_SPIN_STARTYEAR = 1850 - cable_user%CASA_SPIN_ENDYEAR = 1851 + cable_user%CASA_SPIN_ENDYEAR = 1859 cable_user%limit_labile = .false. cable_user%POP_fromZero = .false. cable_user%POP_out = "ini" @@ -1474,9 +1774,9 @@ EOF applysed ${tmp}/sedtmp.${pid} ${rdir}/plume_${experiment}.nml ${rdir}/plume.nml elif [[ "${mettype}" == "bios" ]] ; then YearStart=1900 - YearEnd=2017 + YearEnd=2019 cat > ${tmp}/sedtmp.${pid} << EOF - Run = "spinup" + Run = "standard" EOF applysed ${tmp}/sedtmp.${pid} ${rdir}/bios_${experiment}.nml ${rdir}/bios.nml fi @@ -1495,15 +1795,15 @@ EOF #MCTEST cat > ${tmp}/sedtmp.${pid} << EOF cable_user%CLIMATE_fromZero = .false. - cable_user%YearStart = $(( ${YearStart} + 1 )) - cable_user%YearEnd = $(( ${YearStart} + 2 )) + cable_user%YearStart = ${YearStart} + cable_user%YearEnd = ${YearEnd} icycle = 2 spincasa = .false. cable_user%CASA_fromZero = .false. cable_user%CASA_DUMP_READ = .false. cable_user%CASA_DUMP_WRITE = .false. cable_user%CASA_SPIN_STARTYEAR = 1850 - cable_user%CASA_SPIN_ENDYEAR = 1851 + cable_user%CASA_SPIN_ENDYEAR = 1859 cable_user%limit_labile = .false. cable_user%POP_fromZero = .false. cable_user%POP_out = "ini"