Skip to content

Commit 0115fbc

Browse files
rgknoxrgknox
authored
Merge pull request #262 from rgknox/rgknox-interface-dynamics-numpft
dynamic numpft, dimension interface, removal of edecophyscon
2 parents cdd1f73 + 59c7c8d commit 0115fbc

21 files changed

+544
-821
lines changed

‎biogeochem/EDCanopyStructureMod.F90‎

Lines changed: 27 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -7,16 +7,16 @@ module EDCanopyStructureMod
77

88
use FatesConstantsMod , only : r8 => fates_r8
99
use FatesGlobals , only : fates_log
10-
use EDPftvarcon , only : EDPftvarcon_inst
10+
use EDPftvarcon , only : EDPftvarcon_inst
1111
use EDGrowthFunctionsMod , only : c_area
1212
use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts
1313
use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd
1414
use EDTypesMod , only : nclmax
1515
use EDTypesMod , only : nlevleaf
16-
use EDTypesMod , only : numpft_ed
1716
use EDtypesMod , only : AREA
1817
use FatesGlobals , only : endrun => fates_endrun
1918
use FatesInterfaceMod , only : hlm_days_per_year
19+
use FatesInterfaceMod , only : numpft
2020

2121
! CIME Globals
2222
use shr_log_mod , only : errMsg => shr_log_errMsg
@@ -825,7 +825,6 @@ subroutine canopy_summarization( nsites, sites, bc_in )
825825
use EDPatchDynamicsMod , only : set_root_fraction
826826
use EDTypesMod , only : sizetype_class_index
827827
use EDGrowthFunctionsMod , only : tree_lai, c_area
828-
use EDEcophysConType , only : EDecophyscon
829828
use EDtypesMod , only : area
830829
use EDPftvarcon , only : EDPftvarcon_inst
831830

@@ -941,7 +940,6 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
941940

942941
use EDGrowthFunctionsMod , only : tree_lai, tree_sai, c_area
943942
use EDtypesMod , only : area, dinc_ed, hitemax, n_hite_bins
944-
use EDEcophysConType , only : EDecophyscon
945943

946944
!
947945
! !ARGUMENTS
@@ -1051,19 +1049,19 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
10511049
currentCohort => currentPatch%shortest
10521050
do while(associated(currentCohort))
10531051
ft = currentCohort%pft
1054-
min_chite = currentCohort%hite - currentCohort%hite * EDecophyscon%crown(ft)
1052+
min_chite = currentCohort%hite - currentCohort%hite * EDPftvarcon_inst%crown(ft)
10551053
max_chite = currentCohort%hite
10561054
do iv = 1,N_HITE_BINS
10571055
frac_canopy(iv) = 0.0_r8
10581056
! this layer is in the middle of the canopy
10591057
if(max_chite > maxh(iv).and.min_chite < minh(iv))then
1060-
frac_canopy(iv)= min(1.0_r8,dh / (currentCohort%hite*EDecophyscon%crown(ft)))
1058+
frac_canopy(iv)= min(1.0_r8,dh / (currentCohort%hite*EDPftvarcon_inst%crown(ft)))
10611059
! this is the layer with the bottom of the canopy in it.
10621060
elseif(min_chite < maxh(iv).and.min_chite > minh(iv).and.max_chite > maxh(iv))then
1063-
frac_canopy(iv) = (maxh(iv) -min_chite ) / (currentCohort%hite*EDecophyscon%crown(ft))
1061+
frac_canopy(iv) = (maxh(iv) -min_chite ) / (currentCohort%hite*EDPftvarcon_inst%crown(ft))
10641062
! this is the layer with the top of the canopy in it.
10651063
elseif(max_chite > minh(iv).and.max_chite < maxh(iv).and.min_chite < minh(iv))then
1066-
frac_canopy(iv) = (max_chite - minh(iv)) / (currentCohort%hite*EDecophyscon%crown(ft))
1064+
frac_canopy(iv) = (max_chite - minh(iv)) / (currentCohort%hite*EDPftvarcon_inst%crown(ft))
10671065
elseif(max_chite < maxh(iv).and.min_chite > minh(iv))then !the whole cohort is within this layer.
10681066
frac_canopy(iv) = 1.0_r8
10691067
endif
@@ -1111,7 +1109,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
11111109
currentCohort => currentCohort%taller
11121110
enddo !currentCohort
11131111
lai = 0.0_r8
1114-
do ft = 1,numpft_ed
1112+
do ft = 1,numpft
11151113
lai = lai+ sum(currentPatch%tlai_profile(1,ft,:))
11161114
enddo
11171115

@@ -1159,9 +1157,9 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
11591157
! what is the height of this layer? (for snow burial purposes...)
11601158
! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile.
11611159
layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * &
1162-
EDecophyscon%crown(currentCohort%pft) )
1160+
EDPftvarcon_inst%crown(currentCohort%pft) )
11631161
layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * &
1164-
EDecophyscon%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft))
1162+
EDPftvarcon_inst%crown(currentCohort%pft)) ! EDPftvarcon_inst%vertical_canopy_frac(ft))
11651163

11661164
fraction_exposed =1.0_r8
11671165

@@ -1192,10 +1190,10 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
11921190
iv = currentCohort%NV
11931191
! EDPftvarcon_inst%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile.
11941192
layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * &
1195-
EDecophyscon%crown(currentCohort%pft) )
1193+
EDPftvarcon_inst%crown(currentCohort%pft) )
11961194
! EDPftvarcon_inst%vertical_canopy_frac(ft))
11971195
layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * &
1198-
EDecophyscon%crown(currentCohort%pft))
1196+
EDPftvarcon_inst%crown(currentCohort%pft))
11991197

12001198
fraction_exposed = 1.0_r8 !default.
12011199
snow_depth_avg = snow_depth_si * frac_sno_eff_si
@@ -1251,7 +1249,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
12511249
enddo !cohort
12521250

12531251
do L = 1,currentPatch%NCL_p
1254-
do ft = 1,numpft_ed
1252+
do ft = 1,numpft
12551253
do iv = 1,currentPatch%nrad(L,ft)
12561254
!account for total canopy area
12571255
currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv) / &
@@ -1279,7 +1277,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
12791277

12801278
currentPatch%nrad = currentPatch%ncan
12811279
do L = 1,currentPatch%NCL_p
1282-
do ft = 1,numpft_ed
1280+
do ft = 1,numpft
12831281
if(currentPatch%nrad(L,ft) > 30)then
12841282
write(fates_log(), *) 'ED: issue w/ nrad'
12851283
endif
@@ -1291,24 +1289,24 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
12911289
end do !iv
12921290
enddo !ft
12931291

1294-
if ( L == 1 .and. abs(sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1))) < 0.99999 &
1292+
if ( L == 1 .and. abs(sum(currentPatch%canopy_area_profile(1,1:numpft,1))) < 0.99999 &
12951293
.and. currentPatch%NCL_p > 1 ) then
1296-
write(fates_log(), *) 'ED: canopy area too small',sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1))
1297-
write(fates_log(), *) 'ED: cohort areas', currentPatch%canopy_area_profile(1,1:numpft_ed,:)
1294+
write(fates_log(), *) 'ED: canopy area too small',sum(currentPatch%canopy_area_profile(1,1:numpft,1))
1295+
write(fates_log(), *) 'ED: cohort areas', currentPatch%canopy_area_profile(1,1:numpft,:)
12981296
endif
12991297

13001298
if (L == 1 .and. currentPatch%NCL_p > 1 .and. &
1301-
abs(sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1))) < 0.99999) then
1299+
abs(sum(currentPatch%canopy_area_profile(1,1:numpft,1))) < 0.99999) then
13021300
write(fates_log(), *) 'ED: not enough area in the top canopy', &
1303-
sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1)), &
1304-
currentPatch%canopy_area_profile(L,1:numpft_ed,1)
1301+
sum(currentPatch%canopy_area_profile(L,1:numpft,1)), &
1302+
currentPatch%canopy_area_profile(L,1:numpft,1)
13051303
endif
13061304

1307-
if(abs(sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1))) > 1.00001)then
1305+
if(abs(sum(currentPatch%canopy_area_profile(L,1:numpft,1))) > 1.00001)then
13081306
write(fates_log(), *) 'ED: canopy-area-profile wrong', &
1309-
sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1)), &
1307+
sum(currentPatch%canopy_area_profile(L,1:numpft,1)), &
13101308
currentPatch%patchno, L
1311-
write(fates_log(), *) 'ED: areas',currentPatch%canopy_area_profile(L,1:numpft_ed,1),currentPatch%patchno
1309+
write(fates_log(), *) 'ED: areas',currentPatch%canopy_area_profile(L,1:numpft,1),currentPatch%patchno
13121310

13131311
currentCohort => currentPatch%shortest
13141312

@@ -1328,7 +1326,7 @@ subroutine leaf_area_profile( currentSite , snow_depth_si, frac_sno_eff_si)
13281326
enddo ! loop over L
13291327

13301328
do L = 1,currentPatch%NCL_p
1331-
do ft = 1,numpft_ed
1329+
do ft = 1,numpft
13321330
if(currentPatch%present(L,FT) > 1)then
13331331
write(fates_log(), *) 'ED: present issue',L,ft,currentPatch%present(L,FT)
13341332
currentPatch%present(L,ft) = 1
@@ -1500,28 +1498,28 @@ function calc_areaindex(cpatch,ai_type) result(ai)
15001498
ai = 0._r8
15011499
if (trim(ai_type) == 'elai') then
15021500
do cl = 1,cpatch%NCL_p
1503-
do ft = 1,numpft_ed
1501+
do ft = 1,numpft
15041502
ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * &
15051503
cpatch%elai_profile(cl,ft,1:cpatch%nrad(cl,ft)))
15061504
enddo
15071505
enddo
15081506
elseif (trim(ai_type) == 'tlai') then
15091507
do cl = 1,cpatch%NCL_p
1510-
do ft = 1,numpft_ed
1508+
do ft = 1,numpft
15111509
ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * &
15121510
cpatch%tlai_profile(cl,ft,1:cpatch%nrad(cl,ft)))
15131511
enddo
15141512
enddo
15151513
elseif (trim(ai_type) == 'esai') then
15161514
do cl = 1,cpatch%NCL_p
1517-
do ft = 1,numpft_ed
1515+
do ft = 1,numpft
15181516
ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * &
15191517
cpatch%esai_profile(cl,ft,1:cpatch%nrad(cl,ft)))
15201518
enddo
15211519
enddo
15221520
elseif (trim(ai_type) == 'tsai') then
15231521
do cl = 1,cpatch%NCL_p
1524-
do ft = 1,numpft_ed
1522+
do ft = 1,numpft
15251523
ai = ai + sum(cpatch%canopy_area_profile(cl,ft,1:cpatch%nrad(cl,ft)) * &
15261524
cpatch%tsai_profile(cl,ft,1:cpatch%nrad(cl,ft)))
15271525
enddo

‎biogeochem/EDCohortDynamicsMod.F90‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,6 @@ module EDCohortDynamicsMod
1313
use FatesConstantsMod , only : itrue
1414
use FatesInterfaceMod , only : hlm_days_per_year
1515
use EDPftvarcon , only : EDPftvarcon_inst
16-
use EDEcophysContype , only : EDecophyscon
1716
use EDGrowthFunctionsMod , only : c_area, tree_lai
1817
use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type
1918
use EDTypesMod , only : nclmax
@@ -676,8 +675,8 @@ subroutine fuse_cohorts(patchptr, bc_in)
676675
type (ed_cohort_type) , pointer :: currentCohort, nextc, nextnextc
677676
integer :: i
678677
integer :: fusion_took_place
679-
integer :: maxcohorts !maximum total no of cohorts. Needs to be >numpft_edx2
680-
integer :: iterate !do we need to keep fusing to get below maxcohorts?
678+
integer :: maxcohorts ! maximum total no of cohorts.
679+
integer :: iterate ! do we need to keep fusing to get below maxcohorts?
681680
integer :: nocohorts
682681
real(r8) :: newn
683682
real(r8) :: diff

‎biogeochem/EDPatchDynamicsMod.F90‎

Lines changed: 17 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -8,17 +8,18 @@ module EDPatchDynamicsMod
88
use EDPftvarcon , only : EDPftvarcon_inst
99
use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort
1010
use EDtypesMod , only : ncwd, n_dbh_bins, ntol, area, dbhmax
11-
use EDTypesMod , only : numpft_ed
1211
use EDTypesMod , only : maxPatchesPerSite
1312
use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type
1413
use EDTypesMod , only : min_patch_area
1514
use EDTypesMod , only : nclmax
15+
use EDTypesMod , only : maxpft
1616
use FatesInterfaceMod , only : hlm_use_planthydro
1717
use FatesInterfaceMod , only : hlm_numlevgrnd
1818
use FatesInterfaceMod , only : hlm_numlevsoil
1919
use FatesInterfaceMod , only : hlm_numSWb
2020
use FatesInterfaceMod , only : bc_in_type
2121
use FatesInterfaceMod , only : hlm_days_per_year
22+
use FatesInterfaceMod , only : numpft
2223
use FatesGlobals , only : endrun => fates_endrun
2324
use FatesConstantsMod , only : r8 => fates_r8
2425
use FatesConstantsMod , only : itrue
@@ -206,8 +207,8 @@ subroutine spawn_patches( currentSite, bc_in)
206207
real(r8) :: age ! notional age of this patch in years
207208
integer :: tnull ! is there a tallest cohort?
208209
integer :: snull ! is there a shortest cohort?
209-
real(r8) :: root_litter_local(numpft_ed) ! initial value of root litter. KgC/m2
210-
real(r8) :: leaf_litter_local(numpft_ed) ! initial value of leaf litter. KgC/m2
210+
real(r8) :: root_litter_local(maxpft) ! initial value of root litter. KgC/m2
211+
real(r8) :: leaf_litter_local(maxpft) ! initial value of leaf litter. KgC/m2
211212
real(r8) :: cwd_ag_local(ncwd) ! initial value of above ground coarse woody debris. KgC/m2
212213
real(r8) :: cwd_bg_local(ncwd) ! initial value of below ground coarse woody debris. KgC/m2
213214
real(r8) :: spread_local(nclmax) ! initial value of canopy spread parameter.no units
@@ -523,7 +524,7 @@ subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis
523524
newPatch%cwd_bg(c) = newPatch%cwd_bg(c) + currentPatch%cwd_bg(c) * patch_site_areadis/newPatch%area
524525
enddo
525526

526-
do p = 1,numpft_ed !move litter pool en mass into the new patch
527+
do p = 1,numpft !move litter pool en mass into the new patch
527528
newPatch%root_litter(p) = newPatch%root_litter(p) + currentPatch%root_litter(p) * patch_site_areadis/newPatch%area
528529
newPatch%leaf_litter(p) = newPatch%leaf_litter(p) + currentPatch%leaf_litter(p) * patch_site_areadis/newPatch%area
529530

@@ -589,7 +590,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
589590
currentSite%total_burn_flux_to_atm = currentSite%total_burn_flux_to_atm + burned_litter * new_patch%area !kG/site/day
590591
enddo
591592

592-
do p = 1,numpft_ed
593+
do p = 1,numpft
593594
burned_litter = new_patch%leaf_litter(p) * patch_site_areadis/new_patch%area * currentPatch%burnt_frac_litter(dl_sf)
594595
new_patch%leaf_litter(p) = new_patch%leaf_litter(p) - burned_litter
595596
currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day
@@ -684,7 +685,7 @@ subroutine fire_litter_fluxes(currentSite, cp_target, new_patch_target, patch_si
684685
enddo
685686

686687
!burned leaves.
687-
do p = 1,numpft_ed
688+
do p = 1,numpft
688689

689690
currentSite%leaf_litter_burned(p) = currentSite%leaf_litter_burned(p) + &
690691
dead_tree_density * currentCohort%bl * currentCohort%cfa
@@ -763,8 +764,8 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat
763764
real(r8) :: np_mult !Fraction of the new patch which came from the current patch (and so needs the same litter)
764765
integer :: p,c
765766
real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/day
766-
real(r8) :: canopy_mortality_leaf_litter(numpft_ed) ! flux in to leaf litter from tree death: KgC/m2/day
767-
real(r8) :: canopy_mortality_root_litter(numpft_ed) ! flux in to froot litter from tree death: KgC/m2/day
767+
real(r8) :: canopy_mortality_leaf_litter(maxpft) ! flux in to leaf litter from tree death: KgC/m2/day
768+
real(r8) :: canopy_mortality_root_litter(maxpft) ! flux in to froot litter from tree death: KgC/m2/day
768769
real(r8) :: mean_agb_frac ! mean fraction of AGB to total woody biomass (stand mean)
769770
!---------------------------------------------------------------------
770771

@@ -830,7 +831,7 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat
830831
! For the new patch, only some fraction of its land area (patch_areadis/np%area) is derived from the current patch
831832
! so we need to multiply by patch_areadis/np%area
832833

833-
mean_agb_frac = sum(EDPftvarcon_inst%allom_agb_frac(1:numpft_ed))/dble(numpft_ed)
834+
mean_agb_frac = sum(EDPftvarcon_inst%allom_agb_frac(1:numpft))/dble(numpft)
834835

835836
do c = 1,ncwd
836837

@@ -848,7 +849,7 @@ subroutine mortality_litter_fluxes(currentSite, cp_target, new_patch_target, pat
848849
SF_val_CWD_frac(c) * canopy_mortality_woody_litter * hlm_days_per_year * (1.0_r8 - mean_agb_frac) / AREA
849850
enddo
850851

851-
do p = 1,numpft_ed
852+
do p = 1,numpft
852853

853854
new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + canopy_mortality_leaf_litter(p) / litter_area * np_mult
854855
new_patch%root_litter(p) = new_patch%root_litter(p) + canopy_mortality_root_litter(p) / litter_area * np_mult
@@ -897,8 +898,8 @@ subroutine create_patch(currentSite, new_patch, age, areap, spread_local,cwd_ag_
897898
allocate(new_patch%fabi(hlm_numSWb))
898899
allocate(new_patch%sabs_dir(hlm_numSWb))
899900
allocate(new_patch%sabs_dif(hlm_numSWb))
900-
allocate(new_patch%rootfr_ft(numpft_ed,hlm_numlevgrnd))
901-
allocate(new_patch%rootr_ft(numpft_ed,hlm_numlevgrnd))
901+
allocate(new_patch%rootfr_ft(numpft,hlm_numlevgrnd))
902+
allocate(new_patch%rootr_ft(numpft,hlm_numlevgrnd))
902903

903904
call zero_patch(new_patch) !The nan value in here is not working??
904905

@@ -1152,7 +1153,7 @@ subroutine fuse_patches( csite, bc_in )
11521153
!---------------------------------------------------------------------!
11531154
! Calculate the difference criteria for each pft and dbh class !
11541155
!---------------------------------------------------------------------!
1155-
do ft = 1,numpft_ed ! loop over pfts
1156+
do ft = 1,numpft ! loop over pfts
11561157
do z = 1,n_dbh_bins ! loop over hgt bins
11571158
!is there biomass in this category?
11581159
if(currentPatch%pft_agb_profile(ft,z) > 0.0_r8.or.tpp%pft_agb_profile(ft,z) > 0.0_r8)then
@@ -1268,7 +1269,7 @@ subroutine fuse_2_patches(dp, rp)
12681269
rp%cwd_bg(c) = (dp%cwd_bg(c)*dp%area + rp%cwd_bg(c)*rp%area) * inv_sum_area
12691270
enddo
12701271

1271-
do p = 1,numpft_ed
1272+
do p = 1,numpft
12721273
rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area) * inv_sum_area
12731274
rp%seed_decay(p) = (rp%seed_decay(p)*rp%area + dp%seed_decay(p)*dp%area) * inv_sum_area
12741275
rp%seed_germination(p) = (rp%seed_germination(p)*rp%area + dp%seed_germination(p)*dp%area) * inv_sum_area
@@ -1531,11 +1532,7 @@ subroutine patch_pft_size_profile(cp_pnt)
15311532

15321533
delta_dbh = (DBHMAX/N_DBH_BINS)
15331534

1534-
do p = 1,numpft_ed
1535-
do j = 1,N_DBH_BINS
1536-
currentPatch%pft_agb_profile(p,j) = 0.0_r8
1537-
enddo
1538-
enddo
1535+
currentPatch%pft_agb_profile(:,:) = 0.0_r8
15391536

15401537
do j = 1,N_DBH_BINS
15411538
if (j == 1) then
@@ -1617,7 +1614,7 @@ subroutine set_root_fraction( cpatch , zi )
16171614
integer :: lev,p,c,ft
16181615
!----------------------------------------------------------------------
16191616

1620-
do ft = 1,numpft_ed
1617+
do ft = 1,numpft
16211618
do lev = 1, hlm_numlevgrnd
16221619
cpatch%rootfr_ft(ft,lev) = 0._r8
16231620
enddo

0 commit comments

Comments
 (0)