Merge pull request ESCOMP#4 from ekluzek/master

Bring in sci.1.3.1_api.2.0.0 from ngeet/fates-release

biogeochem/EDPatchDynamicsMod.F90

@@ -947,13 +947,7 @@ subroutine create_patch(currentSite, new_patch, age, areap, spread_local,cwd_ag_
     new_patch%frac_burnt         = 0._r8  
     new_patch%total_tree_area    = 0.0_r8  
     new_patch%NCL_p              = 1
-
-    new_patch%leaf_litter_in(:)  = 0._r8
-    new_patch%leaf_litter_out(:) = 0._r8
-
-    new_patch%root_litter_in(:)  = 0._r8
-    new_patch%root_litter_out(:) = 0._r8
-
+
   end subroutine create_patch
 
   ! ============================================================================

biogeochem/EDPhysiologyMod.F90

@@ -213,7 +213,8 @@ subroutine trim_canopy( currentSite )
                       if (currentCohort%hite > EDPftvarcon_inst%hgt_min(currentCohort%pft))then
                          currentCohort%canopy_trim = currentCohort%canopy_trim - EDPftvarcon_inst%trim_inc(currentCohort%pft)
                          if (EDPftvarcon_inst%evergreen(currentCohort%pft) /= 1)then
-                            currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - EDPftvarcon_inst%trim_inc(currentCohort%pft)) 
+                            currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - &
+                                                      EDPftvarcon_inst%trim_inc(currentCohort%pft)) 
                          endif
                          trimmed = 1
                       endif
@@ -930,7 +931,8 @@ subroutine Growth_Derivatives( currentSite, currentCohort, bc_in)
        currentCohort%npp_froot = currentCohort%npp_froot + &
              max(0.0_r8,currentCohort%carbon_balance*(currentCohort%root_md/currentCohort%md))
 
-       balive_loss = currentCohort%md *(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft))- currentCohort%carbon_balance
+       balive_loss = currentCohort%md *(1.0_r8- EDPftvarcon_inst%leaf_stor_priority(currentCohort%pft)) - &
+                     currentCohort%carbon_balance
        currentCohort%carbon_balance = 0._r8
     endif
 
@@ -1584,7 +1586,8 @@ subroutine flux_into_litter_pools(nsites, sites, bc_in, bc_out)
             currentCohort => currentPatch%tallest
             do while(associated(currentCohort))      
                biomass_bg_ft(currentCohort%pft) = biomass_bg_ft(currentCohort%pft) + &
-                    currentCohort%b * (currentCohort%n / currentPatch%area) * (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft))
+                    currentCohort%b * (currentCohort%n / currentPatch%area) * &
+                    (1.0_r8-EDPftvarcon_inst%allom_agb_frac(currentCohort%pft))
                currentCohort => currentCohort%shorter
             enddo !currentCohort
             ! 

main/EDMainMod.F90

@@ -500,7 +500,11 @@ subroutine ed_total_balance_check (currentSite, call_index )
     net_flux        = currentSite%flux_in - currentSite%flux_out
     error           = abs(net_flux - change_in_stock)   
 
-    if ( abs(error) > 10e-6 ) then
+    ! We are not closing this error within 10e-6 very often
+    ! but this is filling up the logs too much
+    ! Encapsulating print statements and making new issue (RGK 09-11-2017)
+
+    if ( abs(error) > 10e-6 .and. DEBUG ) then
        write(fates_log(),*) 'total error: call index: ',call_index, &
                       'in:  ',currentSite%flux_in,   &
                       'out: ',currentSite%flux_out,  &

main/EDParamsMod.F90

@@ -185,12 +185,6 @@ subroutine FatesRegisterParams(fates_params)
     call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, &
          dimension_names=dim_names)
 
-    call fates_params%RegisterParameter(name=ED_name_grass_spread, dimension_shape=dimension_shape_1d, &
-         dimension_names=dim_names)
-
-    call fates_params%RegisterParameter(name=ED_name_comp_excln, dimension_shape=dimension_shape_1d, &
-         dimension_names=dim_names)
-
     call fates_params%RegisterParameter(name=ED_name_stress_mort, dimension_shape=dimension_shape_1d, &
          dimension_names=dim_names)
 
@@ -303,12 +297,6 @@ subroutine FatesReceiveParams(fates_params)
     call fates_params%RetreiveParameter(name=ED_name_comp_excln, &
          data=ED_val_comp_excln)
 
-    call fates_params%RetreiveParameter(name=ED_name_grass_spread, &
-         data=ED_val_grass_spread)
-
-    call fates_params%RetreiveParameter(name=ED_name_comp_excln, &
-         data=ED_val_comp_excln)
-
     call fates_params%RetreiveParameter(name=ED_name_stress_mort, &
          data=ED_val_stress_mort)
 
@@ -413,8 +401,6 @@ subroutine FatesReportParams(is_master)
         write(fates_log(),fmt0) 'ED_size_diagnostic_scale = ',ED_size_diagnostic_scale
         write(fates_log(),fmt0) 'fates_mortality_disturbance_fraction = ',fates_mortality_disturbance_fraction
         write(fates_log(),fmt0) 'ED_val_grass_spread = ',ED_val_grass_spread
-        write(fates_log(),fmt0) 'ED_val_comp_excln = ',ED_val_comp_excln
-        write(fates_log(),fmt0) 'ED_val_grass_spread = ',ED_val_grass_spread
         write(fates_log(),fmt0) 'ED_val_comp_excln = ', ED_val_comp_excln
         write(fates_log(),fmt0) 'ED_val_stress_mort = ',ED_val_stress_mort
         write(fates_log(),fmt0) 'ED_val_maxspread = ',ED_val_maxspread

main/EDTypesMod.F90

@@ -1,7 +1,8 @@
 module EDTypesMod
 
-  use FatesConstantsMod , only : r8 => fates_r8
-  use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=)
+  use FatesConstantsMod,     only : r8 => fates_r8
+  use FatesGlobals,          only : fates_log
+  use shr_infnan_mod,        only : nan => shr_infnan_nan, assignment(=)
 
   use FatesHydraulicsMemMod, only : ed_cohort_hydr_type
   use FatesHydraulicsMemMod, only : ed_patch_hydr_type
@@ -602,5 +603,215 @@ function get_size_class_index(dbh) result(cohort_size_class)
      cohort_size_class = count(dbh-sclass_ed.ge.0.0_r8)
 
   end function get_size_class_index
-
+
+  ! =====================================================================================
+
+  subroutine val_check_ed_vars(currentPatch,var_aliases,return_code)
+
+     ! ----------------------------------------------------------------------------------
+     ! Perform numerical checks on variables of interest.
+     ! The input string is of the form:  'VAR1_NAME:VAR2_NAME:VAR3_NAME'
+     ! ----------------------------------------------------------------------------------
+
+
+     use FatesUtilsMod,only : check_hlm_list
+     use FatesUtilsMod,only : check_var_real
+
+     ! Arguments
+     type(ed_patch_type),intent(in), target :: currentPatch
+     character(len=*),intent(in)            :: var_aliases
+     integer,intent(out)                    :: return_code ! return 0 for all fine
+                                                           ! return 1 if a nan detected
+                                                           ! return 10+ if an overflow
+                                                           ! return 100% if an underflow
+     ! Locals
+     type(ed_cohort_type), pointer          :: currentCohort
+
+
+     ! Check through a registry of variables to check
+
+     if ( check_hlm_list(trim(var_aliases),'co_n') ) then
+
+        currentCohort => currentPatch%shortest
+        do while(associated(currentCohort))
+           call check_var_real(currentCohort%n,'cohort%n',return_code)
+           if(.not.(return_code.eq.0)) then
+              call dump_site(currentPatch%siteptr)
+              call dump_patch(currentPatch)
+              call dump_cohort(currentCohort)
+              return
+           end if
+           currentCohort => currentCohort%taller
+        end do
+     end if
+
+     if ( check_hlm_list(trim(var_aliases),'co_dbh') ) then
+
+        currentCohort => currentPatch%shortest
+        do while(associated(currentCohort))        
+           call check_var_real(currentCohort%dbh,'cohort%dbh',return_code)
+           if(.not.(return_code.eq.0)) then
+              call dump_site(currentPatch%siteptr)
+              call dump_patch(currentPatch)
+              call dump_cohort(currentCohort)
+              return
+           end if
+           currentCohort => currentCohort%taller
+        end do
+     end if
+
+     if ( check_hlm_list(trim(var_aliases),'pa_area') ) then
+
+        call check_var_real(currentPatch%area,'patch%area',return_code)
+        if(.not.(return_code.eq.0)) then
+           call dump_site(currentPatch%siteptr)
+           call dump_patch(currentPatch)
+           return
+        end if
+     end if
+
+
+
+     return
+  end subroutine val_check_ed_vars
+
+  ! =====================================================================================
+
+  subroutine dump_site(csite) 
+
+     type(ed_site_type),intent(in),target :: csite
+
+
+     ! EDTypes is 
+
+     write(fates_log(),*) '----------------------------------------'
+     write(fates_log(),*) ' Site Coordinates                       '
+     write(fates_log(),*) '----------------------------------------'
+     write(fates_log(),*) 'latitude                    = ', csite%lat
+     write(fates_log(),*) 'longitude                   = ', csite%lon
+     write(fates_log(),*) '----------------------------------------'
+     return
+
+  end subroutine dump_site
+
+  ! =====================================================================================
+
+
+  subroutine dump_patch(cpatch)
+
+     type(ed_patch_type),intent(in),target :: cpatch
+
+     write(fates_log(),*) '----------------------------------------'
+     write(fates_log(),*) ' Dumping Patch Information              '
+     write(fates_log(),*) ' (omitting arrays)                      '
+     write(fates_log(),*) '----------------------------------------'
+     write(fates_log(),*) 'pa%patchno            = ',cpatch%patchno
+     write(fates_log(),*) 'pa%age                = ',cpatch%age
+     write(fates_log(),*) 'pa%age_class          = ',cpatch%age_class
+     write(fates_log(),*) 'pa%area               = ',cpatch%area
+     write(fates_log(),*) 'pa%countcohorts       = ',cpatch%countcohorts
+     write(fates_log(),*) 'pa%ncl_p              = ',cpatch%ncl_p
+     write(fates_log(),*) 'pa%total_canopy_area  = ',cpatch%total_canopy_area
+     write(fates_log(),*) 'pa%total_tree_area    = ',cpatch%total_tree_area
+     write(fates_log(),*) 'pa%canopy_area        = ',cpatch%canopy_area
+     write(fates_log(),*) 'pa%bare_frac_area     = ',cpatch%bare_frac_area
+     write(fates_log(),*) 'pa%lai                = ',cpatch%lai
+     write(fates_log(),*) 'pa%zstar              = ',cpatch%zstar
+     write(fates_log(),*) 'pa%disturbance_rate   = ',cpatch%disturbance_rate
+     write(fates_log(),*) '----------------------------------------'
+     return
+
+  end subroutine dump_patch
+
+  ! =====================================================================================
+
+  subroutine dump_cohort(ccohort)
+
+
+     type(ed_cohort_type),intent(in),target :: ccohort
+
+     write(fates_log(),*) '----------------------------------------'
+     write(fates_log(),*) ' Dumping Cohort Information             '
+     write(fates_log(),*) '----------------------------------------'
+     write(fates_log(),*) 'co%pft                    = ', ccohort%pft
+     write(fates_log(),*) 'co%n                      = ', ccohort%n                         
+     write(fates_log(),*) 'co%dbh                    = ', ccohort%dbh                                        
+     write(fates_log(),*) 'co%hite                   = ', ccohort%hite                                
+     write(fates_log(),*) 'co%b                      = ', ccohort%b                            
+     write(fates_log(),*) 'co%balive                 = ', ccohort%balive
+     write(fates_log(),*) 'co%bdead                  = ', ccohort%bdead                          
+     write(fates_log(),*) 'co%bstore                 = ', ccohort%bstore
+     write(fates_log(),*) 'co%laimemory              = ', ccohort%laimemory
+     write(fates_log(),*) 'co%bsw                    = ', ccohort%bsw                  
+     write(fates_log(),*) 'co%bl                     = ', ccohort%bl
+     write(fates_log(),*) 'co%br                     = ', ccohort%br
+     write(fates_log(),*) 'co%lai                    = ', ccohort%lai                         
+     write(fates_log(),*) 'co%sai                    = ', ccohort%sai  
+     write(fates_log(),*) 'co%gscan                  = ', ccohort%gscan
+     write(fates_log(),*) 'co%leaf_cost              = ', ccohort%leaf_cost
+     write(fates_log(),*) 'co%canopy_layer           = ', ccohort%canopy_layer
+     write(fates_log(),*) 'co%canopy_layer_yesterday = ', ccohort%canopy_layer_yesterday
+     write(fates_log(),*) 'co%nv                     = ', ccohort%nv
+     write(fates_log(),*) 'co%status_coh             = ', ccohort%status_coh
+     write(fates_log(),*) 'co%canopy_trim            = ', ccohort%canopy_trim
+     write(fates_log(),*) 'co%status_coh             = ', ccohort%status_coh               
+     write(fates_log(),*) 'co%excl_weight            = ', ccohort%excl_weight               
+     write(fates_log(),*) 'co%prom_weight            = ', ccohort%prom_weight               
+     write(fates_log(),*) 'co%size_class             = ', ccohort%size_class
+     write(fates_log(),*) 'co%size_by_pft_class      = ', ccohort%size_by_pft_class
+     write(fates_log(),*) 'co%gpp_acc_hold           = ', ccohort%gpp_acc_hold
+     write(fates_log(),*) 'co%gpp_acc                = ', ccohort%gpp_acc
+     write(fates_log(),*) 'co%gpp_tstep              = ', ccohort%gpp_tstep
+     write(fates_log(),*) 'co%npp_acc_hold           = ', ccohort%npp_acc_hold
+     write(fates_log(),*) 'co%npp_tstep              = ', ccohort%npp_tstep
+     write(fates_log(),*) 'co%npp_acc                = ', ccohort%npp_acc
+     write(fates_log(),*) 'co%resp_tstep             = ', ccohort%resp_tstep
+     write(fates_log(),*) 'co%resp_acc               = ', ccohort%resp_acc
+     write(fates_log(),*) 'co%resp_acc_hold          = ', ccohort%resp_acc_hold
+     write(fates_log(),*) 'co%npp_leaf               = ', ccohort%npp_leaf
+     write(fates_log(),*) 'co%npp_froot              = ', ccohort%npp_froot
+     write(fates_log(),*) 'co%npp_bsw                = ', ccohort%npp_bsw
+     write(fates_log(),*) 'co%npp_bdead              = ', ccohort%npp_bdead
+     write(fates_log(),*) 'co%npp_bseed              = ', ccohort%npp_bseed
+     write(fates_log(),*) 'co%npp_store              = ', ccohort%npp_store
+     write(fates_log(),*) 'co%rdark                  = ', ccohort%rdark
+     write(fates_log(),*) 'co%resp_m                 = ', ccohort%resp_m
+     write(fates_log(),*) 'co%resp_g                 = ', ccohort%resp_g
+     write(fates_log(),*) 'co%livestem_mr            = ', ccohort%livestem_mr
+     write(fates_log(),*) 'co%livecroot_mr           = ', ccohort%livecroot_mr
+     write(fates_log(),*) 'co%froot_mr               = ', ccohort%froot_mr
+     write(fates_log(),*) 'co%md                     = ', ccohort%md
+     write(fates_log(),*) 'co%leaf_md                = ', ccohort%leaf_md
+     write(fates_log(),*) 'co%root_md                = ', ccohort%root_md
+     write(fates_log(),*) 'co%carbon_balance         = ', ccohort%carbon_balance
+     write(fates_log(),*) 'co%dmort                  = ', ccohort%dmort
+     write(fates_log(),*) 'co%seed_prod              = ', ccohort%seed_prod
+     write(fates_log(),*) 'co%treelai                = ', ccohort%treelai
+     write(fates_log(),*) 'co%treesai                = ', ccohort%treesai
+     write(fates_log(),*) 'co%leaf_litter            = ', ccohort%leaf_litter
+     write(fates_log(),*) 'co%c_area                 = ', ccohort%c_area
+     write(fates_log(),*) 'co%woody_turnover         = ', ccohort%woody_turnover
+     write(fates_log(),*) 'co%cmort                  = ', ccohort%cmort
+     write(fates_log(),*) 'co%bmort                  = ', ccohort%bmort
+     write(fates_log(),*) 'co%imort                  = ', ccohort%imort
+     write(fates_log(),*) 'co%fmort                  = ', ccohort%fmort
+     write(fates_log(),*) 'co%hmort                  = ', ccohort%hmort
+     write(fates_log(),*) 'co%isnew                  = ', ccohort%isnew
+     write(fates_log(),*) 'co%dndt                   = ', ccohort%dndt
+     write(fates_log(),*) 'co%dhdt                   = ', ccohort%dhdt
+     write(fates_log(),*) 'co%ddbhdt                 = ', ccohort%ddbhdt
+     write(fates_log(),*) 'co%dbalivedt              = ', ccohort%dbalivedt
+     write(fates_log(),*) 'co%dbdeaddt               = ', ccohort%dbdeaddt
+     write(fates_log(),*) 'co%dbstoredt              = ', ccohort%dbstoredt
+     write(fates_log(),*) 'co%storage_flux           = ', ccohort%storage_flux
+     write(fates_log(),*) 'co%cfa                    = ', ccohort%cfa
+     write(fates_log(),*) 'co%fire_mort              = ', ccohort%fire_mort
+     write(fates_log(),*) 'co%crownfire_mort         = ', ccohort%crownfire_mort
+     write(fates_log(),*) 'co%cambial_mort           = ', ccohort%cambial_mort
+     write(fates_log(),*) 'co%size_class             = ', ccohort%size_class
+     write(fates_log(),*) 'co%size_by_pft_class      = ', ccohort%size_by_pft_class
+     write(fates_log(),*) '----------------------------------------'
+     return
+  end subroutine dump_cohort
+
 end module EDTypesMod

main/FatesConstantsMod.F90

@@ -61,10 +61,12 @@ module FatesConstantsMod
   ! Conversion: days per second
   real(fates_r8), parameter :: days_per_sec = 1.0_fates_r8/86400.0_fates_r8
 
-  ! 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
+  ! 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
   real(fates_r8), parameter :: days_per_year = 365.00_fates_r8
 
-   ! 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
+  ! 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
   real(fates_r8), parameter :: years_per_day = 1.0_fates_r8/365.00_fates_r8
 
   ! Physical constants

main/FatesUtilsMod.F90

@@ -3,6 +3,9 @@ module FatesUtilsMod
   ! This module contains helper functions and subroutines which are general in nature.
   ! Think string parsing, timing, maybe numerics, etc.
 
+  use FatesConstantsMod, only : r8 => fates_r8
+  use FatesGlobals, only      : fates_log
+
 contains
 
 
@@ -30,5 +33,40 @@ function check_hlm_list(hlms,hlm_name) result(astatus)
 
   end function check_hlm_list
 
-
+  ! =====================================================================================
+
+  subroutine check_var_real(r8_var, var_name, return_code)
+
+     real(r8),intent(in)         :: r8_var
+     character(len=*),intent(in) :: var_name
+     integer,intent(out)         :: return_code
+
+     real(r8), parameter :: r8_type  = 1.0
+     real(r8), parameter :: overflow  = huge(r8_type)
+     real(r8), parameter :: underflow = tiny(r8_type)
+
+     return_code = 0
+
+     ! NaN check
+     if (r8_var /= r8_var) then
+        write(fates_log(),*) 'NaN detected, ',trim(var_name),': ',r8_var
+        return_code = 1
+     end if
+
+     ! Overflow check (within 100th of max precision)
+     if (abs(r8_var) > 0.01*overflow) then
+        write(fates_log(),*) 'Nigh overflow detected, ',trim(var_name),': ',r8_var
+        return_code = return_code + 10
+     end if
+
+     ! Underflow check (within 100x of min precision)
+     if (abs(r8_var) < 100.0_r8*underflow) then
+        write(fates_log(),*) 'Nigh underflow detected, ',trim(var_name),': ',r8_var
+        return_code = return_code + 100
+     end if
+
+
+  end subroutine check_var_real
+
+
 end module FatesUtilsMod