Skip to content

Commit c8e6da5

Browse files
rgknoxrgknox
authored
Merge pull request #271 from rgknox/rgknox-test-layering
bugfix on understory demotion
2 parents 0115fbc + 9cb0d2e commit c8e6da5

File tree

6 files changed

+1089
-724
lines changed

6 files changed

+1089
-724
lines changed

‎biogeochem/EDCanopyStructureMod.F90‎

Lines changed: 827 additions & 703 deletions
Large diffs are not rendered by default.

‎main/EDMainMod.F90‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -500,7 +500,11 @@ subroutine ed_total_balance_check (currentSite, call_index )
500500
net_flux = currentSite%flux_in - currentSite%flux_out
501501
error = abs(net_flux - change_in_stock)
502502

503-
if ( abs(error) > 10e-6 ) then
503+
! We are not closing this error within 10e-6 very often
504+
! but this is filling up the logs too much
505+
! Encapsulating print statements and making new issue (RGK 09-11-2017)
506+
507+
if ( abs(error) > 10e-6 .and. DEBUG ) then
504508
write(fates_log(),*) 'total error: call index: ',call_index, &
505509
'in: ',currentSite%flux_in, &
506510
'out: ',currentSite%flux_out, &

‎main/EDParamsMod.F90‎

Lines changed: 0 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -185,12 +185,6 @@ subroutine FatesRegisterParams(fates_params)
185185
call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, &
186186
dimension_names=dim_names)
187187

188-
call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, &
189-
dimension_names=dim_names)
190-
191-
call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, &
192-
dimension_names=dim_names)
193-
194188
call fates_params%RegisterParameter(name=ED_name_stress_mort, dimension_shape=dimension_shape_1d, &
195189
dimension_names=dim_names)
196190

@@ -303,12 +297,6 @@ subroutine FatesReceiveParams(fates_params)
303297
call fates_params%RetreiveParameter(name=ED_name_comp_excln, &
304298
data=ED_val_comp_excln)
305299

306-
call fates_params%RetreiveParameter(name=ED_name_grass_spread, &
307-
data=ED_val_grass_spread)
308-
309-
call fates_params%RetreiveParameter(name=ED_name_comp_excln, &
310-
data=ED_val_comp_excln)
311-
312300
call fates_params%RetreiveParameter(name=ED_name_stress_mort, &
313301
data=ED_val_stress_mort)
314302

@@ -413,8 +401,6 @@ subroutine FatesReportParams(is_master)
413401
write(fates_log(),fmt0) 'ED_size_diagnostic_scale = ',ED_size_diagnostic_scale
414402
write(fates_log(),fmt0) 'fates_mortality_disturbance_fraction = ',fates_mortality_disturbance_fraction
415403
write(fates_log(),fmt0) 'ED_val_grass_spread = ',ED_val_grass_spread
416-
write(fates_log(),fmt0) 'ED_val_comp_excln = ',ED_val_comp_excln
417-
write(fates_log(),fmt0) 'ED_val_grass_spread = ',ED_val_grass_spread
418404
write(fates_log(),fmt0) 'ED_val_comp_excln = ', ED_val_comp_excln
419405
write(fates_log(),fmt0) 'ED_val_stress_mort = ',ED_val_stress_mort
420406
write(fates_log(),fmt0) 'ED_val_maxspread = ',ED_val_maxspread

‎main/EDTypesMod.F90‎

Lines changed: 214 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
module EDTypesMod
22

3-
use FatesConstantsMod , only : r8 => fates_r8
4-
use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
3+
use FatesConstantsMod, only : r8 => fates_r8
4+
use FatesGlobals, only : fates_log
5+
use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
56

67
use FatesHydraulicsMemMod, only : ed_cohort_hydr_type
78
use FatesHydraulicsMemMod, only : ed_patch_hydr_type
@@ -602,5 +603,215 @@ function get_size_class_index(dbh) result(cohort_size_class)
602603
cohort_size_class = count(dbh-sclass_ed.ge.0.0_r8)
603604

604605
end function get_size_class_index
605-
606+
607+
! =====================================================================================
608+
609+
subroutine val_check_ed_vars(currentPatch,var_aliases,return_code)
610+
611+
! ----------------------------------------------------------------------------------
612+
! Perform numerical checks on variables of interest.
613+
! The input string is of the form: 'VAR1_NAME:VAR2_NAME:VAR3_NAME'
614+
! ----------------------------------------------------------------------------------
615+
616+
617+
use FatesUtilsMod,only : check_hlm_list
618+
use FatesUtilsMod,only : check_var_real
619+
620+
! Arguments
621+
type(ed_patch_type),intent(in), target :: currentPatch
622+
character(len=*),intent(in) :: var_aliases
623+
integer,intent(out) :: return_code ! return 0 for all fine
624+
! return 1 if a nan detected
625+
! return 10+ if an overflow
626+
! return 100% if an underflow
627+
! Locals
628+
type(ed_cohort_type), pointer :: currentCohort
629+
630+
631+
! Check through a registry of variables to check
632+
633+
if ( check_hlm_list(trim(var_aliases),'co_n') ) then
634+
635+
currentCohort => currentPatch%shortest
636+
do while(associated(currentCohort))
637+
call check_var_real(currentCohort%n,'cohort%n',return_code)
638+
if(.not.(return_code.eq.0)) then
639+
call dump_site(currentPatch%siteptr)
640+
call dump_patch(currentPatch)
641+
call dump_cohort(currentCohort)
642+
return
643+
end if
644+
currentCohort => currentCohort%taller
645+
end do
646+
end if
647+
648+
if ( check_hlm_list(trim(var_aliases),'co_dbh') ) then
649+
650+
currentCohort => currentPatch%shortest
651+
do while(associated(currentCohort))
652+
call check_var_real(currentCohort%dbh,'cohort%dbh',return_code)
653+
if(.not.(return_code.eq.0)) then
654+
call dump_site(currentPatch%siteptr)
655+
call dump_patch(currentPatch)
656+
call dump_cohort(currentCohort)
657+
return
658+
end if
659+
currentCohort => currentCohort%taller
660+
end do
661+
end if
662+
663+
if ( check_hlm_list(trim(var_aliases),'pa_area') ) then
664+
665+
call check_var_real(currentPatch%area,'patch%area',return_code)
666+
if(.not.(return_code.eq.0)) then
667+
call dump_site(currentPatch%siteptr)
668+
call dump_patch(currentPatch)
669+
return
670+
end if
671+
end if
672+
673+
674+
675+
return
676+
end subroutine val_check_ed_vars
677+
678+
! =====================================================================================
679+
680+
subroutine dump_site(csite)
681+
682+
type(ed_site_type),intent(in),target :: csite
683+
684+
685+
! EDTypes is
686+
687+
write(fates_log(),*) '----------------------------------------'
688+
write(fates_log(),*) ' Site Coordinates '
689+
write(fates_log(),*) '----------------------------------------'
690+
write(fates_log(),*) 'latitude = ', csite%lat
691+
write(fates_log(),*) 'longitude = ', csite%lon
692+
write(fates_log(),*) '----------------------------------------'
693+
return
694+
695+
end subroutine dump_site
696+
697+
! =====================================================================================
698+
699+
700+
subroutine dump_patch(cpatch)
701+
702+
type(ed_patch_type),intent(in),target :: cpatch
703+
704+
write(fates_log(),*) '----------------------------------------'
705+
write(fates_log(),*) ' Dumping Patch Information '
706+
write(fates_log(),*) ' (omitting arrays) '
707+
write(fates_log(),*) '----------------------------------------'
708+
write(fates_log(),*) 'pa%patchno = ',cpatch%patchno
709+
write(fates_log(),*) 'pa%age = ',cpatch%age
710+
write(fates_log(),*) 'pa%age_class = ',cpatch%age_class
711+
write(fates_log(),*) 'pa%area = ',cpatch%area
712+
write(fates_log(),*) 'pa%countcohorts = ',cpatch%countcohorts
713+
write(fates_log(),*) 'pa%ncl_p = ',cpatch%ncl_p
714+
write(fates_log(),*) 'pa%total_canopy_area = ',cpatch%total_canopy_area
715+
write(fates_log(),*) 'pa%total_tree_area = ',cpatch%total_tree_area
716+
write(fates_log(),*) 'pa%canopy_area = ',cpatch%canopy_area
717+
write(fates_log(),*) 'pa%bare_frac_area = ',cpatch%bare_frac_area
718+
write(fates_log(),*) 'pa%lai = ',cpatch%lai
719+
write(fates_log(),*) 'pa%zstar = ',cpatch%zstar
720+
write(fates_log(),*) 'pa%disturbance_rate = ',cpatch%disturbance_rate
721+
write(fates_log(),*) '----------------------------------------'
722+
return
723+
724+
end subroutine dump_patch
725+
726+
! =====================================================================================
727+
728+
subroutine dump_cohort(ccohort)
729+
730+
731+
type(ed_cohort_type),intent(in),target :: ccohort
732+
733+
write(fates_log(),*) '----------------------------------------'
734+
write(fates_log(),*) ' Dumping Cohort Information '
735+
write(fates_log(),*) '----------------------------------------'
736+
write(fates_log(),*) 'co%pft = ', ccohort%pft
737+
write(fates_log(),*) 'co%n = ', ccohort%n
738+
write(fates_log(),*) 'co%dbh = ', ccohort%dbh
739+
write(fates_log(),*) 'co%hite = ', ccohort%hite
740+
write(fates_log(),*) 'co%b = ', ccohort%b
741+
write(fates_log(),*) 'co%balive = ', ccohort%balive
742+
write(fates_log(),*) 'co%bdead = ', ccohort%bdead
743+
write(fates_log(),*) 'co%bstore = ', ccohort%bstore
744+
write(fates_log(),*) 'co%laimemory = ', ccohort%laimemory
745+
write(fates_log(),*) 'co%bsw = ', ccohort%bsw
746+
write(fates_log(),*) 'co%bl = ', ccohort%bl
747+
write(fates_log(),*) 'co%br = ', ccohort%br
748+
write(fates_log(),*) 'co%lai = ', ccohort%lai
749+
write(fates_log(),*) 'co%sai = ', ccohort%sai
750+
write(fates_log(),*) 'co%gscan = ', ccohort%gscan
751+
write(fates_log(),*) 'co%leaf_cost = ', ccohort%leaf_cost
752+
write(fates_log(),*) 'co%canopy_layer = ', ccohort%canopy_layer
753+
write(fates_log(),*) 'co%canopy_layer_yesterday = ', ccohort%canopy_layer_yesterday
754+
write(fates_log(),*) 'co%nv = ', ccohort%nv
755+
write(fates_log(),*) 'co%status_coh = ', ccohort%status_coh
756+
write(fates_log(),*) 'co%canopy_trim = ', ccohort%canopy_trim
757+
write(fates_log(),*) 'co%status_coh = ', ccohort%status_coh
758+
write(fates_log(),*) 'co%excl_weight = ', ccohort%excl_weight
759+
write(fates_log(),*) 'co%prom_weight = ', ccohort%prom_weight
760+
write(fates_log(),*) 'co%size_class = ', ccohort%size_class
761+
write(fates_log(),*) 'co%size_by_pft_class = ', ccohort%size_by_pft_class
762+
write(fates_log(),*) 'co%gpp_acc_hold = ', ccohort%gpp_acc_hold
763+
write(fates_log(),*) 'co%gpp_acc = ', ccohort%gpp_acc
764+
write(fates_log(),*) 'co%gpp_tstep = ', ccohort%gpp_tstep
765+
write(fates_log(),*) 'co%npp_acc_hold = ', ccohort%npp_acc_hold
766+
write(fates_log(),*) 'co%npp_tstep = ', ccohort%npp_tstep
767+
write(fates_log(),*) 'co%npp_acc = ', ccohort%npp_acc
768+
write(fates_log(),*) 'co%resp_tstep = ', ccohort%resp_tstep
769+
write(fates_log(),*) 'co%resp_acc = ', ccohort%resp_acc
770+
write(fates_log(),*) 'co%resp_acc_hold = ', ccohort%resp_acc_hold
771+
write(fates_log(),*) 'co%npp_leaf = ', ccohort%npp_leaf
772+
write(fates_log(),*) 'co%npp_froot = ', ccohort%npp_froot
773+
write(fates_log(),*) 'co%npp_bsw = ', ccohort%npp_bsw
774+
write(fates_log(),*) 'co%npp_bdead = ', ccohort%npp_bdead
775+
write(fates_log(),*) 'co%npp_bseed = ', ccohort%npp_bseed
776+
write(fates_log(),*) 'co%npp_store = ', ccohort%npp_store
777+
write(fates_log(),*) 'co%rdark = ', ccohort%rdark
778+
write(fates_log(),*) 'co%resp_m = ', ccohort%resp_m
779+
write(fates_log(),*) 'co%resp_g = ', ccohort%resp_g
780+
write(fates_log(),*) 'co%livestem_mr = ', ccohort%livestem_mr
781+
write(fates_log(),*) 'co%livecroot_mr = ', ccohort%livecroot_mr
782+
write(fates_log(),*) 'co%froot_mr = ', ccohort%froot_mr
783+
write(fates_log(),*) 'co%md = ', ccohort%md
784+
write(fates_log(),*) 'co%leaf_md = ', ccohort%leaf_md
785+
write(fates_log(),*) 'co%root_md = ', ccohort%root_md
786+
write(fates_log(),*) 'co%carbon_balance = ', ccohort%carbon_balance
787+
write(fates_log(),*) 'co%dmort = ', ccohort%dmort
788+
write(fates_log(),*) 'co%seed_prod = ', ccohort%seed_prod
789+
write(fates_log(),*) 'co%treelai = ', ccohort%treelai
790+
write(fates_log(),*) 'co%treesai = ', ccohort%treesai
791+
write(fates_log(),*) 'co%leaf_litter = ', ccohort%leaf_litter
792+
write(fates_log(),*) 'co%c_area = ', ccohort%c_area
793+
write(fates_log(),*) 'co%woody_turnover = ', ccohort%woody_turnover
794+
write(fates_log(),*) 'co%cmort = ', ccohort%cmort
795+
write(fates_log(),*) 'co%bmort = ', ccohort%bmort
796+
write(fates_log(),*) 'co%imort = ', ccohort%imort
797+
write(fates_log(),*) 'co%fmort = ', ccohort%fmort
798+
write(fates_log(),*) 'co%hmort = ', ccohort%hmort
799+
write(fates_log(),*) 'co%isnew = ', ccohort%isnew
800+
write(fates_log(),*) 'co%dndt = ', ccohort%dndt
801+
write(fates_log(),*) 'co%dhdt = ', ccohort%dhdt
802+
write(fates_log(),*) 'co%ddbhdt = ', ccohort%ddbhdt
803+
write(fates_log(),*) 'co%dbalivedt = ', ccohort%dbalivedt
804+
write(fates_log(),*) 'co%dbdeaddt = ', ccohort%dbdeaddt
805+
write(fates_log(),*) 'co%dbstoredt = ', ccohort%dbstoredt
806+
write(fates_log(),*) 'co%storage_flux = ', ccohort%storage_flux
807+
write(fates_log(),*) 'co%cfa = ', ccohort%cfa
808+
write(fates_log(),*) 'co%fire_mort = ', ccohort%fire_mort
809+
write(fates_log(),*) 'co%crownfire_mort = ', ccohort%crownfire_mort
810+
write(fates_log(),*) 'co%cambial_mort = ', ccohort%cambial_mort
811+
write(fates_log(),*) 'co%size_class = ', ccohort%size_class
812+
write(fates_log(),*) 'co%size_by_pft_class = ', ccohort%size_by_pft_class
813+
write(fates_log(),*) '----------------------------------------'
814+
return
815+
end subroutine dump_cohort
816+
606817
end module EDTypesMod

‎main/FatesConstantsMod.F90‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -61,10 +61,12 @@ module FatesConstantsMod
6161
! Conversion: days per second
6262
real(fates_r8), parameter :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8
6363

64-
! Conversion: days per year. assume HLM uses 365 day calendar. If we need to link to 365.25-day-calendared HLM, rewire to pass through interface
64+
! Conversion: days per year. assume HLM uses 365 day calendar.
65+
! If we need to link to 365.25-day-calendared HLM, rewire to pass through interface
6566
real(fates_r8), parameter :: days_per_year = 365.00_fates_r8
6667

67-
! Conversion: years per day. assume HLM uses 365 day calendar. If we need to link to 365.25-day-calendared HLM, rewire to pass through interface
68+
! Conversion: years per day. assume HLM uses 365 day calendar.
69+
! If we need to link to 365.25-day-calendared HLM, rewire to pass through interface
6870
real(fates_r8), parameter :: years_per_day = 1.0_fates_r8/365.00_fates_r8
6971

7072
! Physical constants

‎main/FatesUtilsMod.F90‎

Lines changed: 39 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,9 @@ module FatesUtilsMod
33
! This module contains helper functions and subroutines which are general in nature.
44
! Think string parsing, timing, maybe numerics, etc.
55

6+
use FatesConstantsMod, only : r8 => fates_r8
7+
use FatesGlobals, only : fates_log
8+
69
contains
710

811

@@ -30,5 +33,40 @@ function check_hlm_list(hlms,hlm_name) result(astatus)
3033

3134
end function check_hlm_list
3235

33-
36+
! =====================================================================================
37+
38+
subroutine check_var_real(r8_var, var_name, return_code)
39+
40+
real(r8),intent(in) :: r8_var
41+
character(len=*),intent(in) :: var_name
42+
integer,intent(out) :: return_code
43+
44+
real(r8), parameter :: r8_type = 1.0
45+
real(r8), parameter :: overflow = huge(r8_type)
46+
real(r8), parameter :: underflow = tiny(r8_type)
47+
48+
return_code = 0
49+
50+
! NaN check
51+
if (r8_var /= r8_var) then
52+
write(fates_log(),*) 'NaN detected, ',trim(var_name),': ',r8_var
53+
return_code = 1
54+
end if
55+
56+
! Overflow check (within 100th of max precision)
57+
if (abs(r8_var) > 0.01*overflow) then
58+
write(fates_log(),*) 'Nigh overflow detected, ',trim(var_name),': ',r8_var
59+
return_code = return_code + 10
60+
end if
61+
62+
! Underflow check (within 100x of min precision)
63+
if (abs(r8_var) < 100.0_r8*underflow) then
64+
write(fates_log(),*) 'Nigh underflow detected, ',trim(var_name),': ',r8_var
65+
return_code = return_code + 100
66+
end if
67+
68+
69+
end subroutine check_var_real
70+
71+
3472
end module FatesUtilsMod

0 commit comments

Comments
 (0)