From e1b3bf89a03ddfaf7e8ba57a3f194cfe255f2e62 Mon Sep 17 00:00:00 2001 From: Marcos Longo <mdplongo@gmail.com> Date: Tue, 3 May 2022 13:44:44 -0700 Subject: [PATCH] Make parameter woody integer. Parameter prt_params%woody is used to decide whether a PFT is woody or not. Instead of converting it to integer whenever a logical test is to be performed, I turned the parameter integer. --- biogeochem/EDCanopyStructureMod.F90 | 4 ++-- biogeochem/EDCohortDynamicsMod.F90 | 2 +- biogeochem/EDLoggingMortalityMod.F90 | 4 ++-- biogeochem/EDPatchDynamicsMod.F90 | 8 ++++---- biogeochem/FatesAllometryMod.F90 | 4 ++-- fire/SFMainMod.F90 | 14 +++++++------- main/FatesHistoryInterfaceMod.F90 | 2 +- parteh/PRTParametersMod.F90 | 2 +- parteh/PRTParamsFATESMod.F90 | 16 ++++++++++------ 9 files changed, 30 insertions(+), 26 deletions(-) diff --git a/biogeochem/EDCanopyStructureMod.F90 b/biogeochem/EDCanopyStructureMod.F90 index c12ec2edda..5bd85cb5a1 100644 --- a/biogeochem/EDCanopyStructureMod.F90 +++ b/biogeochem/EDCanopyStructureMod.F90 @@ -1235,7 +1235,7 @@ subroutine canopy_spread( currentSite ) do while (associated(currentCohort)) call carea_allom(currentCohort%dbh,currentCohort%n, & currentSite%spread,currentCohort%pft,currentCohort%c_area) - if( ( int(prt_params%woody(currentCohort%pft)) .eq. itrue ) .and. & + if( ( prt_params%woody(currentCohort%pft) .eq. itrue ) .and. & (currentCohort%canopy_layer .eq. 1 ) ) then sitelevel_canopyarea = sitelevel_canopyarea + currentCohort%c_area endif @@ -1346,7 +1346,7 @@ subroutine canopy_summarization( nsites, sites, bc_in ) if(currentCohort%canopy_layer==1)then currentPatch%total_canopy_area = currentPatch%total_canopy_area + currentCohort%c_area - if( int(prt_params%woody(ft))==itrue)then + if( prt_params%woody(ft) == itrue)then currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area endif endif diff --git a/biogeochem/EDCohortDynamicsMod.F90 b/biogeochem/EDCohortDynamicsMod.F90 index 4318ee469f..8c6f589c04 100644 --- a/biogeochem/EDCohortDynamicsMod.F90 +++ b/biogeochem/EDCohortDynamicsMod.F90 @@ -2107,7 +2107,7 @@ subroutine EvaluateAndCorrectDBH(currentCohort,delta_dbh,delta_hite) delta_dbh = 0._r8 delta_hite = 0._r8 - if( int(prt_params%woody(currentCohort%pft)) == itrue) then + if( prt_params%woody(currentCohort%pft) == itrue) then struct_c = currentCohort%prt%GetState(struct_organ, all_carbon_elements) diff --git a/biogeochem/EDLoggingMortalityMod.F90 b/biogeochem/EDLoggingMortalityMod.F90 index f1f23d9f33..74f21d8bc2 100644 --- a/biogeochem/EDLoggingMortalityMod.F90 +++ b/biogeochem/EDLoggingMortalityMod.F90 @@ -258,7 +258,7 @@ subroutine LoggingMortality_frac( pft_i, dbh, canopy_layer, lmort_direct, & ! transfer of area to secondary land is based on overall area affected, not just logged crown area ! l_degrad accounts for the affected area between logged crowns - if(int(prt_params%woody(pft_i)) == 1)then ! only set logging rates for trees + if(prt_params%woody(pft_i) == itrue)then ! only set logging rates for trees ! direct logging rates, based on dbh min and max criteria if (dbh >= logging_dbhmin .and. .not. & @@ -542,7 +542,7 @@ subroutine logging_litter_fluxes(currentSite, currentPatch, newPatch, patch_site ! plants that were impacted. Thus, no direct dead can occur ! here, and indirect are impacts. - if(int(prt_params%woody(pft)) == itrue) then + if(prt_params%woody(pft) == itrue) then direct_dead = 0.0_r8 indirect_dead = logging_coll_under_frac * & (1._r8-currentPatch%fract_ldist_not_harvested) * currentCohort%n * & diff --git a/biogeochem/EDPatchDynamicsMod.F90 b/biogeochem/EDPatchDynamicsMod.F90 index 537e74824d..487318fa9d 100644 --- a/biogeochem/EDPatchDynamicsMod.F90 +++ b/biogeochem/EDPatchDynamicsMod.F90 @@ -777,7 +777,7 @@ subroutine spawn_patches( currentSite, bc_in) else ! small trees - if( int(prt_params%woody(currentCohort%pft)) == itrue)then + if( prt_params%woody(currentCohort%pft) == itrue)then ! Survivorship of undestory woody plants. Two step process. @@ -917,7 +917,7 @@ subroutine spawn_patches( currentSite, bc_in) ! burned off. Here, we remove that mass, and ! tally it in the flux we sent to the atmosphere - if(int(prt_params%woody(currentCohort%pft)) == itrue)then + if(prt_params%woody(currentCohort%pft) == itrue)then leaf_burn_frac = currentCohort%fraction_crown_burned else @@ -995,7 +995,7 @@ subroutine spawn_patches( currentSite, bc_in) ! WHat to do with cohorts in the understory of a logging generated ! disturbance patch? - if(int(prt_params%woody(currentCohort%pft)) == itrue)then + if(prt_params%woody(currentCohort%pft) == itrue)then ! Survivorship of undestory woody plants. Two step process. @@ -1905,7 +1905,7 @@ subroutine mortality_litter_fluxes(currentSite, currentPatch, & num_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * & hlm_freq_day * fates_mortality_disturbance_fraction) - elseif(int(prt_params%woody(pft)) == itrue) then + elseif(prt_params%woody(pft) == itrue) then ! Understorey trees. The total dead is based on their survivorship ! function, and the total area of disturbance. diff --git a/biogeochem/FatesAllometryMod.F90 b/biogeochem/FatesAllometryMod.F90 index 42264ca776..ef3c58495b 100644 --- a/biogeochem/FatesAllometryMod.F90 +++ b/biogeochem/FatesAllometryMod.F90 @@ -2370,7 +2370,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) integer, parameter :: max_counter = 200 ! Do reduce "if" calls, we break this call into two parts - if ( int(prt_params%woody(ipft)) == itrue ) then + if ( prt_params%woody(ipft) == itrue ) then if(.not.present(bdead)) then write(fates_log(),*) 'woody plants must use structure for dbh reset' @@ -2456,7 +2456,7 @@ subroutine ForceDBH( ipft, canopy_trim, d, h, bdead, bl ) call h_allom(d,ipft,h) if(counter>10)then write(fates_log(),*) 'dbh counter: ',counter,' is woody: ',& - int(prt_params%woody(ipft))==itrue + (prt_params%woody(ipft) == itrue) end if diff --git a/fire/SFMainMod.F90 b/fire/SFMainMod.F90 index aedcb4aa7c..ee8e4c2400 100644 --- a/fire/SFMainMod.F90 +++ b/fire/SFMainMod.F90 @@ -192,7 +192,7 @@ subroutine charecteristics_of_fuel ( currentSite ) currentPatch%livegrass = 0.0_r8 currentCohort => currentPatch%tallest do while(associated(currentCohort)) - if( int(prt_params%woody(currentCohort%pft)) == ifalse)then + if( prt_params%woody(currentCohort%pft) == ifalse)then currentPatch%livegrass = currentPatch%livegrass + & currentCohort%prt%GetState(leaf_organ, all_carbon_elements) * & @@ -374,7 +374,7 @@ subroutine wind_effect ( currentSite, bc_in) do while(associated(currentCohort)) if (debug) write(fates_log(),*) 'SF currentCohort%c_area ',currentCohort%c_area - if( int(prt_params%woody(currentCohort%pft)) == itrue)then + if( prt_params%woody(currentCohort%pft) == itrue)then currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area else total_grass_area = total_grass_area + currentCohort%c_area @@ -864,7 +864,7 @@ subroutine crown_scorching ( currentSite ) if (currentPatch%fire == 1) then currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if ( int(prt_params%woody(currentCohort%pft)) == itrue) then !trees only + if ( prt_params%woody(currentCohort%pft) == itrue) then !trees only leaf_c = currentCohort%prt%GetState(leaf_organ, all_carbon_elements) sapw_c = currentCohort%prt%GetState(sapw_organ, all_carbon_elements) @@ -878,7 +878,7 @@ subroutine crown_scorching ( currentSite ) enddo !end cohort loop do i_pft=1,numpft - if (tree_ag_biomass > 0.0_r8 .and. int(prt_params%woody(i_pft)) == itrue) then + if (tree_ag_biomass > 0.0_r8 .and. prt_params%woody(i_pft) == itrue) then !Equation 16 in Thonicke et al. 2010 !Van Wagner 1973 EQ8 !2/3 Byram (1959) currentPatch%Scorch_ht(i_pft) = EDPftvarcon_inst%fire_alpha_SH(i_pft) * (currentPatch%FI**0.667_r8) @@ -920,7 +920,7 @@ subroutine crown_damage ( currentSite ) do while(associated(currentCohort)) currentCohort%fraction_crown_burned = 0.0_r8 - if ( int(prt_params%woody(currentCohort%pft)) == itrue) then !trees only + if ( prt_params%woody(currentCohort%pft) == itrue) then !trees only ! Flames lower than bottom of canopy. ! c%hite is height of cohort @@ -984,7 +984,7 @@ subroutine cambial_damage_kill ( currentSite ) if (currentPatch%fire == 1) then currentCohort => currentPatch%tallest; do while(associated(currentCohort)) - if ( int(prt_params%woody(currentCohort%pft)) == itrue) then !trees only + if ( prt_params%woody(currentCohort%pft) == itrue) then !trees only ! Equation 21 in Thonicke et al 2010 bt = EDPftvarcon_inst%bark_scaler(currentCohort%pft)*currentCohort%dbh ! bark thickness. ! Equation 20 in Thonicke et al. 2010. @@ -1036,7 +1036,7 @@ subroutine post_fire_mortality ( currentSite ) do while(associated(currentCohort)) currentCohort%fire_mort = 0.0_r8 currentCohort%crownfire_mort = 0.0_r8 - if ( int(prt_params%woody(currentCohort%pft)) == itrue) then + if ( prt_params%woody(currentCohort%pft) == itrue) then ! Equation 22 in Thonicke et al. 2010. currentCohort%crownfire_mort = EDPftvarcon_inst%crown_kill(currentCohort%pft)*currentCohort%fraction_crown_burned**3.0_r8 ! Equation 18 in Thonicke et al. 2010. diff --git a/main/FatesHistoryInterfaceMod.F90 b/main/FatesHistoryInterfaceMod.F90 index f43289da15..af02d730a3 100644 --- a/main/FatesHistoryInterfaceMod.F90 +++ b/main/FatesHistoryInterfaceMod.F90 @@ -2506,7 +2506,7 @@ subroutine update_history_dyn(this,nc,nsites,sites) store_m_net_alloc*n_perm2 / days_per_year / sec_per_day ! Woody State Variables (basal area growth increment) - if ( int(prt_params%woody(ft)) == itrue) then + if ( prt_params%woody(ft) == itrue) then ! basal area [m2/m2] hio_ba_si_scpf(io_si,scpf) = hio_ba_si_scpf(io_si,scpf) + & diff --git a/parteh/PRTParametersMod.F90 b/parteh/PRTParametersMod.F90 index 04a0f5dda0..a0b6cbb44e 100644 --- a/parteh/PRTParametersMod.F90 +++ b/parteh/PRTParametersMod.F90 @@ -100,7 +100,7 @@ module PRTParametersMod real(r8), allocatable :: c2b(:) ! Carbon to biomass multiplier [kg/kgC] real(r8), allocatable :: wood_density(:) ! wood density g cm^-3 ... - real(r8), allocatable :: woody(:) ! Does the plant have wood? (1=yes, 0=no) + integer , allocatable :: woody(:) ! Does the plant have wood? (1=yes, 0=no) real(r8), allocatable :: crown(:) ! fraction of the height of the plant ! that is occupied by crown real(r8), allocatable :: slamax(:) ! Maximum specific leaf area of plant (at bottom) [m2/gC] diff --git a/parteh/PRTParamsFATESMod.F90 b/parteh/PRTParamsFATESMod.F90 index 208ff848fb..16c05cb2b0 100644 --- a/parteh/PRTParamsFATESMod.F90 +++ b/parteh/PRTParamsFATESMod.F90 @@ -441,8 +441,12 @@ subroutine PRTReceivePFT(fates_params) name = 'fates_woody' call fates_params%RetreiveParameterAllocate(name=name, & - data=prt_params%woody) - + data=tmpreal) + allocate(prt_params%woody(size(tmpreal,dim=1))) + call ArrayNint(tmpreal,prt_params%woody) + deallocate(tmpreal) + + name = 'fates_wood_density' call fates_params%RetreiveParameterAllocate(name=name, & data=prt_params%wood_density) @@ -1076,13 +1080,13 @@ subroutine PRTCheckParams(is_master) ! Check if woody plants have a structural biomass (agb) intercept ! ---------------------------------------------------------------------------------- if ( ( prt_params%allom_agb1(ipft) <= tiny(prt_params%allom_agb1(ipft)) ) .and. & - ( int(prt_params%woody(ipft)) .eq. 1 ) ) then + ( prt_params%woody(ipft) .eq. 1 ) ) then write(fates_log(),*) 'Woody plants are expected to have a non-zero intercept' write(fates_log(),*) ' in the diameter to AGB allometry equations' write(fates_log(),*) ' PFT#: ',ipft write(fates_log(),*) ' allom_agb1: ',prt_params%allom_agb1(ipft) - write(fates_log(),*) ' woody: ',int(prt_params%woody(ipft)) + write(fates_log(),*) ' woody: ',prt_params%woody(ipft) write(fates_log(),*) ' Aborting' call endrun(msg=errMsg(sourcefile, __LINE__)) @@ -1091,7 +1095,7 @@ subroutine PRTCheckParams(is_master) ! Check if non-woody plants have structural biomass (agb) intercept ! ---------------------------------------------------------------------------------- ! if ( ( prt_params%allom_agb1(ipft) > tiny(prt_params%allom_agb1(ipft)) ) .and. & -! ( int(prt_params%woody(ipft)) .ne. 1 ) ) then +! ( iprt_params%woody(ipft) .ne. 1 ) ) then ! ! write(fates_log(),*) 'Non-woody plants are expected to have a zero intercept' ! write(fates_log(),*) ' in the diameter to AGB allometry equations' @@ -1100,7 +1104,7 @@ subroutine PRTCheckParams(is_master) ! write(fates_log(),*) ' woody tissues (sap and structural dead wood).' ! write(fates_log(),*) ' PFT#: ',ipft ! write(fates_log(),*) ' allom_agb1: ',prt_params%allom_agb1(ipft) -! write(fates_log(),*) ' woody: ',int(prt_params%woody(ipft)) +! write(fates_log(),*) ' woody: ',prt_params%woody(ipft) ! write(fates_log(),*) ' Aborting' ! call endrun(msg=errMsg(sourcefile, __LINE__)) !